zlgeasyd12_cass.bas

用VB实现USB功能

        nFrameLeave = nLen Mod nFrameLen
    End If
    
    
    For i = 1 To nFrameNum                   '发送nFrameNum帧数据
        ComBuf(0) = Asc("W")                 '读命令
        ComBuf(1) = 2                        '24wc02
        ComBuf(2) = 0
        ComBuf(3) = nBgnAdr_l                '取发送地址
        ComBuf(4) = nBgnAdr_h
        ComBuf(5) = nFrameLen               '接收个数低字节
        ComBuf(6) = 0
        ComBuf(7) = 0                        '计算校验和
        For j = 0 To 6
          ComBuf(7) = ComBuf(7) Xor ComBuf(j)
        Next j
        
        For j = 1 To nFrameLen               '取所发送数据
          cAFrameOrder(j - 1) = Asc(Mid(WriteDate, (i - 1) * nFrameLen + j, 1))
        Next j

        st = WritePort1(ComBuf(0), 8)       '发送写数据命令
        If st <> 0 Then
            MsgBox "向端口一写数据出错！", vbInformation, "提示"
            Exit Function
        End If
        
        st = ReadPort1(ComBuf(0), 2)        '检查发送命令是否正确
        If st <> 0 Then
            MsgBox "读端口一数据出错！", vbInformation, "提示"
            Exit Function
        End If
        If ComBuf(0) <> &HBB Or ComBuf(1) <> &H1 Then
            MsgBox "向端口一发送命令出错！", vbInformation, "提示"
            Exit Function
        End If
    
        st = WritePort2(cAFrameOrder(0), 64)   '发送写数据命令
        If st <> 0 Then
            MsgBox "向端口二写数据出错！", vbInformation, "提示"
            Exit Function
        End If
        
        st = ReadPort1(ComBuf(0), 2)       '检查发送命令是否正确
        If st <> 0 Then
            MsgBox "读端口一数据出错！", vbInformation, "提示"
            Exit Function
        End If
        If ComBuf(0) <> &HBB Or ComBuf(1) <> &H3 Then
            MsgBox "写数据出错！", vbInformation, "提示"
            Exit Function
        End If
        
        st = ReadPort2(ComBuf(0), 1)       '读端点2检查返回的个数是否与发送个数相同
        If st <> 0 Then
            MsgBox "读端口一数据出错！", vbInformation, "提示"
            Exit Function
        End If
        If ComBuf(0) <> nFrameLen Then
            MsgBox "写E2PROM数据个数出错！", vbInformation, "提示"
            Exit Function
        End If
        
        nBgnAdr_l = nBgnAdr_l + nFrameLen    '计算下一个地址
    Next i
     
     
     
  If nFrameLeave > 0 Then
        ComBuf(0) = Asc("W")                 '读命令
        ComBuf(1) = 2                        '24wc02
        ComBuf(2) = 0
        ComBuf(3) = nBgnAdr_l                '取发送地址
        ComBuf(4) = nBgnAdr_h
        ComBuf(5) = nFrameLeave              '接收个低字节
        ComBuf(6) = 0
        ComBuf(7) = 0                        '计算校验和
        For j = 0 To 6
          ComBuf(7) = ComBuf(7) Xor ComBuf(j)
        Next j
        
        For j = 1 To nFrameLeave               '取所发送数据
          cAFrameOrder(j - 1) = Asc(Mid(WriteDate, (i - 1) * nFrameLen + j, 1))
        Next j
        
        st = WritePort1(ComBuf(0), 8)       '发送写数据命令
        If st <> 0 Then
            MsgBox "向端口一写数据出错！", vbInformation, "提示"
            Exit Function
        End If
        
        st = ReadPort1(ComBuf(0), 2)       '检查发送命令是否正确
        If st <> 0 Then
            MsgBox "读端口一数据出错！", vbInformation, "提示"
            Exit Function
        End If
        If ComBuf(0) <> &HBB Or ComBuf(1) <> &H1 Then
            MsgBox "向端口一发送命令出错！", vbInformation, "提示"
            Exit Function
        End If
        
        l = nFrameLeave                       '发送数据长度
        st = WritePort2(cAFrameOrder(0), l)   '发送写数据命令
        If st <> 0 Then
            MsgBox "向端口二写数据出错！", vbInformation, "提示"
            Exit Function
        End If
        
        st = ReadPort1(ComBuf(0), 2)        '检查发送命令是否正确
        If st <> 0 Then
            MsgBox "读端口一数据出错！", vbInformation, "提示"
            Exit Function
        End If
        If ComBuf(0) <> &HBB Or ComBuf(1) <> &H3 Then
            MsgBox "写数据出错！", vbInformation, "提示"
            Exit Function
        End If
        
        st = ReadPort2(ComBuf(0), 1)       '读端点2检查返回的个数是否与发送个数相同
        If st <> 0 Then
            MsgBox "读端口一数据出错！", vbInformation, "提示"
            Exit Function
        End If
        If ComBuf(0) <> nFrameLeave Then
            MsgBox "写E2PROM数据个数出错！", vbInformation, "提示"
            Exit Function
        End If
        
 End If
 WriteE2PRom = 0
 
End Function
        '------------------------------------------------------------
        '说明:  十六进制字符转为十进制值
        '参数:  HChar 十六进制字符(两位)
        '
        '返回:  返回十进制值
        '------------------------------------------------------------
Function HtoD(ByVal HChar As String)
    Dim Ch1 As Long
    Dim Ch2 As Long
    
    If Len(Trim$(HChar)) = 1 Then
        Ch1 = Asc(0)
    Else
        Ch1 = Asc(Left$(HChar, 1))
    End If
    Ch2 = Asc(Right$(HChar, 1))
    Select Case Ch1
       Case 48 To 57
         Ch1 = Ch1 - 48
       Case 65 To 70
          Ch1 = Ch1 - 55
       Case 97 To 102
          Ch1 = Ch1 - 87
   End Select
   
    Select Case Ch2
       Case 48 To 57
         Ch2 = Ch2 - 48
       Case 65 To 70
          Ch2 = Ch2 - 55
       Case 97 To 102
          Ch2 = Ch2 - 87
   End Select
   Ch1 = Ch1 * 16 + Ch2
   HtoD = Ch1
End Function


        '------------------------------------------------------------
        '说明:  把字符串转为十六进制显示
        '参数:  Str字符串
        '
        '返回:  十六进制的字符串
        '------------------------------------------------------------
Function StoH(ByVal Str As String)
    Dim i As Integer
    Dim StrTem As String
    Dim StrTem2 As String
    
    If Len(Str) > 0 Then
     For i = 1 To Len(Str)
       StrTem2 = ""
       StrTem2 = Hex(Asc(Mid(Str, i, 1)))
       If Len(StrTem2) = 1 Then
          StrTem2 = "0" + StrTem2
       End If
       StrTem = StrTem + StrTem2 + " "
     Next i
       StoH = StrTem
    End If
End Function


        '------------------------------------------------------------
        '说明:  把字符串转为十六进制显示
        '参数:  Str十六进制字符
        '
        '返回:  字符串
        '------------------------------------------------------------
Function HtoS(ByVal Str As String)
    Dim i As Integer
    Dim StrTem As String
    Dim StrTem2 As String
    
    If Len(Trim(Str)) > 0 Then
     For i = 1 To Len(Trim(Str))
        If Asc(Mid(Trim(Str), i, 1)) <> 32 Then            '不为空格时
              StrTem2 = Mid(Trim(Str), i, 1)
              i = i + 1                                    '指向下一个
            If i <= Len(Trim(Str)) Then
              If Asc(Mid(Trim(Str), i, 1)) <> 32 Then
                 StrTem2 = StrTem2 + Mid(Trim(Str), i, 1)
              End If
            End If
            If Len(StrTem2) = 1 Then
              StrTem2 = "0" + StrTem2
            End If
              StrTem = StrTem + Chr(HtoD(StrTem2))
              StrTem2 = ""
        End If
     Next i
       HtoS = StrTem
    End If
End Function