zlgeasyd12_cass.bas

用VB实现USB功能

Attribute VB_Name = "ZlgEasyD12_cass"



'*************************************************************************
'*                     声明全局变量
'*************************************************************************


Public st As Long                              '接收命今状态

                
'*************************************************************************
'*                      声明引用 EasyD12.dll API函数
'*************************************************************************
                
        '------------------------------------------------------------
        '说明:  读USB端口1数据
        '参数:  pData 读取数据缓冲区首地址  、iLen 读取的长度
        '返回:  0 发送数据成功、非0发送数据失败
        '------------------------------------------------------------
Declare Function ReadPort1 Lib "EasyD12.dll" (ByRef pData As Byte, ByVal iLen As Integer) As Integer


        '------------------------------------------------------------
        '说明:  读USB端口2数据
        '参数:  pData 读取数据缓冲区首地址  、iLen 读取的长度
        '返回:  0 发送数据成功、非0发送数据失败
        '------------------------------------------------------------
Declare Function ReadPort2 Lib "EasyD12.dll" (ByRef pData As Byte, ByVal iLen As Integer) As Integer

        '------------------------------------------------------------
        '说明:  向USB端口1写数据
        '参数:  pData 所写数据缓冲区首地址  、iLen 写数据长度
        '返回:  0 写数据成功、非0写数据失败
        '------------------------------------------------------------
Declare Function WritePort1 Lib "EasyD12.dll" (ByRef pData As Byte, ByVal iLen As Integer) As Integer

        '------------------------------------------------------------
        '说明:  向USB端口2写数据
        '参数:  pData 所写数据缓冲区首地址  、iLen 写数据长度
        '       dwTimeout 超时等待
        '返回:  0 写数据成功、非0写数据失败
        '------------------------------------------------------------
Declare Function WritePort2 Lib "EasyD12.dll" (ByRef pData As Byte, ByVal iLen As Integer) As Integer








'*************************************************************************
'*                      程序函数定义
'*************************************************************************

        '------------------------------------------------------------
        '说明:  读E2PRom数据
        '参数:  BgnAdr_L 开始读数据低地址、BgnAdr_H 开始读数据高地址、
        '        nLen   读数据长度
        '返回:  有字符串返回表示读数据成功，1为读数据失败
        '------------------------------------------------------------
Function ReadE2PRom(ByVal BgnAdr_L As Integer, ByVal BgnAdr_H As Integer, ByVal nLen As Integer)
    Dim nFrameLen As Integer                 '帧长度变量
    Dim nFrameNum As Integer                 '帧数
    Dim nFrameLeave As Integer               '最后一帐数据长度
    Dim ComBuf(7)   As Byte                  '命令缓冲区
    Dim cAFrameAck(63) As Byte               '接收数据缓冲区
    Dim nBgnAdr_l As Integer                 '读数据低地址
    Dim nBgnAdr_h As Integer                 '读数据高地址
    Dim Str As String                        '返回字符串
    Dim i As Integer
    Dim j As Integer
       
    ReadE2PRom = ""
    Str = ""
    nFrameLen = 64                            '每帧接收64个数据
    nBgnAdr_l = BgnAdr_L
    nBgnAdr_h = BgnAdr_H
    
    If nLen > 0 Then
        nFrameNum = Int(nLen / nFrameLen)
        nFrameLeave = nLen Mod nFrameLen
    End If
    
    
    For i = 1 To nFrameNum
        ComBuf(0) = Asc("R")                 '读命令
        ComBuf(1) = 2                        '24wc02
        ComBuf(2) = 0
        ComBuf(3) = nBgnAdr_l                '取发送地址
        ComBuf(4) = nBgnAdr_h
        ComBuf(5) = nFrameLen                      '接收64个低字节
        ComBuf(6) = 0
        ComBuf(7) = 0                        '计算校验和
        For j = 0 To 6
          ComBuf(7) = ComBuf(7) Xor ComBuf(j)
        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 = ReadPort2(cAFrameAck(0), 64)    '读端口2所返回的数据
        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) <> &H2 Then
            MsgBox "读E2PROM数据出错！", vbInformation, "提示"
            Exit Function
        End If
                 
        For j = 1 To nFrameLen                 '把数据转成字符患
            Str = Str + Chr(cAFrameAck(j - 1))
        Next j
        
        nBgnAdr_l = nBgnAdr_l + nFrameLen       '计算下一个地址

    Next i
     
   
     
    If nFrameLeave > 0 Then
        ComBuf(0) = Asc("R")                 '读命令
        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
        l = nFrameLeave
        
        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 = ReadPort2(cAFrameAck(0), l)     '读端口2所返回的数据
        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) <> &H2 Then
            MsgBox "读E2PROM数据出错！", vbInformation, "提示"
            Exit Function
        End If
                 
        For j = 1 To nFrameLeave                 '把数据转成字符患
            Str = Str + Chr(cAFrameAck(j - 1))
        Next j
        
     End If
     
       ReadE2PRom = Str                         '返回字符串
                             
        
End Function
        
        '------------------------------------------------------------
        '说明:  向写E2PRom数据
        '参数:  BgnAdr_L 开始写数据低地址、BgnAdr_H 开始写数据高地址、
        '       WriteDate 所写数据
        '返回:  0 为发送数成功，1为发送数据失败
        '------------------------------------------------------------
Function WriteE2PRom(ByVal BgnAdr_L As Integer, ByVal BgnAdr_H As Integer, ByVal WriteDate As String)
    Dim nFrameLen As Integer                 '帧长度变量
    Dim nFrameNum As Integer                 '帧数
    Dim nFrameLeave As Integer               '最后一帐数据长度
    Dim cAFrameOrder(63) As Byte             '发送数据缓冲区
    Dim ComBuf(7)   As Byte                  '命令缓冲区
    Dim nBgnAdr_l As Integer                 '发送数据低地址
    Dim nBgnAdr_h As Integer                 '发送数据高地址
    Dim nLen  As Integer                     '发送数据长度
    Dim i As Integer
    Dim j As Integer
       
    WriteE2PRom = 1
    nFrameLen = 64                            '每帧发送八个数据
    nBgnAdr_l = BgnAdr_L
    nBgnAdr_h = BgnAdr_H
      
    nLen = Len(WriteDate)                    '取字符串长度
    If nLen > 0 Then
        nFrameNum = Int(nLen / nFrameLen)