zlgcomport.bas

这个的用于DP51单片机的串口通讯的系列程序

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

                
                
                
'*************************************************************************
'*                      声明引用 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数据
        '参数:  DpAdr DP-51地址、BgnAdr_L 开始读数据低地址、
        '        BgnAdr_H 开始读数据高地址、nLen   读数据长度
        '返回:  有字符串返回表示读数据成功，1为读数据失败
        '------------------------------------------------------------
Function ReadE2PRom(ByVal DpAdr As Integer, 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(7) 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) = &H5
        cAFrameOrder(3) = DpAdr              'DP-51地址
        cAFrameOrder(4) = nBgnAdr_l           '取发送地址
        cAFrameOrder(5) = nBgnAdr_h
        cAFrameOrder(6) = 8                   '读取数据长度
        
           cAFrameOrder(7) = 0               '计算校验和
        For j = 0 To 6
          cAFrameOrder(7) = cAFrameOrder(7) 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
                 St = ErrManage(cAFrameAck(2), cAFrameAck(3), 0) '取返回错误帧数据
                  ReadE2PRom = ""              '清空接收数据
                  Exit Function
              End If

        Else
            St = ErrManage(cAFrameAck(2), cAFrameAck(3), 0) '取返回错误帧数据
            ReadE2PRom = ""              '清空接收数据
          Exit Function
        End If
    Next i
     
     
     
    If nFrameLeave > 0 Then
        cAFrameOrder(0) = &H12                '发最后一帧数据
        cAFrameOrder(1) = &H20
        cAFrameOrder(2) = &H5
        cAFrameOrder(3) = DpAdr               'DP-51地址
        cAFrameOrder(4) = nBgnAdr_l           '取发送地址
        cAFrameOrder(5) = nBgnAdr_h
        cAFrameOrder(6) = nFrameLeave
        
           cAFrameOrder(7) = 0               '计算校验和
        For j = 0 To 6
          cAFrameOrder(7) = cAFrameOrder(7) 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
                  St = ErrManage(cAFrameAck(2), cAFrameAck(3), 0) '取返回错误帧数据
                  ReadE2PRom = ""              '清空接收数据
                   Exit Function
           End If

        Else
            St = ErrManage(cAFrameAck(2), cAFrameAck(3), 0) '取返回错误帧数据
            ReadE2PRom = ""              '清空接收数据
          Exit Function
        End If
     End If
       ReadE2PRom = Str
                             '返回字符串
        
End Function
        
        '------------------------------------------------------------
        '说明:  向写E2PRom数据
        '参数:  DpAdr DP-51地址、BgnAdr_L 开始写数据低地址、
        '       BgnAdr_H 开始写数据高地址、WriteDate 所写数据
        '返回:  0 为发送数成功，1为发送数据失败
        '------------------------------------------------------------
Function WriteE2PRom(ByVal DpAdr As Integer, 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(14) 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