form1.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "超前科技 USB FOR JB8 "
   ClientHeight    =   4164
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   7176
   LinkTopic       =   "Form1"
   ScaleHeight     =   4164
   ScaleWidth      =   7176
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox t3 
      Height          =   285
      Left            =   6360
      TabIndex        =   18
      Text            =   "Text4"
      Top             =   2040
      Width           =   615
   End
   Begin VB.TextBox t2 
      Height          =   285
      Left            =   6360
      TabIndex        =   17
      Text            =   "Text3"
      Top             =   1680
      Width           =   615
   End
   Begin VB.TextBox t1 
      Height          =   285
      Left            =   6360
      TabIndex        =   16
      Text            =   "Text2"
      Top             =   1320
      Width           =   615
   End
   Begin VB.PictureBox Picture3 
      Height          =   255
      Left            =   4080
      ScaleHeight     =   204
      ScaleWidth      =   204
      TabIndex        =   12
      Top             =   2640
      Width           =   255
   End
   Begin VB.PictureBox Picture2 
      Height          =   255
      Left            =   3240
      ScaleHeight     =   204
      ScaleWidth      =   204
      TabIndex        =   11
      Top             =   2640
      Width           =   255
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H000000FF&
      Height          =   255
      Left            =   2400
      ScaleHeight     =   204
      ScaleWidth      =   204
      TabIndex        =   10
      Top             =   2640
      Width           =   255
   End
   Begin VB.TextBox Text1 
      Height          =   975
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   9
      Top             =   3000
      Width           =   6135
   End
   Begin MSComctlLib.ProgressBar ProgressBar3 
      Height          =   255
      Left            =   720
      TabIndex        =   8
      Top             =   2040
      Width           =   5535
      _ExtentX        =   9758
      _ExtentY        =   445
      _Version        =   393216
      Appearance      =   1
      Max             =   255
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   6120
      Top             =   2520
   End
   Begin VB.CommandButton Stop 
      Caption         =   "断开连接"
      Height          =   375
      Left            =   4680
      TabIndex        =   7
      Top             =   120
      Width           =   975
   End
   Begin VB.CheckBox Check3 
      Caption         =   "Led 3"
      Height          =   255
      Left            =   2760
      TabIndex        =   6
      Top             =   720
      Width           =   975
   End
   Begin VB.CheckBox Check2 
      Caption         =   "Led 2"
      Height          =   255
      Left            =   1560
      TabIndex        =   5
      Top             =   720
      Width           =   1095
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Led 1"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   720
      Width           =   1095
   End
   Begin MSComctlLib.ProgressBar ProgressBar2 
      Height          =   255
      Left            =   720
      TabIndex        =   3
      Top             =   1680
      Width           =   5535
      _ExtentX        =   9758
      _ExtentY        =   445
      _Version        =   393216
      Appearance      =   1
      Max             =   255
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   255
      Left            =   720
      TabIndex        =   2
      Top             =   1320
      Width           =   5535
      _ExtentX        =   9758
      _ExtentY        =   445
      _Version        =   393216
      Appearance      =   1
      Max             =   255
   End
   Begin VB.CommandButton Start 
      Caption         =   "开始连接"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   120
      Width           =   975
   End
   Begin VB.TextBox Status 
      Height          =   285
      Left            =   1440
      TabIndex        =   0
      Top             =   120
      Width           =   3015
   End
   Begin VB.Label Label8 
      Caption         =   "按键显示:"
      Height          =   255
      Left            =   1080
      TabIndex        =   23
      Top             =   2520
      Width           =   855
   End
   Begin VB.Label Label7 
      Caption         =   "传感器"
      Height          =   255
      Left            =   2760
      TabIndex        =   22
      Top             =   1080
      Width           =   735
   End
   Begin VB.Label Label6 
      Caption         =   "第三路"
      Height          =   255
      Left            =   120
      TabIndex        =   21
      Top             =   2040
      Width           =   735
   End
   Begin VB.Label Label5 
      Caption         =   "第二路"
      Height          =   255
      Left            =   120
      TabIndex        =   20
      Top             =   1680
      Width           =   615
   End
   Begin VB.Label Label4 
      Caption         =   "第一路"
      Height          =   255
      Left            =   120
      TabIndex        =   19
      Top             =   1320
      Width           =   615
   End
   Begin VB.Label Label3 
      Caption         =   "Key 3"
      Height          =   255
      Left            =   3960
      TabIndex        =   15
      Top             =   2400
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "Key 2"
      Height          =   255
      Left            =   3120
      TabIndex        =   14
      Top             =   2400
      Width           =   495
   End
   Begin VB.Label Label1 
      Caption         =   "Key 1"
      Height          =   255
      Left            =   2280
      TabIndex        =   13
      Top             =   2400
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 2 instances required: 1 for read and 1 for write
Dim WithEvents Endpoint1 As USBIOCOMLib.USBIOInterface
Attribute Endpoint1.VB_VarHelpID = -1
Dim WithEvents Endpoint2 As USBIOCOMLib.USBIOInterface
Attribute Endpoint2.VB_VarHelpID = -1
' buffer for reading
Dim readbuffer(7) As Byte
' help function to display errors
Sub ShowError(ErrorCode As Long)
    If ErrorCode <> USBIO_ERR_SUCCESS Then
        Status.Text = Endpoint1.ErrorText(ErrorCode)
    End If
End Sub

Private Sub Command1_Click()
Picture1.BackColor = &H8000000F
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"
    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"
        Else
            MsgBox "Cannot open the USB device."
        End If
    Else
        ' show a message if no device is found
        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 for 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 = 8
        ' read 8 bytes from the COM object
        Endpoint1.ReadData readbuffer, count, 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
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 = &HFF&
Else
Picture1.BackColor = &HFF00&
End If

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


        Dim buffer(7) As Byte
       Dim Status As Long
  buffer(1) = 1
 Endpoint2.WriteData buffer, 0, Status
'        ShowError Status



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