Private Sub Form_Load()
    ConfigureUI
    Form1.Caption = "RAPI File Copier"
    Command1.Caption = "Connect"
    Command2.Caption = "Disconnect"
    Command2.Enabled = False
    
    Label1.Caption = "PC File:"
    Label2.Caption = "Path/File Name on device:"
    Text1.Text = "C:\PCTestFile1.Txt"
    Text2.Text = "\CETestFile1.Txt"
    Command3.Caption = "Copy Down To Device"
    Command5.Caption = "..."
    
    Label3.Caption = "Device File:"
    Label4.Caption = "Path/File Name on PC:"
    Text3.Text = "\CETestFile1.Txt"
    Text4.Text = "C:\PCTestFile2.Txt"
    Command4.Caption = "Copy Up To Desktop"
    
    Label5.Caption = "Status: Disconnected!"
    Label6.Caption = "Bytes Copied: 0"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Command2_Click
    Unload Me
End Sub

Private Sub Command1_Click()
    'Connect
    If RapiConnect Then
        Label5.Caption = "Status: Connected!"
        Command1.Enabled = False
        Command2.Enabled = True
    Else
        Label5.Caption = "Status: Disconnected!"
        Command1.Enabled = True
        Command2.Enabled = False
    End If
End Sub

Private Sub Command2_Click()
    'Disconnect
    Call RapiDisconnect
    If RapiIsConnected Then
        Label5.Caption = "Status: Connected!"
        Command1.Enabled = False
        Command2.Enabled = True
    Else
        Label5.Caption = "Status: Disconnected!"
        Command1.Enabled = True
        Command2.Enabled = False
    End If
End Sub

Private Sub Command3_Click()
    If Not RapiIsConnected Then
        MsgBox "Device is not connected. Please connect first."
        Exit Sub
    End If
    If Not FileExists(Text1.Text) Then
        MsgBox "The PC file could not be found.", vbInformation
        Exit Sub
    End If
    Text1.Refresh
    Text2.Refresh
    Call RAPICopyPCFileToCE(Text1.Text, Text2.Text)
End Sub

Private Sub Command4_Click()
    If Not RapiIsConnected Then
        MsgBox "Device is not connected. Please connect first."
        Exit Sub
    End If
    If FileExists(Text4.Text) Then
        MsgBox "The PC file already exists. It will NOT be overwritten!"
        Exit Sub
    End If
    Text3.Refresh
    Text4.Refresh
    Call RAPICopyCEFileToPC(Text3.Text, Text4.Text)
End Sub

Private Sub Command5_Click()
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName = "" Then Exit Sub
    Text1.Text = CommonDialog1.FileName
    Text2.Text = Mid(Text1.Text, InStrRev(Text1.Text, "\"), _
        Len(Text1.Text))
    Text3.Text = Text2.Text
    Text4.Text = Mid(Text1.Text, 1, InStrRev(Text1.Text, ".") - 1) _
        & "2" & Mid(Text1.Text, InStrRev(Text1.Text, "."), Len(Text1.Text))
End Sub

Private Sub ConfigureUI()
    Form1.Move 345, 465, 10410, 3675
    Command1.Move 120, 120, 4935, 750
    Command2.Move 5220, 120, 4935, 750
    Command3.Move 8040, 1020, 2115, 750
    Command4.Move 8040, 1995, 2115, 750
    Command5.Move 7620, 1020, 295, 285
    Label1.Move 120, 1020, 915, 255
    Label2.Move 120, 1440, 1895, 255
    Label3.Move 120, 1995, 915, 255
    Label4.Move 120, 2415, 1895, 255
    Label5.Move 120, 2940, 4935, 255
    Label6.Move 5220, 2940, 4935, 255
    Text1.Move 1140, 1020, 6375, 285
    Text2.Move 2085, 1440, 5790, 285
    Text3.Move 1140, 1995, 6735, 285
    Text4.Move 2085, 2415, 5790, 285
End Sub
					

Option Explicit
Private Declare Function WaitForSingleObject Lib "kernel32" (
  ByVal _ hHandle As Long 
  ByVal dwMilliseconds As Long) As Long 

Public Const ONE_SECOND = 1000 
Public Const E_FAIL = &H80004005

Public Const FILE_ATTRIBUTE_NORMAL = &H80

Public Const INVALID_HANDLE_VALUE = -1

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000

Public Const CREATE_NEW = 1
Public Const CREATE_ALWAYS = 2
Public Const OPEN_EXISTING = 3

Public Const ERROR_FILE_EXISTS = 80
Public Const ERROR_INVALID_PARAMETER = 87
Public Const ERROR_DISK_FULL = 112

Public Type CEOSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Public Type RAPIINIT
    cbSize As Long
    heRapiInit As Long
    hrRapiInit As Long
End Type

Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Public Type MyType
    value As Integer
End Type

Public Declare Function CeCloseHandle Lib "rapi.dll" ( _
    ByVal hObject As Long) As Boolean
        
Public Declare Function CeCreateFile Lib "rapi.dll" ( _
    ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    lpSecurityAttributes As SECURITY_ATTRIBUTES, _
    ByVal dwCreationDistribution As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long
        
Public Declare Function CeGetVersionEx Lib "rapi.dll" ( _
    lpVersionInformation As CEOSVERSIONINFO) As Boolean
        
Public Declare Function CeRapiInitEx Lib "rapi.dll" ( _
    pRapiInit As RAPIINIT) As Long
    
Public Declare Function CeRapiUninit Lib "rapi.dll" () As Long

Public Declare Function CeReadFile Lib "rapi.dll" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Long) As Boolean
    
Public Declare Function CeWriteFile Lib "rapi.dll" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Long) As Boolean
    
Public Declare Function CeGetLastError Lib "rapi.dll" () As Long

'Wrapper functions for above API calls

Private Function GetSub(Addr As Long) As Long
    'Used for the init call.
    GetSub = Addr
End Function

Public Sub ConnectedRapi()
    'Used for the init call. Do not remove.
End Sub

Public Function RapiConnect() As Boolean
    'Initiates a connection and returns true
    ' if it connected, false if it did not.
    
    'Modified to match suggestion of Microsoft KB article 831883
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;831883

    Dim pRapiInit As RAPIINIT
    Dim dwWaitRet, dwTimeout As Long
    Dim hr As Long

    On Error GoTo RapiConnect_Err
    
    pRapiInit.cbSize = Len(pRapiInit)
    pRapiInit.heRapiInit = 0
    pRapiInit.hrRapiInit = 0

    hr = E_FAIL
    dwWaitRet = 0
    dwTimeout = 10 * ONE_SECOND 'However long you want to wait

    'Call CeRapiInitEx one time.
     hr = CeRapiInitEx(pRapiInit)
   
    If hr < 0 Then 'FAILED
      GoTo Failed
    End If
   
   'Wait for the RAPI event until timeout.

   'Use the WaitForSingleObject function for the worker thread
   'Use the WaitForMultipleObjects function if you are also waiting for other events.
   
   dwWaitRet = WaitForSingleObject(pRapiInit.heRapiInit, dwTimeout)
   
   If dwWaitRet = 0 Then 'WAIT_OBJECT_0
      'If the RAPI init is returned, check result
      
      If pRapiInit.hrRapiInit >= 0 Then 'SUCCEEDED   
        GoTo Succeeded
      Else
        GoTo Failed
      End If
   Else
      'Timeout or failed.
      GoTo Failed
   
   End If
   
   'success
   Succeeded:
     'Now you can make RAPI calls.
     RapiConnect = True
     Exit Function
   Failed:
     'Uninitialize RAPI if you ever called CeRapiInitEx.
     If hr >= 0 Then 'SUCCEEDED
       Call CeRapiUninit
     End If
    
   RapiConnect = False
   Exit Function
    
RapiConnect_Err:
    RapiConnect = False
End Function

Public Sub RAPICopyCEFileToPC(ByVal CESourceFile As String, _
        ByVal PCDestFile As String)
        
    Dim lCeFileHandle   As Long
    Dim iFile           As Integer
    Dim BytePos         As Long
    Dim lBufferLen      As Long
    Dim lBytesRead      As Long
    Dim bytFile(2048)   As Byte
    Dim lResult         As Long
    Dim I               As Integer
    
    ' Open the CE file.
    lCeFileHandle = RapiOpenFile(CESourceFile, 1, False, _
            FILE_ATTRIBUTE_NORMAL)
            
    If lCeFileHandle <> INVALID_HANDLE_VALUE Then
        'Create a file on the PC and write
        ' the bytes from the CE file to it.
        iFile = FreeFile
        Open PCDestFile For Binary Access Write As iFile
        BytePos = 1
        lBufferLen = 2048
        Do
            lResult = CeReadFile(lCeFileHandle, bytFile(0), _
                    lBufferLen, lBytesRead, 0&)
                    
            If (lResult And (lBytesRead = 0)) Then
                lResult = CeCloseHandle(lCeFileHandle)
                Close iFile
                Exit Do
            Else
                For I = 0 To lBytesRead - 1
                    Put iFile, BytePos + I, bytFile(I)
                Next I
                BytePos = BytePos + lBytesRead
            End If
            Form1.Label6.Caption = "Bytes Copied:" & _
                    (BytePos - 1) & " Up."
                    
            Form1.Label6.Refresh
        Loop
        Form1.Label6.Caption = Form1.Label6.Caption & _
                " Transfer Completed."
                
    Else
        lResult = CeCloseHandle(lCeFileHandle)
        MsgBox "Device File Does Not Exist Or Is Empty (0 Bytes)!"
    End If
End Sub

Public Sub RAPICopyPCFileToCE(ByVal PCSourceFile As String, _
        ByVal CEDestFile As String)
        
    Dim iFile As Integer
    Dim bytFile() As MyType
    Dim lCeFileHandle As Long
    Dim BytePos As Long
    Dim lBufferLen As Long
    Dim TotalCopied As Long
    Dim lBytesWritten As Long
    Dim lResult As Long
    
    'Get bytes from PC file.
    iFile = FreeFile
    Open PCSourceFile For Binary Access Read As iFile
        ReDim bytFile(LOF(iFile))
        Get iFile, , bytFile
    Close iFile
    
    'Create a file on the CE Device and write
    ' the bytes from the PC file to it.
    lCeFileHandle = RapiOpenFile(CEDestFile, 2, _
            True, FILE_ATTRIBUTE_NORMAL)
            
    If lCeFileHandle <> INVALID_HANDLE_VALUE Then
        BytePos = 0
        
        'Copy this many bytes at a time (MUST BE EVEN #).
        lBufferLen = 2048
        Do
            If UBound(bytFile) - TotalCopied > lBufferLen Then
                ' Copy the next set of bytes
                lResult = CeWriteFile(lCeFileHandle, bytFile(BytePos), _
                        lBufferLen, lBytesWritten, 0&)
                        
                TotalCopied = TotalCopied + lBytesWritten
                ' Unicode compensation.
                BytePos = BytePos + (lBufferLen \ 2)
                Form1.Label6.Caption = "Bytes Copied: " & _
                        TotalCopied & " Down."
                        
                Form1.Label6.Refresh
            Else
                ' Copy the remaining bytes if greater than 0
                lBufferLen = UBound(bytFile) - TotalCopied
                If lBufferLen > 0 Then
                    ' Copy remaining bytes at one time.
                    lResult = CeWriteFile(lCeFileHandle, _
                           bytFile(BytePos), lBufferLen, lBytesWritten, 0&)
 
                End If
                TotalCopied = TotalCopied + lBytesWritten
                Form1.Label6.Caption = "Bytes Copied: " & _
                        TotalCopied & " Down."
                        
                Form1.Label6.Refresh
                Exit Do
            End If
        Loop
    Else
        'CeCreateFile failed.  Why?
        Select Case CeGetLastError
            Case ERROR_FILE_EXISTS
                MsgBox "A file already exists with the specified name."
            Case ERROR_INVALID_PARAMETER
                MsgBox "A parameter was invalid."
            Case ERROR_DISK_FULL
                MsgBox "Disk if Full."
            Case Else
                MsgBox "An unknown error occurred."
        End Select
    End If
    Form1.Label6.Caption = Form1.Label6.Caption & " Transfer Completed."
    lResult = CeCloseHandle(lCeFileHandle)
End Sub

Public Sub RapiDisconnect()
    Call CeRapiUninit
End Sub

Public Function RapiGetCEOSVersionString() As String
    ' Returns the Major, Minor, and Build number of the OS In a string.
    Dim ceosver As CEOSVERSIONINFO
    
    ceosver.dwOSVersionInfoSize = Len(ceosver)
    
    If CeGetVersionEx(ceosver) Then
        RapiGetCEOSVersionString = ceosver.dwMajorVersion & "." & _
            ceosver.dwMinorVersion & "." & _
            ceosver.dwBuildNumber & " " & _
            Left$(ceosver.szCSDVersion, _
            InStr(ceosver.szCSDVersion, Chr$(0)) - 1)
    Else
        RapiGetCEOSVersionString = ""
    End If
End Function

Public Function RapiIsConnected() As Boolean
    ' Returns whether there is a RAPI connection. If the Version
    'string is returned then we know we have a valid connection.
    RapiIsConnected = RapiGetCEOSVersionString <> ""
End Function

Public Function RapiOpenFile(ByVal FileName As String, _
        ByVal mode As Integer, _
        ByVal CreateNew As Boolean, _
        ByVal flags As Long) As Long
            
    Dim lReturn As Long
    Dim lFileMode As Long
    Dim Security As SECURITY_ATTRIBUTES
    Dim CreateDist As Long
    
    Select Case mode
        Case 1: lFileMode = GENERIC_READ
        Case 2: lFileMode = GENERIC_WRITE
        Case 3: lFileMode = GENERIC_READ Or GENERIC_WRITE
    End Select
    
    If CreateNew Then
        CreateDist = CREATE_NEW
    Else
        CreateDist = OPEN_EXISTING
    End If
    
    lReturn = CeCreateFile(StrConv(FileName, vbUnicode), lFileMode, _
            0, Security, CreateDist, flags, 0&)
        
    RapiOpenFile = lReturn
End Function

Function FileExists(ByVal sFilename As String) As Boolean
'This function will check to make sure that a file exists. It will
'return True if the file was found and False if it was not found.
'Example: If Not FileExists("autoexec.bat") Then...

    Dim I As Integer
    
    On Error Resume Next
    
    I = Len(Dir$(sFilename))
    If Err Or I = 0 Or Trim(sFilename) = "" Then
        FileExists = False
    Else
        FileExists = True
    End If
End Function