COM-Port API
Florian Brucker
da ich nur vb-standard hab und das mscomm da nicht dabei ist (ich arbeite
sowieso lieber mit apis als mit ocxs) würde mich interessieren, auf welchen
apis das control aufsetzt - beim winsock.ocx z.b. das winsock-api. in meinem
allapi.net-api-viewer hab' ich nichts entsprechendes gefunden.
ich will bytes an com senden und empfangen.
danke!
greetings:florian
Olaf Donker
aufgehoben falls ich sowas mal brauche. Ich habe das aber nie
ausprobiert!
Olaf
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
Public Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const INVALID_HANDLE_VALUE = -1&
Public Const OPEN_EXISTING = 3
Public Const NOPARITY = 0
Public Const ONESTOPBIT = 0
Public Const EV_CTS = &H8 ' CTS changed state
Public Const EV_DSR = &H10 ' DSR changed state
Public Const EV_RXCHAR = &H1 ' Any Character received
Public Const EV_RXFLAG = &H2 ' Received certain
character
Public Const EV_TXEMPTY = &H4 ' Transmitt Queue Empty
Declare Function SetCommMask Lib "kernel32" (ByVal hFile As Long, ByVal
dwEvtMask As Long) As Long
Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA"
(lpEventAttributes As Any, ByVal bManualReset As Long, ByVal
bInitialState
As Long, ByVal lpName As Any) As Long
Declare Function WaitCommEvent Lib "kernel32" (ByVal hFile As Long,
lpEvtMask As Long, lpOverlapped As Any) As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal
lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode
As
Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As
Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long)
As
Long
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer
As
Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long,
lpOverlapped As Any) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer
As
Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As
Long,
lpOverlapped As Any) As Long
Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB
As
DCB) As Long
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long,
lpDCB
As DCB) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As
Long)
As Long
Dim dcbVar As DCB
Dim hCom As Long
Dim dwError As Long
Dim fSuccess As Integer
Dim SerialOpen As Boolean
Public Sub InitSerial()
hCom = CreateFile("COM1", GENERIC_READ Or GENERIC_WRITE, _
0, 0&, OPEN_EXISTING, 0, 0)
If hCom = INVALID_HANDLE_VALUE Then
MsgBox "Error: CreateFile()"
Exit Sub
End If
fSuccess = GetCommState(hCom, dcbVar)
If fSuccess = False Then
MsgBox "Error: GetCommState()"
Exit Sub
End If
dcbVar.BaudRate = 9600
dcbVar.ByteSize = 8
dcbVar.Parity = NOPARITY
dcbVar.StopBits = ONESTOPBIT
fSuccess = SetCommState(hCom, dcbVar)
If fSuccess = False Then
MsgBox "Error: SetCommState()"
Exit Sub
Else
SerialOpen = True
End If
End Sub
Public Sub WriteSerialByte(byOut As Byte)
Dim lBuffer As Long
lBuffer = byOut
fSuccess = WriteFile(hCom, lBuffer, 1, lBytesWritten, 0&)
If fSuccess = False Then
MsgBox "Error: WriteFile()"
End If
End Sub
Public Sub CloseSerial()
fSuccess = CloseHandle(hCom)
If fSuccess = False Then
MsgBox "Error: CloseHandle()"
End If
End Sub
Public Function ReceiveSerialByte() As Byte
Dim lBuffer As Long
Dim hEvent As Long
Dim lEventMask As Long
Dim o As OVERLAPPED
fSuccess = SetCommMask(hCom, EV_RXCHAR)
If fSuccess = False Then
MsgBox "Error: SetCommMask()"
End If
o.hEvent = CreateEvent(0&, False, False, 0&)
If fSuccess = False Then
MsgBox "Error: CreateEvent()"
End If
If WaitCommEvent(hCom, lEventMask, o) <> 0 Then
fSuccess = ReadFile(hCom, lBuffer, 1, lBytesRead, 0&)
ReceiveSerialByte = CByte(lBuffer)
End If
End Function
schloti
es gibt auch gute DLLs (Freeware), die die Funktionen kapseln...z.B. die
RASAPI.DLL...eine DLL (habe ich nicht gecoded) findest Du auf meiner Page,
Rubrik Downloads...
cu,
schloti