form1.frm

Ch372开发软硬件详细资料,硬件为CH372+8051 软件为VB或VC皆有

            On Error Resume Next
                If (CH375WriteData(0, mBuffer, mLength)) Then        ' 发送成功
                
                    If (mLength <> 4096) Then
                        Dim strtempdlerr As String
                        strtempdlerr = "S2-C" & mTestCount & " CH375WriteData actual length short " & mLength & "(4096)"
                        List1.AddItem (strtempdlerr)
                    End If
                        
                    mTotal = mTotal + mLength ' 累计长度
                
                Else   ' 写操作失败
                    mErrCnt = mErrCnt + 1
                    Dim strtempdwerr As String
                    strtempdwerr = "S2-C" & mTestCount & " CH375WriteData return error"
                    List1.AddItem (strtempdwerr)
                End If
            Next mTestCount
            mLength = GetTickCount()
            mLength = mLength - mStep
            speed = 1000
            If (mLength <> 0) Then
                speed = speed * mTotal / mLength
            Else
                speed = 9999999
            End If
            Dim strtempdspeed As String
            strtempdspeed = "*** download speed = " & speed & " Bytes/Sec, total=" & mTotal & " bytes, time=" & mLength & "mS"
            List1.AddItem (strtempdspeed)
            Call SetCurSel
            Call Wait
        
            '*********************************上传速度测试**************************
            List1.AddItem ("*** Step-3: test speed of upload data: 2048KB data")
            Call SetCurSel
            mBuffer.mBuff(0) = TEST_UPLOAD
            mLength = 1
        On Error Resume Next
            If (CH375WriteData(0, mBuffer, mLength)) Then     ' 发送成功
            
                mTotal = 0
                mStep = GetTickCount()
                For mTestCount = 0 To 499  ' 循环测试
                
                    mLength = 4096
                On Error Resume Next
                    If (CH375ReadData(0, mBuffer, mLength)) Then         ' 接收成功
                    
                        If (mLength <> 4096) Then
                            Dim strtempulerr As String
                            strtempulerr = "S3-C" & mTestCount & " CH375ReadData actual length short " & mLength & " (4096)"
                            List1.AddItem (strtempulerr)
                        End If
                        mTotal = mTotal + mLength   ' 累计长度
                    Else   ' 读操作失败
                        mErrCnt = mErrCnt + 1
                        TxtErr.Text = mErrCnt
                        Dim strtempurerr As String
                        strtempurerr = "S3-C" & mTestCount & " CH375ReadData return error"
                        List1.AddItem (strtempurerr)
                    End If
                Next mTestCount
                mLength = GetTickCount()
                mLength = mLength - mStep
                speed = 1000
                If (mLength <> 0) Then
                    speed = speed * mTotal / mLength
                Else
                    speed = 9999999
                End If
                Dim strtempuspeed As String
                strtempuspeed = "*** upload speed = " & speed & " Bytes/Sec, total=" & mTotal & " bytes, time=" & mLength & " mS"
                List1.AddItem (strtempuspeed)
                Call SetCurSel
            Else        ' 写操作失败
              
                mErrCnt = mErrCnt + 1
                TxtErr.Text = mErrCnt
                List1.AddItem ("S3 CH375WriteData return error")
                Call SetCurSel
            End If
           Call Wait
        
        ' 关闭CH375设备,如果不继续使用则必须关闭设备,就象读写完硬盘中的数据文件后要关闭一样
            Dim strtemp As String
            strtemp = "*** Total error = " & mErrCnt
            List1.AddItem (strtemp)
            List1.AddItem ("*** CH375CloseDevice: 0 ")
        On Error Resume Next
            CH375CloseDevice (0)
            IsOpen = False
            List1.AddItem ("Exit.")
            ChkTest.Value = False
            Call SetCurSel
            StatusBar1.Panels.Item(1).Text = "Test Over"
            StatusBar1.Panels.Item(2).Text = "ErrorCount = " & mErrCnt
       
    Else
        Call Wait
    On Error Resume Next
        CH375CloseDevice (0)
            IsOpen = False
        List1.AddItem ("设备已关闭。")
        ChkTest.Value = False
    End If
    Call SetCurSel
End Sub

'清空列表框
Private Sub CmdClear_Click()
    List1.Clear
    Text2.Text = ""
End Sub

Private Sub CmdClose_Click()
On Error Resume Next
    CH375CloseDevice (0)
    IsOpen = False
    List1.AddItem ("设备已关闭")
    Unload Me
End Sub

Private Sub Command1_Click()
 Dim sendbuffer As mBuf
 Dim readbuffer As mBuf
 Dim i, j, k, sendtime, lastsend  As Integer
  
    
  
            
  
 
    
 sendlength = Len(Text1.Text)
  If sendlength > 64 Then
            sendtime = Int(sendlength / 64)
            lastsend = sendlength Mod 64
            Else
            sendtime = 0
            singlesendno = sendlength
            lastsend = sendlength
  End If
 For j = 0 To sendtime
        If j = sendtime Then
             singlesendno = lastsend
             Else: singlesendno = 63
        End If
                
        For i = 0 To singlesendno
        
          sendbuffer.mBuff(i) = Asc(Right(Left(Text1.Text, i + 1 + j * 64), 1))
         Debug.Print sendbuffer.mBuff(i)
         Next i
         If (CH375WriteData(0, sendbuffer, singlesendno)) Then
                    MsgBox "send data,sucess!"
                   '       Dim receiveno As Long
                  '        receiveno = 64
                   '       If (CH375ReadData(0, readbuffer, receiveno)) Then
                   '              MsgBox " receive ok!"
                   '           Else
                   '                 MsgBox "no data receive ,communication error !", vbCritical
                  '          End If
         
      
                 '       For k = 0 To receiveno - 1
                 '           readbuffer.mBuff(k) = Not readbuffer.mBuff(k)
                 '           Text2.Text = Text2.Text & Trim(Chr(readbuffer.mBuff(k)))
                 '       Next k
                 Else
                    MsgBox "  error send!", vbCritical
         End If
  Next j
          
    
  
        
End Sub

Private Sub Command2_Click()
Dim readbuffer As mBuf
Dim i As Integer
Dim length As Long
'sendlength = 1
'readbuffer.mBuff(0) = TEST_UPLOAD
'   If (CH375WriteData(0, readbuffer, sendlength)) Then
 '           MsgBox "commande sucess!"
'    End If
length = 4096
On Error Resume Next
If (CH375ReadData(0, readbuffer, length)) Then
            MsgBox " receive ok!"
        Else
            MsgBox "no data receive ,communication error !", vbCritical
  End If
        Debug.Print "receiveno=", length
        Text2.Text = ""
        For i = 0 To length - 1
            
          readbuffer.mBuff(i) = Not readbuffer.mBuff(i)
         '  Debug.Print readbuffer.mBuff(i)
          Text2.Text = Text2.Text & Chr(readbuffer.mBuff(i))
        Next i
End Sub

Private Sub Command3_Click()
          
 Dim sendbuffer As mBuf
 Dim readbuffer As mBuf
 Dim i, sendtime, lastsend  As Long

  
            
  
 
    
 'sendlength = Len(Text1.Text)
 sendlength = 4096
  For i = 0 To sendlength
        
          sendbuffer.mBuff(i) = Asc(Right(Left(Text1.Text, i + 1), 1))
   '      Debug.Print sendbuffer.mBuff(i)
         Next i
         If (CH375WriteData(0, sendbuffer, sendlength)) Then
                    MsgBox "send data,sucess!"
                 
                 Else
                    MsgBox "  error send!", vbCritical
         End If
End Sub
'初始化，加载DLL
Private Sub Form_Load()
    ChkTest.Value = 0
    List1.AddItem ("CH372/CH375 Bulk Data Test Program V1.0 ,   Copyright (C) W.ch 2003.12")
    List1.AddItem ("test data correctness and USB speed")
On Error Resume Next
    '需要使用DLL则需要先加载
    List1.AddItem ("*** Load DLL: CH375DLL.DLL ")
    
    If (LoadLibrary("CH375DLL.DLL") = Null) Then
        Exit Sub                      ' 加载DLL失败,可能未安装到系统中
    End If
    
    IsOpen = mOpenDevice()
    
End Sub

'等待子程序
Private Sub Wait()
    Dim x As Integer
    x = 1000
    While x
        x = x - 1
    Wend
End Sub

'设置当前选项在最底端
Private Sub SetCurSel()
    Dim lstid As Integer
    If (List1.ListCount > 1) Then
        lstid = List1.ListCount - 1
   Else
        lstid = List1.ListCount
   End If
   List1.Selected(lstid) = True
End Sub

'关闭窗口前先关闭设备
Private Sub Form_Unload(Cancel As Integer)
    If (IsOpen) Then
        Call Wait
    On Error Resume Next
        CH375CloseDevice (0)
        IsOpen = False
    End If
    
End Sub

Private Function mOpenDevice() As Boolean
    On Error Resume Next
     If (CH375OpenDevice(0) = -1) Then   ' 打开设备
        List1.AddItem ("设备打开失败，请检查设备和链接库")
        IsOpen = False
        mOpenDevice = False
    Else
        IsOpen = True
        List1.AddItem ("*** CH375OpenDevice: 0# ")
        mOpenDevice = True
    End If
End Function