Imports System.Text
Imports System.IO
Imports System.Threading
Public Class Rs232
Structure COMMTIMEOUTS
Dim ReadIntervalTimeout As Long
Dim ReadTotalTimeoutMultiplier As Long
Dim ReadTotalTimeoutConstant As Long
Dim WriteTotalTimeoutMultiplier As Long
Dim WriteTotalTimeoutConstant As Long
End Structure
Public Const GENERIC_ALL = &H10000000
Public Const OPEN_EXISTING = 3
Private Declare Function CloseHandle Lib “kernel32” (ByVal hObject As Integer) As Integer
Private Declare Function GetLastError Lib “kernel32” () As Integer
Private Declare Function ReadFile Lib “kernel32” (ByVal hFile As Integer, ByRef lpBuffer As Byte, ByVal nNumberOfBytesToRead As Integer, ByRef lpNumberOfBytesRead As Integer, ByVal lpOverlapped As Integer) As Integer
Private Declare Function WriteFile Lib “kernel32” (ByVal hFile As Integer, ByRef lpBuffer As Byte, ByVal nNumberOfBytesToWrite As Integer, ByRef lpNumberOfBytesWritten As Integer, ByVal lpOverlapped As Integer) As Integer ‘OVERLAPPED
Private Declare Function CreateFile Lib “kernel32” Alias “CreateFileA” (ByVal lpFileName As String, ByVal dwDesiredAccess As Integer, ByVal dwShareMode As Integer, ByVal lpSecurityAttributes As Integer, ByVal dwCreationDisposition As Integer, ByVal dwFlagsAndAttributes As Integer, ByVal hTemplateFile As Integer) As Integer
Private Declare Function GetFileSize Lib “kernel32” Alias “GetFileSize” (ByVal hFile As Integer, ByRef lpFileSizeHigh As Integer) As Integer
Private Declare Function SetCommTimeouts Lib “Kernel32” (ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As Integer
Dim m_hCom, ComID As Integer
Sub New(ByVal COM As Integer)
ComID = COM
Create()
End Sub
Sub Create()
m_hCom = CreateFile(“COM” & ComID.ToString, GENERIC_ALL, 0, Nothing, OPEN_EXISTING, 0, 0)
Dim Timeout As COMMTIMEOUTS
Timeout.ReadIntervalTimeout = 100
Timeout.ReadTotalTimeoutConstant = 100
Timeout.ReadTotalTimeoutMultiplier = 0
Timeout.WriteTotalTimeoutConstant = 100
Timeout.WriteTotalTimeoutMultiplier = 0
SetCommTimeouts(m_hCom, Timeout)
LastError()
End Sub
ReadOnly Property hCom() As Integer
Get
Return m_hCom
End Get
End Property
Function Write(ByVal Data As String) As Integer
Dim Ret As Integer
Dim Byts() = Encoding.Default.GetBytes(Data & vbCr)
Return WriteFile(m_hCom, Byts(0), Byts.Length, Ret, 0)
End Function
Function Read() As String
Dim Byts(8192) As Byte
Dim Ret As Integer
ReadFile(m_hCom, Byts(0), Byts.Length, Ret, 0)
ReDim Preserve Byts(Ret)
Return Encoding.Default.GetString(Byts)
End Function
Sub Close()
CloseHandle(m_hCom)
End Sub
Sub LastError()
‘从某文件读取Win32API错误列表, 然后输出中文错误信息。
Dim foo = GetLastError()
If foo = 0 Then
Return
End If
Using Rd As New StreamReader(“Win32Err.txt”)
Do While Not Rd.EndOfStream
Dim Line = Split(Rd.ReadLine, ” “)
If Val(Line(0)) = foo Then
Throw New Exception(Line(1))
End If
Loop
End Using
End Sub
End Class
代码使用了Win32API这神奇的东西, 有1问题, 读的时候读空会卡死, Timeout就没用了。
发表评论