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結(jié)構(gòu)
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) '清輸出緩沖區(qū)
lRet = PurgeComm(lHandle, 0) '清輸入緩沖區(qū)
lRet = GetCommState(lHandle, lpDCB) '獲得通訊口的狀態(tài)
Shand:
writebuff$ = Chr$(&H8F)
lRet = WriteFile(lHandle, writebuff$, 1, Nchars, lpOverlapped) '送握手信號入串口緩沖區(qū)
If lRet <= 0 Then
MsgBox "發(fā)送操作出錯，飯卡握手信號未發(fā)送成功", 16
GoTo Shand '不成功則重發(fā)
Else
GoTo Qtest
End If
GoTo Shand
Qtest:
Readbuff$ = "" '清緩沖區(qū)為空
Do While lHandle '循環(huán)查詢串口
RNum = 0 '設置讀串口次數(shù)的指針為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次串口，以免陷入死循環(huán)
MsgBox "飯卡沒有插接好或電卡沒有接在串口上！"
GoTo CloseP
End If
RNum = RNum + 1
GoTo ReadAgain
End If
If Hex$(Asc(Readbuff)) <> Hex$(&HFF) Then
GoTo Shand '回送碼不正確則返回繼續(xù)發(fā)送握手信號
Else
label1.Caption = "握手信號是：" + Hex$(Asc(Readbuff$))
MsgBox "握手信號正確，已正確聯(lián)機"
GoTo CloseP
End If
Loop
CloseP: lRet = CloseHandle(lHandle)
If lRet = 0 Then
MsgBox "串行通迅口關閉成功", 48, "提示窗口"
End If
End Sub