'//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"
