filetransfermodule.bas

上位机与下位机的USB通讯

Attribute VB_Name = "modFileTransfer"

Option Explicit

' Declare statements for all the functions in the SiUSBXp DLL
' NOTE: These statements assume that the DLL file is located in
'       the same directory as this project.
'       If you change the location of the DLL, be sure to change the location
'       in the declare statements also.
Public Declare Function SI_GetNumDevices Lib "SiUSBXp.dll" (ByRef lpwdNumDevices As Long) As Integer
Public Declare Function SI_GetProductString Lib "SiUSBXp.dll" (ByVal dwDeviceNum As Long, ByRef lpvDeviceString As Byte, ByVal dwFlags As Long) As Integer
Public Declare Function SI_Open Lib "SiUSBXp.dll" (ByVal dwDevice As Long, ByRef cyHandle As Long) As Integer
Public Declare Function SI_Close Lib "SiUSBXp.dll" (ByVal cyHandle As Long) As Integer
Public Declare Function SI_Read Lib "SiUSBXp.dll" (ByVal cyHandle As Long, ByRef lpBuffer As Byte, ByVal dwBytesToRead As Long, ByRef lpdwBytesReturned As Long, ByVal lpOverlapped As Long) As Integer
Public Declare Function SI_Write Lib "SiUSBXp.dll" (ByVal cyHandle As Long, ByRef lpBuffer As Byte, ByVal dwBytesToWrite As Long, ByRef lpdwBytesWritten As Long, ByVal lpOverlapped As Long) As Integer
Public Declare Function SI_SetTimeouts Lib "SiUSBXp.dll" (ByVal dwReadTimeout As Long, ByVal dwWriteTimeout As Long) As Integer
Public Declare Function SI_GetTimeouts Lib "SiUSBXp.dll" (ByRef lpdwReadTimeout As Long, ByRef lpdwWriteTimeout As Long) As Integer
Public Declare Function SI_CheckRXQueue Lib "SiUSBXp.dll" (ByVal cyHandle As Long, ByRef lpdwNumBytesInQueue As Long, ByRef lpdwQueueStatus As Long) As Integer

'Masks for the serial number and description
Public Const SI_RETURN_SERIAL_NUMBER = &H0
Public Const SI_RETURN_DESCRIPTION = &H1
Public Const SI_RETURN_LINK_NAME = &H2
Public Const SI_RETURN_VID = &H3
Public Const SI_RETURN_PID = &H4

'Masks for return values from the device
Public Const SI_SUCCESS = &H0
Public Const SI_DEVICE_NOT_FOUND = &HFF
Public Const SI_INVALID_HANDLE = &H1
Public Const SI_READ_ERROR = &H2
Public Const SI_RX_QUEUE_NOT_READY = &H3
Public Const SI_WRITE_ERROR = &H4
Public Const SI_RESET_ERROR = &H5
Public Const SI_INVALID_BUFFER = &H6
Public Const SI_INVALID_REQUEST_LENGTH = &H7
Public Const SI_DEVICE_IO_FAILED = &H8

Public Const SI_QUEUE_NO_OVERRUN = &H0
Public Const SI_QUEUE_OVERRUN = &H1
Public Const SI_QUEUE_READY = &H2

Public Const SI_MAX_DEVICE_STRLEN = 256
Public Const SI_MAX_READ_SIZE = 65536
Public Const SI_MAX_WRITE_SIZE = 4096

Public Const INVALID_HANDLE_VALUE = &HFFFF

Public Const MAX_PACKET_SIZE_WRITE = 512
Public Const MAX_PACKET_SIZE_READ = 4096

Public Const FT_READ_MSG = &H0
Public Const FT_WRITE_MSG = &H1
Public Const FT_READ_ACK = &H2
Public Const FT_MSG_SIZE = &H3

Public Const MAX_WRITE_PKTS = 1

'Variables used within the project
Global hUSBDevice  'global handle that is set when connected with the usb device
Global Status      'status, value to set when communicating with the board to determine success
Global TempString  'tempstring, contains the value of the file when performing a read

Public Const IOBufSize = 12
Global IOBuf(IOBufSize) As Byte 'io buffer; bits are defined as follows:
'IOBuf(0) = LED1
'IOBuf(1) = LED2
'IOBuf(2) = Port
'IOBuf(3) = Analog1
'IOBuf(4) = Analog2
'IOBuf(5,6,7) = Unused
'IOBuf(8,9,10,11) = Number Of Interrupts

Public Function ConvertToVBString(Str)

    Dim NewString As String
    Dim i As Integer
    
    'for the received string array, loop until we get
    'a 0 char, or until the max length has been obtained
    'then add the ascii char value to a vb string
    i = 0
    Do While (i < SI_MAX_DEVICE_STRLEN) And (Str(i) <> 0)
        NewString = NewString + Chr$(Str(i))
        i = i + 1
    Loop
    
    ConvertToVBString = NewString
    
End Function

Public Sub WriteFileData()

    Dim Success As Boolean
    Success = True
    
    Dim FileNum As Integer
    FileNum = FreeFile

    'check if there is a valid file
    If frmMain.txtTransfer.Text <> "" Then
        Open frmMain.txtTransfer.Text For Binary As FileNum
        
        Dim FileSize As Long
        FileSize = FileLen(frmMain.txtTransfer.Text)
        
        'if the file is valid, and exists then obtain its size,
        'and prepare to write data to the board
        If FileSize > 0 Then
            Dim BytesWritten As Long
            Dim BytesRead As Long
            Dim Buf(MAX_PACKET_SIZE_WRITE) As Byte
            
            BytesWritten = 0
            BytesRead = 0
                       
            Buf(0) = FT_WRITE_MSG
            Buf(1) = FileSize And &HFF
            Buf(2) = (FileSize And &HFF00) / 256
            
            'send the board a write message
            If (DeviceWrite(Buf, FT_MSG_SIZE, BytesWritten)) Then
                If BytesWritten = FT_MSG_SIZE Then
                    Dim NumPkts As Long
                    Dim NumLoops As Long
                    Dim CounterPkts As Long
                    Dim CounterLoops As Long
                    Dim i As Integer
                    Dim ByteInFile As Long
                    
                    'send data to the board in groups of 8 packets
                    If (FileSize Mod MAX_PACKET_SIZE_WRITE) > 0 Then
                        NumPkts = (FileSize \ MAX_PACKET_SIZE_WRITE) + 1
                    Else
                        NumPkts = (FileSize \ MAX_PACKET_SIZE_WRITE)
                    End If
                    If (NumPkts Mod MAX_WRITE_PKTS) > 0 Then
                        NumLoops = (NumPkts \ MAX_WRITE_PKTS) + 1
                    Else
                        NumLoops = (NumPkts \ MAX_WRITE_PKTS)
                    End If
                    CounterPkts = 0
                    CounterLoops = 0

                    Do While (CounterLoops < NumLoops) And Success
                        i = 0
                        Do While (i < MAX_WRITE_PKTS) And (CounterPkts < NumPkts) And Success
                            'for each section of 8 packets, clear the buffer
                            'then load the next section of data to send
                            Call MemSet(Buf, 0, MAX_PACKET_SIZE_WRITE)
                            If CounterPkts < (NumPkts - 1) Then
                                Call FileRead(FileNum, Buf, MAX_PACKET_SIZE_WRITE)
                            Else
                                'check if last packet is partial
                                If (FileSize Mod MAX_PACKET_SIZE_WRITE) > 0 Then
                                    Call FileRead(FileNum, Buf, FileSize Mod MAX_PACKET_SIZE_WRITE)
                                Else
                                    Call FileRead(FileNum, Buf, MAX_PACKET_SIZE_WRITE)
                                End If
                            End If
                            BytesWritten = 0
                            Success = DeviceWrite(Buf, MAX_PACKET_SIZE_WRITE, BytesWritten)
                            CounterPkts = CounterPkts + 1
                            i = i + 1
                        Loop
                        
                        If Success Then
                            Call MemSet(Buf, 0, MAX_PACKET_SIZE_WRITE)

                            'check for ack packet after writing 8 packets
                            Do While (Buf(0) <> 255) And Success
                                Success = DeviceRead(Buf, 1, BytesRead)
                            Loop
                        End If
                        
                        CounterLoops = CounterLoops + 1
                    Loop
                Else
                    MsgBox "Incomplete Write File Size Message Sent to Device"
                    Success = False
                End If
            Else
                MsgBox "Target Device Failure While Sending File Size Information"
                Success = False
            End If
            
            Close FileNum
        Else
            MsgBox "Failed to Open File " + frmMain.txtTransfer.Text
            Success = False
        End If
    Else
        MsgBox "No File Selected"
        Success = False
    End If
        
End Sub

Public Function DeviceWrite(Buffer() As Byte, dwSize As Long, lpdwBytesWritten As Long) As Boolean
    Dim Stat As Integer
    Dim WriteStatus As Integer
       
    WriteStatus = SI_Write(hUSBDevice, Buffer(0), dwSize, lpdwBytesWritten, 0)
    
    If WriteStatus = SI_SUCCESS Then
        DeviceWrite = True
    Else
        DeviceWrite = False
    End If
  
End Function

Public Sub ReadFileData()

    Dim Success As Boolean
    Success = True
    
    Dim FileNum As Integer
    FileNum = FreeFile

    TempString = ""
    
    'check if there is a valid file
    If frmMain.txtReceive.Text <> "" Then
        Open frmMain.txtReceive.Text For Output As FileNum
        
        Dim BytesRead As Long
        Dim BytesWritten As Long
        Dim Buf(MAX_PACKET_SIZE_READ) As Byte
        
        Buf(0) = FT_READ_MSG
        Buf(1) = &HFF
        Buf(2) = &HFF
        
        'send the board a read message
        If (DeviceWrite(Buf, FT_MSG_SIZE, BytesWritten)) Then
            Dim FileSize As Long
            Dim CounterPkts As Long
            Dim NumPkts As Long
            
            FileSize = 0
            CounterPkts = 0
            NumPkts = 0
            Call MemSet(Buf, 0, MAX_PACKET_SIZE_READ)
            
            'determine the file size and number of packets to
            'receive from the board
            If (DeviceRead(Buf, FT_MSG_SIZE, BytesRead)) Then
                FileSize = ((Buf(1) And &HFF) Or ((Buf(2) * 256) And &HFF00))
                If (FileSize Mod MAX_PACKET_SIZE_READ) > 0 Then
                    NumPkts = (FileSize \ MAX_PACKET_SIZE_READ) + 1
                Else
                    NumPkts = (FileSize \ MAX_PACKET_SIZE_READ)
                End If
                
                'send each packet back to the board and store it in a temp
                'string via the FileWrite function
                Do While (CounterPkts < NumPkts) And Success
                    Call MemSet(Buf, 0, MAX_PACKET_SIZE_READ)
                    BytesRead = 0
                    
                    If (DeviceRead(Buf, MAX_PACKET_SIZE_READ, BytesRead)) Then
                        If (CounterPkts < (NumPkts - 1)) Then
                            Call FileWrite(FileNum, Buf, MAX_PACKET_SIZE_READ)
                        Else
                            'check to see if last packet is partial
                            If (FileSize Mod MAX_PACKET_SIZE_READ) > 0 Then
                                Call FileWrite(FileNum, Buf, (FileSize Mod MAX_PACKET_SIZE_READ))
                            Else
                                Call FileWrite(FileNum, Buf, MAX_PACKET_SIZE_READ)
                            End If
                        End If
                    Else
                        MsgBox "Failed Reading File Packet From Target Device"
                    End If
                    
                    CounterPkts = CounterPkts + 1
                Loop
            Else
                MsgBox "Target Device Failure While Sending Read File Message"
            End If
        Else
            MsgBox "Target Device Failure While Sending File Size Information"
            Success = False
        End If

        'write the entire temporary string to the output file chosen
        Print #FileNum, TempString;
               
        Close FileNum
    Else
        MsgBox "No File Selected"
        Success = False
    End If
 
End Sub

Public Function DeviceRead(Buffer() As Byte, dwSize As Long, lpdwBytesRead As Long) As Boolean

    Dim Stat As Integer
    Dim ReadStatus As Integer
    Dim BytesInQueue As Long
    BytesInQueue = 0
    
    ReadStatus = SI_Read(hUSBDevice, Buffer(0), dwSize, lpdwBytesRead, 0)
   
    If ReadStatus = SI_SUCCESS Then
        DeviceRead = True
    Else
        DeviceRead = False
    End If
    
End Function

Public Sub MemSet(Buffer() As Byte, Value As Byte, Amount As Long)
    
    'this function sets all elements of on array to 0
    Dim i
    
    For i = 0 To (Amount - 1)
        Buffer(i) = Value
    Next
    
End Sub

Public Sub FileRead(FileNum As Integer, Buffer() As Byte, NumberOfBytes As Long)

    'this function converts the characters of a text file to bytes of
    'binary data to send out
    Dim i
    Dim Tmp
            
    For i = 0 To NumberOfBytes - 1
        If (Not EOF(FileNum)) Then
            Tmp = Input(FileNum, 1)
            If Tmp <> "" Then
                Buffer(i) = Asc(Tmp)
            Else
                Buffer(i) = 0
            End If
        End If
    Next
    
End Sub

Public Sub FileWrite(FileNum As Integer, Buffer() As Byte, NumberOfBytes As Long)

    'this function puts all the characters from the buffer in a temp
    'string to be dumped into a file after everything has been read
    Dim i
    
    For i = 0 To NumberOfBytes - 1
        TempString = TempString + Chr(Buffer(i))
    Next
    
End Sub