vb.net读写串口代码

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就没用了。

发表评论

注意 - 你可以用以下 HTML tags and attributes:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

:wink: :twisted: :roll: :oops: :mrgreen: :lol: :idea: :evil: :cry: :arrow: :?: :-| :-x :-o :-P :-D :-? :) :( :!: 8-O 8)

本文链接:https://twd2.me/archives/444QrCode