form1.frm

6个用VB和DELPHI编写的FOR USB驱动程序

End Sub
'get descriptor
Sub GetDescriptor()
    Dim ByteCount As Long
    ByteCount = 4096
    Dim Descriptor(4096) As Byte
    Dim Status As Long
    'Dim recipient As Long
    
    ' call Endpoint1 object

  Endpoint1.GetDescriptor Descriptor, ByteCount, 0, 1, 1, 0, Status
    If Status <> USBIO_ERR_SUCCESS Then
        MsgBox (Endpoint1.ErrorText(Status))
    Else
        If (ByteCount - 1) > 0 Then
            DescriptorField.Text = DescriptorField.Text & "Descriptor" & vbNewLine
            PrintDescriptor Descriptor, ByteCount, 4096
        End If
    End If
End Sub
'get device descriptor
 Sub GetDeviceDescriptor()
    Dim ByteCount As Long
    ByteCount = 4096
    Dim Descriptor(4096) As Byte
    Dim Status As Long
    ' call Endpoint1 object
    Endpoint1.GetDeviceDescriptor Descriptor, ByteCount, Status
    If Status <> USBIO_ERR_SUCCESS Then
        MsgBox (Endpoint1.ErrorText(Status))
    Else
        If (ByteCount - 1) > 0 Then
            DescriptorField.Text = DescriptorField.Text & "Device Descriptor" & vbNewLine
            'display the descriptor in a readable format
            PrintDescriptor Descriptor, ByteCount, ByteCount
        End If
    End If
End Sub
'get string descriptor
Function GetStringDescriptor_String(GetStringDescriptorIndexField As Long) As String
    Dim Descriptor(256) As Byte
    Dim ByteCount As Long
    ByteCount = 256
    Dim Status As Long
    ' call Endpoint1 object
    Endpoint1.GetStringDescriptor Descriptor, ByteCount, GetStringDescriptorIndexField, 0, Status
    If Status <> USBIO_ERR_SUCCESS Then
        MsgBox (Endpoint1.ErrorText(Status))
    Else
       'GetStringDescriptorField.Text = ""
        'GetStringDescriptorLengthField.Text = Descriptor(0)
        'GetStringDescriptorTypeField.Text = Descriptor(1)
        ' display the descriptor in a readable format
        For n = 2 To ByteCount
            If Val(GetStringDescriptorIndexField) = 0 Then
                If Descriptor(n) < 16 Then
                    GetStringDescriptor_String = GetStringDescriptor_String & "0" & Hex(Descriptor(n)) & " "
                Else
                    GetStringDescriptor_String = GetStringDescriptor_String & Hex(Descriptor(n)) & " "
                End If
            Else
                If Descriptor(n) = 0 Then
                GetStringDescriptor_String = GetStringDescriptor_String
                Else
                GetStringDescriptor_String = GetStringDescriptor_String & Chr(Descriptor(n))
                End If
                
            End If
        Next n
        
    End If
End Function

Private Sub Command2_Click()
Call GetDescriptor

End Sub

Private Sub Command3_Click()
Call GetDeviceDescriptor
End Sub

Private Sub Command4_Click()
Dim ok As String
ok = GetStringDescriptor_String(1)
DescriptorField.Text = DescriptorField.Text & vbNewLine & ok

End Sub

Private Sub Command5_Click()
'StatusBar1.Panels.Add 1, , "1111"
'StatusBar1.Panels.Item "fasfasdf"
StatusBar1.Panels.Item(1) = "adfasdfasdf"
End Sub

Private Sub Command6_Click()

DescriptorField.Text = DescriptorField.Text & vbNewLine & GetStringDescriptor_String(2)
End Sub

Private Sub Form_Load()
    
    ' some local variables
    Dim Devices As Long
    Dim Status1 As Long
    Dim Status2 As Long
    Form1.Caption = "Mcu123.com USB For 68HC908JB8 学习板。学习USB就是快！"
    t1.ForeColor = &HFF
    t2.ForeColor = &HFF
    t3.ForeColor = &HFF

    ' create two instances of the COM object, one for each endpoint
    Set Endpoint1 = New USBIOCOMLib.USBIOInterface
    Set Endpoint2 = New USBIOCOMLib.USBIOInterface
    ' Enumerate the available devices.
    ' We use the USBIO default GUID here.
    ' In production-level code a custom GUID should be used which is defined in usbio.inf.
    Endpoint1.EnumerateDevices "{325ddf96-938c-11d3-9e34-0080c82727f4}", Devices
    ' check the number of available devices
    If Devices >= 1 Then
        ' open the first device (index 0)
        Endpoint1.OpenDevice 0, Status1
        Endpoint2.OpenDevice 0, Status2
        If (Status1 = USBIO_ERR_SUCCESS) And (Status2 = USBIO_ERR_SUCCESS) Then
            Form1.Status = "USB device opened"
            StatusBar1.Panels.Item(1) = "设备已经打开."
            StatusBar1.Panels.Item(2) = "设备标识:" & GetStringDescriptor_String(2) '读取
        Else
            MsgBox "Cannot open the USB device."
            StatusBar1.Panels.Item(1) = "没有找到设备."
            StatusBar1.Panels.Item(2) = "No USB device connected or USBIO device driver not installed "
        End If
    Else
        ' show a message if no device is found
        StatusBar1.Panels.Item(1) = "没有找到设备."
        StatusBar1.Panels.Item(2) = "No USB device connected or USBIO device driver not installed "
        MsgBox "No USB device connected or USBIO device driver not installed"
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
 Dim st As Long
   'stop read and write
    Endpoint2.StopWriting
    Endpoint1.StopReading
    
    ' delete intefaces and unconfigure device
    Endpoint1.DeleteInterfaces
    Endpoint1.UnconfigureDevice st
    ShowError st
End Sub

Private Sub Start_Click()
Dim Status As Long
Timer1.Enabled = True
    ' the following sequence configures the device,
    ' it is possible to use one of the instances
    ' add an interface, we assume 0 is a valid interface
    Endpoint1.AddInterface 0, 0, 4096, Status
    ShowError Status
    ' set the configuration, 0 is ok for single configuration devices
    Endpoint1.SetConfiguration 0, Status
    ShowError Status
    
    ' Bind to the IN endpoint 0x81.
    Endpoint1.Bind Val(&H81), Status
    ShowError Status
    Endpoint1.ResetPipe Status
    ShowError Status
    ' Start reading from the endpoint, this is required to enable the EP for reading
    Endpoint1.StartReading 8, 3, 5, Status
    ShowError Status
    ' disable the start button
    Start.Enabled = False

    ' Bind to the OUT endpoint 0x02
    Endpoint2.Bind Val(2), Status
    ShowError Status

    ' Start writing to the endpoint, this is required to enable the EP for writing
    Endpoint2.StartWriting 8, 3, 5, False, Status
    If Status = USBIO_ERR_SUCCESS Then
        Form1.Status = "已经连接成功."
    End If
    ShowError Status
    ' enable the timer fo                                                                                                                                                                                                                                     r writing
    Timer1.Enabled = True
    
End Sub
' this function is called if the device has sent data
Sub Endpoint1_ReadComplete(ByVal Obj As Object)

    If Start.Enabled = False Then
        Dim Status As Long
        'Dim count As Long
        'count = 6
        readcounter = 8
        ' read 8 bytes from the COM object
        Endpoint1.ReadData readbuffer, readcounter, Status
        ' check status
        If Status = USBIO_ERR_SUCCESS Then
            ' show settings of analog and digital input
            ProgressBar1.Value = readbuffer(3)
            ProgressBar2.Value = readbuffer(4)
            ProgressBar3.Value = readbuffer(5)
            t1.Text = Str(Numtopersent(readbuffer(3), 255)) + "%"
            t2.Text = Str(Numtopersent(readbuffer(4), 255)) + "%"
            t3.Text = Str(Numtopersent(readbuffer(5), 255)) + "%"
    '        ProcBar1.Value = readbuffer(5)
       Text1.Text = Str(readbuffer(3)) + Str(readbuffer(4)) + Str(readbuffer(5))
            'Check4.Value = readbuffer(0)
            'Check5.Value = readbuffer(1)
            'Check6.Value = readbuffer(2)
           Call Key_hit(readbuffer(0), readbuffer(1), readbuffer(2))
        Else
            ShowError Status
        End If
    End If
    
        
        'Dim Status1 As Long
        ' set led config
        'writebuffer(0) = Check1.Value
        'writebuffer(1) = Check2.Value
       ' writebuffer(2) = Check3.Value
       ' ' write to the device
       ' Endpoint2.WriteData writebuffer, 0, Status1
        'ShowError Status1
End Sub

Private Sub Form_Terminate()
    ' close the device
    Endpoint1.CloseDevice
    Endpoint2.CloseDevice
End Sub

Private Sub Stop_Click()
    Dim st As Long
   'stop read and write
    Endpoint2.StopWriting
    Endpoint1.StopReading
    Start.Enabled = True
    Status.Text = "已经断开连接."
    ' delete intefaces and unconfigure device
    Endpoint1.DeleteInterfaces
    Endpoint1.UnconfigureDevice st
    ShowError st
End Sub

Private Sub Timer1_Timer()
    ' submit a write request
    If Start.Enabled = False Then
        Dim buffer(7) As Byte
        Dim Status As Long
        ' set led config
        buffer(0) = Check1.Value
        buffer(1) = Check2.Value
        buffer(2) = Check3.Value
        ' write to the device
        Endpoint2.WriteData buffer, 0, Status
        ShowError Status
    Else
        Timer1.Enabled = False
    End If
End Sub

Private Sub Key_hit(key1 As Byte, key2 As Byte, key3 As Byte)
If key1 = 0 Then
Picture1.BackColor = &H8000000F
Else
Picture1.BackColor = &HFF00&
End If

If key2 = 0 Then
Picture2.BackColor = &H8000000F
Else
Picture2.BackColor = &HFF00&
End If

If key3 = 0 Then
Picture3.BackColor = &H8000000F
Else
Picture3.BackColor = &HFF00&
End If
End Sub

Function Numtopersent(n As Byte, fulln As Byte) As Byte
Numtopersent = (n / fulln) * 100
End Function

'print descriptor
Private Sub PrintDescriptor(Descriptor() As Byte, ByteCount As Long, MaxDescSizeText As Long)
    Dim n As Long
    Dim k As String
    n = 0
    Do While n < ByteCount
        ' convert descriptor to readable format
        If MaxDescSizeText < Descriptor(n) Then
            anzbytes = MaxDescSizeText - 1
        Else
            anzbytes = (Descriptor(n) - 1 + n)
        End If
        For m = n To anzbytes
            If Descriptor(m) < 16 Then
                k = k & "0" & Hex(Descriptor(m)) & " "
            Else
                k = k & Hex(Descriptor(m)) & " "
            End If
        Next m
            ' add to list
            n = n + Descriptor(n)
            DescriptorField.Text = DescriptorField.Text & k & vbNewLine
            k = ""
    Loop
End Sub