?? mscommprocess.bas
字號:
Attribute VB_Name = "MsCommProcess"
Option Explicit
'depend on MSComm, General.bas, Parity.bas
Public Type COMMTIMEOUTS
ReadIntervalTimeout As Long
ReadTotalTimeoutMultiplier As Long
ReadTotalTimeoutConstant As Long
WriteTotalTimeoutMultiplier As Long
WriteTotalTimeoutConstant As Long
End Type
Declare Function SetCommTimeouts Lib "kernel32" _
(ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function GetCommTimeouts Lib "kernel32" _
(ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Public timeouts As COMMTIMEOUTS
Public Sub OpenAndAdjustPort(comMS As MSComm)
'Check Err after it.
Dim lRet As Long
On Error Resume Next
With comMS
CloseMsComm comMS, 50
lRet = GetCommTimeouts(.CommID, timeouts)
timeouts.ReadIntervalTimeout = 1000 * 15 \ Val(.Settings) + 100
timeouts.ReadTotalTimeoutMultiplier = 1000 * 15 \ Val(.Settings) + 100
timeouts.ReadTotalTimeoutConstant = 1000
timeouts.WriteTotalTimeoutMultiplier = 1000 * 15 \ Val(.Settings) + 100
timeouts.WriteTotalTimeoutConstant = 1000
lRet = SetCommTimeouts(.CommID, timeouts)
OpenMsComm comMS, 50
End With
End Sub
Public Function GetComStatus(comMS As MSComm) As String
Dim strTmp As String
With comMS
strTmp = "COM" + Trim(Str(.CommPort)) + "; "
strTmp = strTmp + .Settings + "; "
If .DTREnable = True Then
strTmp = strTmp + "DTR=Enable; "
Else
strTmp = strTmp + "DTR=Disable; "
End If
If .RTSEnable = True Then
strTmp = strTmp + "RTS=Enable; "
Else
strTmp = strTmp + "RTS=Disable; "
End If
If .PortOpen = True Then
strTmp = strTmp + "Open"
Else
strTmp = strTmp + "Close"
End If
End With
GetComStatus = strTmp
End Function
Public Sub OpenMsComm(comMS As MSComm, nDelay As Integer)
'Check Err after it.
On Error Resume Next
With comMS
If .PortOpen = False Then
.PortOpen = True
If nDelay > 0 Then DelayTime nDelay 'Very important!
End If
End With
End Sub
Public Sub CloseMsComm(comMS As MSComm, nDelay As Integer)
With comMS
If .PortOpen = True Then
comMS.PortOpen = False
If nDelay > 0 Then DelayTime nDelay
End If
End With
End Sub
Public Function SendData(comMS As MSComm, ByVal strHexData As String, nParity As Integer, nEnd As Integer) As String
Dim strTmp As String
On Error Resume Next
With comMS
If .PortOpen = False Then
MsgBox "The port is close!", vbCritical + vbOKOnly
Exit Function
End If
strTmp = GetFullPackage(strHexData, nParity, nEnd)
.Output = HexCharsToVariant(strTmp)
End With
SendData = strTmp
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -