module1.bas

vb api 进行串口通信

Attribute VB_Name = "Module1"
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_EXISTING = 3
Public Const COM1 = &H3F8
Public Const FILE_FLAG_OVERLAPPED = &H40000000

Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type
Public 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
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
Public Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) 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 GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long
Public Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Function OpenThePort(cPort As String, cBaud As String, cParity As String, cData As String, tStops As String) As Boolean
Dim lResult As Long
Dim lHandle As Long
Dim DCB_COMM As DCB
Dim cDCBConfig As String
Dim JFQ As SECURITY_ATTRIBUTES
'JFQ = Null
'lHandle = CreateFile(COM1, GENERIC_READ Or GENERIC_WRITE, 0, JFQ, OPEN_EXISTING, 0, 0)
lHandle = CreateFile(cPort, GENERIC_READ Or GENERIC_WRITE, 0, JFQ, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0)
If lHandle = -1 Then
OpenThePort = False
MsgBox "串口可能正被其他应用程序占用！"
lResult = CloseHandle(lHandle)   '先关闭串口后再打开
If lResult = 0 Then
OpenThePort = True
Exit Function
End If
End If
'cDCBConfig.band = 2400 '设置DCB
'cDCBConfig.parity = None
'cDCBConfig.Data = 8
'cDCBConfig.stop = 1
lResult = BuildCommDCB(cDCBConfig, DCB_COMM) '按用户设定配置一个DCB结构
If lResult = 0 Then
OpenThePort = False
MsgBox "无法建立DCB设备控制块"
Exit Function
End If
lResult = SetCommState(lHandle, DCB_COMM) '实际设置一个串口的DCB
If lResult = 0 Then
OpenThePort = False
MsgBox "无法建立DCB设备控制块"
Exit Function
End If
OpenThePort = True
End Function
Public Sub SendHand()
Dim Nchars As Long
Static Readbuff As String * 1
Static writebuff As String * 1
Dim lpDCB As DCB
Dim lRet As Long
Dim lHandle As Long
Dim lpOverlapped As OVERLAPPED
Dim RNum As Integer

MsgBox "请把饭卡读卡器插在串口1上！", 48, "提示窗口"
lHandle = OpenThePort("COM1", 9600, "None", 8, 1)
lRet = PurgeComm(lHandle, 1) '清输出缓冲区
lRet = PurgeComm(lHandle, 0) '清输入缓冲区
lRet = GetCommState(lHandle, lpDCB) '获得通讯口的状态
Shand:
writebuff$ = Chr$(&H8F)
lRet = WriteFile(lHandle, writebuff$, 1, Nchars, lpOverlapped) '送握手信号入串口缓冲区
If lRet <= 0 Then
MsgBox "发送操作出错，饭卡握手信号未发送成功", 16
GoTo Shand '不成功则重发
Else
GoTo Qtest
End If
GoTo Shand
Qtest:
Readbuff$ = "" '清缓冲区为空
Do While lHandle '循环查询串口
RNum = 0 '设置读串口次数的指针为0
ReadAgain:
lRet = ReadFile(lHandle, Readbuff$, 1, Nchars, lpOverlapped)
If lRet < 0 Then
MsgBox "请取应答信号出错", 16
End If
If lRet = 0 Then
If RNum > 1000 Then '只读1000次串口，以免陷入死循环
MsgBox "饭卡没有插接好或电卡没有接在串口上！"
GoTo CloseP
End If
RNum = RNum + 1
GoTo ReadAgain
End If
If Hex$(Asc(Readbuff)) <> Hex$(&HFF) Then
GoTo Shand '回送码不正确则返回继续发送握手信号
Else
label1.Caption = "握手信号是：" + Hex$(Asc(Readbuff$))
MsgBox "握手信号正确，已正确联机"
GoTo CloseP
End If
Loop
CloseP: lRet = CloseHandle(lHandle)
If lRet = 0 Then
MsgBox "串行通迅口关闭成功", 48, "提示窗口"
End If
End Sub