tongxun.bas

主要用于控制三相电能表检验装置

Attribute VB_Name = "Module2"
Option Explicit
'此文件主要处理通讯程序，只负责数据的发送、接收，并不对数据进行任何数据
'对于对串口处理将采用API来完成
'通讯处理函数方案
'1、发送      预计有24个串口，可以同时操作，每次发送最大1024个字节，估计发送缓冲有24*1024，但此类情况少见
'             建立有128字节为单位的缓冲块，13*8（104）个缓冲单位 由以下单位来管理
                Public TxOutBuff(23, 599) As Byte '发送数据缓冲512+50
                 
                Type CommDealWithTx
                    Comm As String  '需要发送的串口
                    'KuaiN As Byte   '起始块号 0时，表示无相关数据要发送
                    DataLen As Long '要发送的数据长度
                End Type
                Public CommDWOut(23) As CommDealWithTx  '104个
                Public CommScan  As Byte '循环扫描
              '间隔0.5对以上缓冲进行数据扫描
'2、接收      间隔0.5扫描接收的数据，判断接收完毕标准是：前次接收到，后次扫描没有接收到数据，这样来确定一帧数据接收完毕接收
            '当接收到数据后，立即将以消息的方式发送到指定的窗体
                Type CommDealWithRx
                    Comm As String  '需要接收的串口
                    RxInBuff(599) As Byte '接收数据缓冲
                    DataLen As Integer  '接收数据的数据长度
                End Type
                    Public CommDWIn(24) As CommDealWithRx '13个串口
'串口的收发，将单独作为一个进程来处理

'CreateFile
'ReadFile
'WriteFile
'SetCommTimeouts
'GetCommState
'SetCommState
'SetupComm
'PurgeComm
'SetCommMask
'WaitCommEvent
'//定义与API函数匹配的结构
Type DCB
     DCBlength As Long
     BaudRate As Long
     fBitFields As Long 'See Comments in Win32API.Txt
     wReserved As Integer
     XonLim As Integer
     XoffLim As Integer
     ByteSize As Byte
     Parity As Byte
     StopBits As Byte
     XonChar As Byte
     XoffChar As Byte
     ErrorChar As Byte
     EofChar As Byte
     EvtChar As Byte
     wReserved1 As Integer 'Reserved; Do Not Use
End Type
Type COMSTAT
     fBitFields As Long 'See Comment in Win32API.Txt
     cbInQue As Long
     cbOutQue As Long
End Type
Public Type OVERLAPPED
   Internal As Long
   InternalHigh As Long
   offset As Long
   OffsetHigh As Long
   hEvent As Long
End Type

Public Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

Public Type COMMTIMEOUTS
   ReadIntervalTimeout As Long
   ReadTotalTimeoutMultiplier As Long
   ReadTotalTimeoutConstant As Long
   WriteTotalTimeoutMultiplier As Long
   WriteTotalTimeoutConstant As Long
End Type
'//////////////////////////////////////////
'Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
'Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
Public Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Public Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long
Public Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Public Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Public Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare Function SetCommMask Lib "kernel32" (ByVal hFile As Long, ByVal dwEvtMask As Long) As Long
Public Declare Function WaitCommEvent Lib "kernel32" (ByVal hFile As Long, lpEvtMask As Long, lpOverlapped As OVERLAPPED) As Long
Public Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Public Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long '发送消息
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'------------------------Const变量定义--------------Begin
Public Const GENERIC_WRITE = &H40000000
Public Const GENERIC_READ = &H80000000
Public Const OPEN_EXISTING = 3
Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80
'------------------------Const变量定义--------------end
Type CommSetN
    Comm As String '串口号码
    LHdcComm As Long
End Type
    Public CommSetJ(23) As CommSetN
    Dim CommSetNMax As Byte
    Function Commucation_Main() '通讯主函数
         
        
        Commucation_Init  '通讯参数初试化
        
        
         
    End Function
 Function Open_Comm() '打开各个串口
    Commucation_Init
        Dim i As Byte
     Dim j As Long
             j = 1
             'Form1.Label1.Caption = "打开各个端口的配置"
             Form1.List1.Clear
             For i = 0 To 11
                If (BiaoWeiNum And j) = j Then '表位设置控制
                    If BiaoWei(i).Comm <> "" Then
                        If SetComm(BiaoWei(i).Comm, BiaoWei(i).Peizhi, i) = 0 Then
                            'msgbox("")
                            Form1.List1.AddItem "表位" & Str$(i + 1) & "打开不成功"
                            BiaoWei(i).Comm = ""
                            BiaoWei(i).Peizhi = ""
                        Else
                            Form1.List1.AddItem "表位" & Str$(i + 1) & "打开成功"
                        End If
                    End If
                End If
                j = j + j
             Next i
 End Function
 Function Commucation_Init()
    Dim i As Byte
    For i = 0 To 23
        CommSetJ(i).Comm = ""
        CommSetJ(i).LHdcComm = 0
    Next i
    CommSetNMax = 0
    For i = 0 To 23
        CommDWOut(i).Comm = ""
        CommDWOut(i).DataLen = 0
        
    Next i
    CommScan = 0
 End Function
 
Function SetComm(Comm As String, Peizhi As String, Ptr As Byte) As Long '打开某个串口
         Dim lLngHdcComm As Long
         Dim lInttmp As Long
         Dim lTypHdc As DCB
         Dim sec  As SECURITY_ATTRIBUTES '文件保密方式
         sec.bInheritHandle = True
         sec.lpSecurityDescriptor = 0
         sec.nLength = Len(sec) '"\\.\" & Comm
         lLngHdcComm = CreateFile("\\.\" & Comm, GENERIC_WRITE Or GENERIC_READ, 0&, sec, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0&) 'FILE_FLAG_OVERLAPPED
         If lLngHdcComm = -1 Then
            SetComm = 0
            Exit Function
        End If
        Dim i As Byte
        For i = 0 To 23
            If CommSetJ(i).Comm = "" Then
              CommSetJ(i).Comm = Comm
              CommSetJ(i).LHdcComm = lLngHdcComm '保存串口的使用情况
              CommDWIn(Ptr).Comm = Comm
              CommNUM = CommNUM + 1
              Exit For
            End If
        Next i
        lInttmp = GetCommState(lLngHdcComm, lTypHdc)
        If lInttmp = 0 Then
           SetComm = 0
           Exit Function
        End If
        lInttmp = BuildCommDCB(Peizhi, lTypHdc)
        If lInttmp = 0 Then
           SetComm = 0
           Exit Function
        End If
        lInttmp = SetCommState(lLngHdcComm, lTypHdc)
        If lInttmp = 0 Then
           SetComm = 0
           Exit Function
        End If
        
       SetComm = lLngHdcComm
End Function
Function Cloas_comm()
    Dim i As Byte
    For i = 0 To 23
        If CommSetJ(i).Comm <> "" Then
            CloseComm CommSetJ(i).Comm
        End If
    Next i
End Function
Function CloseComm(Comm As String)
    Dim i As Byte
    For i = 0 To 23
        If CommSetJ(i).Comm = Comm Then
            CloseHandle CommSetJ(i).LHdcComm
            CommSetJ(i).LHdcComm = 0
            CommSetJ(i).Comm = ""
            Exit For
        End If
    Next i
End Function
 Function AjustStep()
    ID = BiaoShuJuID(DangQianHang1, i, DataString)
    If ID = "FFFF" Then
        DangQianHang1 = 0
    Else
        ZuZheng ID, datad, 0, 2 '写参数
        'DangQianHang1 = DangQianHang1 + 1
    End If
 End Function
Function fa_Main()
    Dim i As Byte
    Dim j As Long
   
    Dim DataLen As Integer
    Dim Comm As String
   ' Dim outdata(599) As Byte
    Dim lIntRet As Integer
    Dim CRC As Long
    
    'Dim FileH As Long
    'Dim lLngWrited As Long
    'Dim lOvlWrite As OVERLAPPED
    'outdata(0) = &H68
    'outdata(1) = &H1 '读电压参数
    'outdata(2) = &H2 '固定长度
    'outdata(3) = &H1F 'TempData(1) '低位在前
    'outdata(4) = &HB6 'TempData(0) '高位在后
    'outdata(5) = 1
    'outdata(6) = 1
    'CRC = CRC_Cal(0, outdata, 7) '计算CRC
    'outdata(7) = CRC And &HFF
    'CRC = CRC And &HFF00
    'CRC = CRC / 256
    'outdata(8) = CRC And &HFF
    'outdata(9) = &H16
    'Comm = "COM4"
    'DataLen = 11
    'FileH = GetCommFileH(Comm)
    'lIntRet = WriteFile(CommSetJ(FileH).LHdcComm, outdata(0), DataLen, lLngWrited, lOvlWrite) '//发送数据
    For i = 0 To 23
        If CommDWOut(i).Comm <> "" Then
                DataLen = CommDWOut(i).DataLen
                Comm = CommDWOut(i).Comm
                CommDWOut(i).Comm = ""
                CommDWOut(i).DataLen = 0
            If DataLen > 0 Then
                    For j = 0 To DataLen - 1
                        outdata(j) = TxOutBuff(i, j)
                    Next j
                    Dim FileH As Long
                    Dim lLngWrited As Long
                    Dim lOvlWrite As OVERLAPPED
                    FileH = GetCommFileH(Comm)
                    If FileH = -1 Then
                        'Main.List2.AddItem Comm & "未打开"
                        Exit Function