|
|
你可以用 VB6 Serial API class
- Option Explicit
- '// WIN32API Function
- '//Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
- Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
- Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
- Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
- Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
- Private Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long
-
- '// WIN32API Structure
- Private 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
-
- '// WIN32API Constant
- Private Const GENERIC_READ = &H80000000
- Private Const GENERIC_WRITE = &H40000000
- Private Const OPEN_EXISTING = 3
- Private Const FILE_FLAG_OVERLAPPED = &H40000000
- Private Const INVALID_HANDLE_VALUE = -1
- Private Const NOPARITY = 0
- Private Const ONESTOPBIT = 0
- Private Const FILE_FLAG_NO_BUFFERING = &H20000000
-
- '// Comm Port Handle
- Private hComm As Long
-
- Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
- '// Close the opened Comm
- If hComm <> 0 Then CloseHandle (hComm)
- End Sub
-
- Private Sub CmdAction_Click(Index As Integer)
- Dim Idx As Integer
- Select Case Index
- Case 0 '// Open/Close
- If CmdAction(0).Caption = "&Open" Then
- If OpenPort(txtCOMM(0).Text, CLng(txtCOMM(1).Text), CLng(txtCOMM(2).Text)) <> 0 Then
- CmdAction(0).Caption = "&Cancel"
- For Idx = 0 To 2: txtCOMM(Idx).Enabled = False: Next
- txtData.Enabled = True
- CmdAction(1).Enabled = True
- lblStatus.Caption = "Open Port Successful: Hanlde -> " & hComm
- Else
- lblStatus.Caption = "Fail to open port!!!"
- End If
- Else
- CloseHandle (hComm)
- CmdAction(0).Caption = "&Open"
- For Idx = 0 To 2: txtCOMM(Idx).Enabled = True: Next
- txtData.Enabled = False
- CmdAction(1).Enabled = False
- lblStatus.Caption = "Port Closed"
- End If
- Case 1 '// Send
- Write2Port txtData.Text
- End Select
-
- End Sub
-
- Private Function OpenPort(ByVal strPort As String, ByVal lngBaudRate As String, ByVal lngDataBit As Long) As Long
- Dim pDCB As DCB
- Dim lpPort As String
-
- '// Create Comm Name Buffer
- '//lpPort = String(6, Chr(0))
- '//Mid$(lpPort, 1, 6) = "COM" & strPort & ":"
-
- lpPort = "\\.\COM" + strPort + vbNullChar
-
- '// Close the current opened Comm Port (If any)
- If hComm > 0 Then CloseHandle (hComm)
-
- '// Open selected comm port
- '//hComm = CreateFile(lpPort, _
- '// GENERIC_READ Or GENERIC_WRITE, _
- '// 0, _
- '// vbNull, _
- '// OPEN_EXISTING, _
- '// 0, _
- '// vbNull)
-
- hComm = CreateFile(lpPort, _
- GENERIC_READ Or GENERIC_WRITE, _
- 0, _
- ByVal 0, _
- OPEN_EXISTING, _
- FILE_FLAG_NO_BUFFERING, _
- 0)
-
- If hComm <> INVALID_HANDLE_VALUE Then
- pDCB.DCBlength = Len(pDCB)
-
- '// Retrieve default Comm port settings
- GetCommState hComm, pDCB
-
- '// Configure new Comm port settings
- With pDCB
- .BaudRate = lngBaudRate
- .Parity = NOPARITY
- .ByteSize = lngDataBit
- .StopBits = ONESTOPBIT
- .EofChar = 0
- .ErrorChar = 0
- .EvtChar = 0
- .fBitFields = 20625
- .XoffChar = 19
- .XoffLim = 512
- .XonChar = 17
- .XonLim = 2048
- End With
-
- '// Set new configure Comm port settings
- If SetCommState(hComm, pDCB) = 0 Then
- CloseHandle (hComm)
- OpenPort = 0
-
- MsgBox "Fail to configure serial port!", vbExclamation + vbOKOnly, "Error"
- Else
- OpenPort = hComm
- End If
- Else
- CloseHandle (hComm)
- OpenPort = 0
- End If
- End Function
-
- Private Sub Write2Port(ByVal strData As String)
- Dim dwByteWrite As Long
- Dim Sz As Long, Idx As Long
- Dim Bytes() As Byte
-
- '// Create & Convert str into array of Byte
- Sz = Len(strData)
- ReDim Bytes(Sz) As Byte
- For Idx = 1 To Sz
- Bytes(Idx) = Asc(Mid$(strData, Idx, 1))
- Next
-
- '// Write data into Open Comm Port
- If hComm <> INVALID_HANDLE_VALUE Then
- WriteFile hComm, _
- Bytes(1), _
- UBound(Bytes), _
- dwByteWrite, _
- ByVal 0&
- Else
- MsgBox "Invalid port handle", vbExclamation + vbOKOnly, "Error"
- End If
-
- Erase Bytes
-
- End Sub
|
評分
-
查看全部評分
|
QQ好友和群
QQ空間
騰訊微博
騰訊朋友
收藏
淘帖
頂
踩
