zlgcomport.bas

嵌入式系统中一些外围设备驱动示例程序集

Attribute VB_Name = "ZlgComPort_Module"
'            /*
'             ************************************************************************
'             *
'             *  Copyright(c) 2002, 周立功单片机发展有限公司
'             *                   All rights reserved.
'             *
'             *     文   件: ZlgComPort_Module.bas
'             *
'             *     摘   要: 本程序主要是演示ZmpCom.dll API函数调用方法
'             *
'             *
'             *     创建日期:  2002年10月26日
'             *
'             *************************************************************************
'             */

                
                
                
'*************************************************************************
'*                      声明引用 ZlgComPort API函数
'*************************************************************************
                
        '------------------------------------------------------------
        '说明:  设置通信波特率
        '参数:  Baud  波特率(bit)
        '返回:  True 设置波特率成功、False 设置波特率失败
        '------------------------------------------------------------
Declare Function SetCommBaud Lib "ZlgComPort.dll" (ByVal Baud As Integer) As Boolean

        '------------------------------------------------------------
        '说明:  设置通信端口
        '参数:  Port  通信端口号(1-4)
        '返回:  True 设置通信端口成功、False 设置通信端口失败
        '------------------------------------------------------------
Declare Function SetCommPort Lib "ZlgComPort.dll" (ByVal Port As Integer) As Boolean

        '------------------------------------------------------------
        '说明:  打开通信端口
        '参数:  无
        '返回:  0 打开通信端口成功、非0打开通信端口失败
        '------------------------------------------------------------
Declare Function OpenPort Lib "ZlgComPort.dll" () As Integer

        '------------------------------------------------------------
        '说明:  关闭当前通信端口
        '参数:  无
        '返回:  0 关闭当前通信端口成功、非0关闭当前通信端口失败
        '------------------------------------------------------------
Declare Function ClosePort Lib "ZlgComPort.dll" () As Integer

        '------------------------------------------------------------
        '说明:  发送数据命令
        '参数:  pOrderBuff  发送数据首地址、pAckBuff 接收数据首地址、
        '       nTimeOuts 发送命令超时
        '返回:  0 发送数据成功、非0发送数据失败
        '------------------------------------------------------------
Declare Function SendOrder Lib "ZlgComPort.dll" (ByRef pOrderBuff As Byte, ByRef pAckBuff As Byte, ByVal nTimeOuts As Integer) As Integer




'*************************************************************************
'*                      声明引用系统API函数
'*************************************************************************
        
        '------------------------------------------------------------
        '说明:  挂起当前线程
        '参数:  dwMilliseconds  挂起时间(毫秒)
        '返回:  无
        '------------------------------------------------------------
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)




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


Public st As Long                              '接收发送数据命返回值
Public PortOpen As Boolean                     '串口打开标致
Public stbl As Boolean                         '接收端口设置状态





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

        '------------------------------------------------------------
        '说明:  读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 cAFrameOrder(6) As Byte              '发送数据缓冲区
    Dim cAFrameAck(13) 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 = ""
    nFrameLen = 8                            '每帧接收八个数据
    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                   '发送nFrameNum帧数据
        cAFrameOrder(0) = &H12
        cAFrameOrder(1) = &H20
        cAFrameOrder(2) = &H4
        cAFrameOrder(3) = nBgnAdr_l           '取发送地址
        cAFrameOrder(4) = nBgnAdr_h
        cAFrameOrder(5) = 8
        
           cAFrameOrder(6) = 0               '计算校验和
        For j = 0 To 5
          cAFrameOrder(6) = cAFrameOrder(6) Xor cAFrameOrder(j)
        Next j
        
        nBgnAdr_l = nBgnAdr_l + 8             '计算下一个地址

        
        st = SendOrder(cAFrameOrder(0), cAFrameAck(0), 1000)
        Sleep 100                              '挂起100毫秒
        
        If st = 0 Then                         '判断发送数据是否正确
              If cAFrameAck(1) = &HA0 Then
                  For j = 1 To nFrameLen
                    Str = Str + Chr(cAFrameAck(2 + j))
                  Next j
              Else
                  ReadE2PRom = ""
                  Exit Function
              End If

        Else
           ReadE2PRom = ""
          Exit Function
        End If
    Next i
     
     
     
    If nFrameLeave > 0 Then
        cAFrameOrder(0) = &H12                '发最后一帧数据
        cAFrameOrder(1) = &H20
        cAFrameOrder(2) = &H4
        cAFrameOrder(3) = nBgnAdr_l           '取发送地址
        cAFrameOrder(4) = nBgnAdr_h
        cAFrameOrder(5) = nFrameLeave
        
           cAFrameOrder(6) = 0               '计算校验和
        For j = 0 To 5
          cAFrameOrder(6) = cAFrameOrder(6) Xor cAFrameOrder(j)
        Next j
        
        
        st = SendOrder(cAFrameOrder(0), cAFrameAck(0), 1000)
        Sleep 100                              '挂起100毫秒
        
        If st = 0 Then                         '判断发送数据是否正确
           If cAFrameAck(1) = &HA0 Then
                  For j = 1 To nFrameLeave
                    Str = Str + Chr(cAFrameAck(2 + j))
                  Next j
           Else
                   ReadE2PRom = ""
                   Exit Function
           End If

        Else
           ReadE2PRom = ""
          Exit Function
        End If
     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(13) As Byte             '发送数据缓冲区
    Dim cAFrameAck(4) 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 = 8                            '每帧发送八个数据
    nBgnAdr_l = BgnAdr_L
    nBgnAdr_h = BgnAdr_H
      
    nLen = Len(WriteDate)                    '取字符串长度
    If nLen > 0 Then
        nFrameNum = Int(nLen / nFrameLen)
        nFrameLeave = nLen Mod nFrameLen
    End If
    
    
    For i = 1 To nFrameNum                   '发送nFrameNum帧数据
        cAFrameOrder(0) = &H12
        cAFrameOrder(1) = &H21
        cAFrameOrder(2) = &HB
        cAFrameOrder(3) = nBgnAdr_l           '取发送地址
        cAFrameOrder(4) = nBgnAdr_h
        
        For j = 1 To nFrameLen                '取发送数据
           cAFrameOrder(4 + j) = Asc(Mid(WriteDate, (i - 1) * 8 + j, 1))
        Next j
        
           cAFrameOrder(13) = 0               '计算校验和
        For j = 0 To 12
          cAFrameOrder(13) = cAFrameOrder(13) Xor cAFrameOrder(j)
        Next j
        
        nBgnAdr_l = nBgnAdr_l + 8             '计算下一个地址

        
        st = SendOrder(cAFrameOrder(0), cAFrameAck(0), 1000)
        Sleep 100                              '挂起100毫秒
        
        If st = 0 Then                         '判断发送数据是否正确
              If cAFrameAck(1) = &HA0 Then
                  WriteE2PRom = 0
              Else
                  WriteE2PRom = 1
                   Exit Function
              End If
           
        Else
           WriteE2PRom = 1
          Exit Function
        End If
    Next i
     
     
     
  If nFrameLeave > 0 Then
        cAFrameOrder(0) = &H12                '发最后一帧数据
        cAFrameOrder(1) = &H21
        cAFrameOrder(2) = 3 + nFrameLeave
        cAFrameOrder(3) = nBgnAdr_l           '取发送地址
        cAFrameOrder(4) = nBgnAdr_h
        
        For j = 1 To nFrameLeave              '取发送数据
           cAFrameOrder(4 + j) = Asc(Mid(WriteDate, nFrameNum * 8 + j, 1))
        Next j
        
           cAFrameOrder(nFrameLeave + 5) = 0   '计算校验和
        For j = 0 To nFrameLeave + 4
          cAFrameOrder(nFrameLeave + 5) = cAFrameOrder(nFrameLeave + 5) Xor cAFrameOrder(j)
        Next j
        
        
        st = SendOrder(cAFrameOrder(0), cAFrameAck(0), 1000)
        Sleep 100                              '挂起100毫秒
        
        If st = 0 Then                         '判断发送数据是否正确
           If cAFrameAck(1) = &HA0 Then
                   WriteE2PRom = 0
           Else
                   WriteE2PRom = 1
                   Exit Function
           End If
        Else
           WriteE2PRom = 1
          Exit Function
        End If
 End If
 
End Function
        '------------------------------------------------------------
        '说明:  十六进制字符转为十进制值
        '参数:  HChar 十六进制字符(两位)
        '
        '返回:  返回十进制值
        '------------------------------------------------------------
Function HtoD(ByVal HChar As String)
    Dim Ch1 As Long
    Dim Ch2 As Long
    
    Ch1 = Asc(Left$(HChar, 1))
    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