Serielle Schnittstelle

Download ca. 130 kB Schnittslelle.xls

Download ca. 58 kB Schnittstelle.xlsm

Im Jahr 2003 hatte ich an gleicher Stelle eine Arbeitsmappe veröffentlicht, welche die serielle Schnittstelle rudimentär anspricht. Das heißt, mein Ziel war damals nicht die vollständige Kontrolle über die Schnittstelle, vordringlich wollte ich Ein- bzw. Ausgänge ohne IO-Karte benutzen. Die serielle Schnittstelle bietet dazu ja standardmäßig vier Eingänge und zwei Ausgänge und wenn man die Sendeleitung missbraucht, sogar drei Ausgänge. Das Setzen der Eigenschaften wie Baudrate, etc., oder das Senden und Empfangen von Text waren dabei für mich eher nebensächlich.

Da ich mir aber mittlerweile von Pollin den Bausatz das AVR-Net-IO-Board angeschafft habe und den Ehrgeiz hatte, die Steuerung und die Speicherung der bereitgestellten Daten von Excel erledigen zu lassen , wurde die Mappe noch einmal komplett überarbeitet. Besonders wichtig war mir dabei die Klasse clsCommPort als Arbeitstier, die ich auch nun zum Ansteuern des Boards über die serielle Schnittstelle einsetze. Ich habe zwar ausgiebig getestet, aber dass alle gesetzten Eigenschaften auch tatsächlich angenommen wurden, kann ich trotzdem nicht garantieren.

Momentan existiert auch bereits eine funktionierende Klasse, die das Auslesen und Ansteuern via TCP/IP übernimmt, bevor ich die aber veröffentliche, muss ich dieser aber noch den letzten Schliff verpassen und unter Office 10 zum Laufen bringen. Coming soon!

Die in diesem Beispiel verwendete Userform verwendet alle Methoden der Klasse clsCommPort, liest den gesamten Eigenschaftspool aus und stellt diesen dar. Außerdem können alle Eigenschaften geändert und anschließend zurückgeschrieben werden.

Zur Fehlersuche werden die einzelnen Schritte aufgezeichnet und können bei Bedarf im entsprechenden Textfeld ausgegeben werden. Setzt man die Eigenschaft LogWrite der Klasse auf Wahr, wird alles sofort in eine Textdatei ausgegeben. Defaultmäßig wird der Ordner verwendet, in der sich die Arbeitsmappe befindet, alternativ kann man den Pfad und Dateinamen über die Eigenschaft LogFile selber festlegen.

Bei einem Absturz von Excel, der aber eigentlich nicht vorkommen sollte, hat man so die Möglichkeit, der Ursache näherzukommen. Auf Grund der vielen Steuerelemente zum Visualisieren sieht die Userform aber leider etwas überladen aus.

Office 2010

Office 2010 verwendet eine neue VBA-Version, nämlich VBA 7. Benutzt man keine API-Funktionen, ändert sich zu den vorherigen Versionen nicht viel, der Code bedarf dann auch keinerlei Anpassungen. Ich selbst verwende API-Funktionen aber eher exzessiv, weil vieles, was ich mit Excel anstellen möchte, ohne API-Funktionen ganz einfach nicht funktioniert. Deshalb muss man auch die bedingte Kompilierung einsetzen.

Zum Einen werden unter Office 10 die API-Funktionen etwas anders deklariert, zum Anderen gibt es nun auch 64-Bit Office-Versionen, bei denen ein schnöder Zeiger nun nicht mehr in einen Longwert passt.

Zum Erkennen, ob VBA7 gerade läuft, gibt es nun eine gleichnamige Konstante und zum Erkennen, dass die 64-Bit Version läuft, die Konstante Win64.

#If Win64 Then
   #If VBA7 Then
   #Else
   #End If
#End If

Technisches zur RS 232 Schnittstelle

Kommen wir nun zu ein paar allgemeinen Eigenschaften der seriellen Schnittstelle.

Serielle Schnittstellen an einem PC sind als RS-232 Schnittstellen ausgeführt und halten sich an die für diesen Typ festgelegte Spezifikationen. Bei diesen Schnittstellen gibt es zwei Stecker-Ausführungsformen, einmal 25-polig und einmal 9-polig. Die Funktionen der Steuerleitungen sind bei beiden gleich, nur die Pinbelegungen sind anders.

Die RS-232-Leitungen arbeiten mit den zwei Spannungspegeln von -12V für eine logische 1 und +12V für eine logische 0, während der Computer intern + 5V für eine logische 1 und 0 V für eine logische 0 verwendet. Der tatsächlich gültige Spannungsbereich bei der RS-232-Schnittstelle liegt tatsächlich aber zwischen + 3V und + 15V für eine Null und zwischen - 3V und - 15V für eine logische 1.  

Der Ruhezustand bei einer RS232-Schnittstelle in Bezug auf die Masse (Ground) ist der Spannungspegel -12V, also in Wirklichkeit eine logische 1 (Mark). Das Setzen der Ausgänge lässt die Spannung auf +12 V (Space) umspringen.

Zuständig für die Pegelumwandlung des in der Digitaltechnik verwendeten TTL-Pegels in die für die RS232-Schnittstelle geforderten Pegel ist meist ein kleines IC wie das MAX232, welches mit Hilfe einer internen Ladungspumpe und ein paar Kondensatoren die zwei Spannungen (- 12V, + 12V)  erzeugt und auch die TX/RX Spannungen invertiert und auf die neuen Pegel umsetzt. Dieser Baustein ist dann auch für die Belastbarkeit der Ausgänge verantwortlich.

Ich beschreibe hier einmal die Steckerbelegung einer 9-poligen Schnittstelle.

·         Pin 1
DCD (Data Carrier Detect). Diese Leitung ist ein Eingang. Damit wird dem PC mitgeteilt, dass der Signalpegel in Ordnung ist und die Übertragung beginnen kann.

·         Pin 2
RXD (Receive Data). ). Diese Leitung ist die Empfangsleitung, hier kommen die einzelnen Bits nacheinander an. 

·         Pin 3
TXD (Transmit Data). ). Diese Leitung ist die Sendeleitung, hierüber werden die einzelnen Bits nacheinander gesendet. 

·         Pin 4
DTR (Data Terminal Ready). Diese Leitung ist ein Ausgang, hierüber meldet der Computer, der im Allgemeinen eine DEE(DatenEndEinrichtung) ist, dass er zur Datenverarbeitung bereit ist.

·         Pin 5
GND (Ground) . Masse.

·         Pin 6
DSR (Data Set Ready). Damit wird der DEE angezeigt, dass die Peripherie betriebsbereit ist. Ist somit ein Eingang.

·         Pin 7
RTS (Request To Send). Diese Leitung ist ein Ausgang, wird von der DEE gesetzt und dient zur Abfrage, ob die Peripherie bereit ist. Siehe CTS.

·         Pin 8
CTS (Clear To Send). Diese Leitung ist ein Eingang.  Als Reaktion auf RTS meldet die Peripherie, wenn sie zur Datenaufnahme bereit ist.

·         Pin 9
RI (Ring Indikator) . Diese Leitung ist ein Eingang. Hierüber meldet zum Beispiel ein Modem einen eingehenden Anruf (Ring).

Für die Datenübertragung selbst ist eigentlich nur TXD, RXD und GND wichtig. Häufig werden RTS-CTS und DTR-DSR gebrückt, wenn die Software die Signale fordert, die Peripherie diese aber nicht anbieten kann.

Man kann die zwei Handshake-Leitungen DTR und RTS und zusätzlich TXD benutzen, um einen Transistor durchzuschalten oder beispielsweise eine LED(Leuchtdiode) zum Leuchten zu bringen. Die Ausgänge liefern bei einer Leerlaufspannung von etwa +- 12V um die 10-20 mA, also gerade den Strom, den eine Standard-LED benötigt. Somit ist es möglich, eine normale LED auch ohne Vorwiderstand anzuschließen. Es ist aber sicher nicht verkehrt, den verwendeten LEDs einen Vorwiderstand zu spendieren um damit den Strom selbst festzulegen und es kostet auch nicht die Welt. Dann ist auch sichergestellt, dass beispielsweise Low-Current LEDs nicht zu viel Strom abbekommen.

Mit einem kleinen, externen Kondensator kann man beispielsweise auch in Reihe zum Kondensator geschaltete Widerstände messen, indem man die Ladezeit des Kondensators bis zum Erreichen der Schwellenspannung eines Eingangs misst. Die Schwellenspannung (+- 3V) ist im Vergleich zu der gesamten Spannung (+- 12V) eines Ausgangs recht niedrig und kann man von einem nahezu linearen Zusammenhang von Zeit und Widerstand ausgehen. In diesem Bereich verläuft die Ladekurve noch ziemlich gerade.

Die Userform ufSerial

Die Userform enthält eine Menge Steuerelemente, welche die Einstellungen der Schnittstelle wiederspiegeln.

Links oben findet man ein Textfeld und gleich rechts daneben ein Kontrollkästchen. In dem Textfeld wird der Name einer vorhandenen Schnittstelle eingegeben, durch einen Klick auf das Kontrollkästchen wird die Schnittstelle, sofern das möglich ist, geöffnet und der Status durch einen Haken angezeigt.

Darunter befinden sich zwei Textfelder mit jeweils zwei zugehörigen Schaltflächen und den Beschriftungen “Senden“, “Empfangen“, sowie “Textfeld leeren“. Ein Klick auf die Schaltflächen “Textfeld leeren“ leert die zugehörigen Textfelder. Ist eine Schnittstelle geöffnet, wird durch einen Klick auf die Schaltfläche “Senden“ der zugehörige Text in den Ausgabepuffer geschrieben. Ein Klick auf die Schaltfläche “ Empfangen“ fragt kontinuierlich den Eingangspuffer ab, bis die in dem darüber liegenden Textfeld eingegebene Timeoutzeit in Sekunden abgelaufen ist. Aus dem Eingangspuffer gelesene Zeichen werden in dem darunter liegendem Textfeld dargestellt.

Im mittleren Bereich der Userform findet man zwei Rahmensteuerelemente mit den Beschriftungen “Eingänge Status“ und “Ausgänge Ein-, Ausschalten“. Darüber befinden sich eine Schaltfläche mit der Beschriftung “Eingänge abfragen“. Ein Klick darauf fragt den Status der Eingänge ab und setzt je nach Status die Kontrollkästchen im Rahmensteuerelement “Eingänge Status“.

Ein Klick auf die Kontrollkästchen im Rahmensteuerelement “ Ausgänge Ein-, Ausschalten“ schaltet die Ausgänge je nach Status der Kästchen auf +12V oder -12V.

Unter diesem Rahmensteuerelement befinden sich eine weitere Schaltfläche und ein Listenfeld. Durch einen Klick auf die Schaltfläche wird der aktuelle Status der Schnittstelle abgefragt und im Listenfeld dargestellt. Angezeigt werden Informationen wie die Anzahl der Zeichen im Ein- bzw. Ausgabepuffer.

Links davon befinden sich eine weitere Schaltfläche und ein Listenfeld. Durch einen Klick auf die Schaltfläche mit der Beschriftung “ Logdaten abfragen“ wird der aktuelle Loginhalt der Klasse abgefragt und im Textfeld dargestellt.

Im rechten Drittel der Userform findet man ein weiteres Rahmensteuerelement mit zwei darüber befindlichen Schaltflächen. In den drin befindlichen Textfeldern, Kontrollkästchen und Optionsschaltflächen werden nach dem Öffnen und nach einem Klick auf die Schaltfläche “Einstellungen abfragen“ die aktuellen Einstellungen dargestellt. Die Einstellungen werden nach einer Änderung der Steuerelemente durch einen Klick auf die Schaltfläche  “Einstellungen Setzen“ gesetzt, anschließend werden die Einstellungen neu ausgelesen.

Ein Klick auf die Schaltfläche “Im Notfall alle möglichen Verbindungen trennen“ soll mögliche, bestehende Verbindungen trennen. Durch einen Abbruch beim Testen und einer gleichzeitig offenen Schnittstelle können die Schnittstellen nicht noch einmal geöffnet werden, solange man nicht die Anwendung neu startet. Durch einen Klick werden verschiedene Handles an die Klasseneigenschaft KommunikationSchließen der Klasse clsCommPort übergeben und es wird versucht, die durch dieses Handle referenzierte Schnittstelle zu schließen.

Der Code dieser Userform besteht zum größten Teil aus Klickereignissen. In diesen werden lediglich Eigenschaften der Klasse clsCommPort gesetzt und ausgelesen, sowie Methoden dieser Klasse verwendet.

Die KeyPress-Ereignisse dienen hier dazu, in Textfeldern lediglich Ziffern und in einigen Fällen auch ein Komma zuzulassen. Werden Tasten gedrückt, die nicht in dem in den Ereignissen zu findendem Zeichenpool vorhanden sind, werden die Tastendrücke unterdrückt.

Option Explicit
Private mclsComm  As New clsCommPort
Private mlngPort  As Long
Private mblnBusy  As Boolean

Private Sub cmdReadStatus_Click()
   ' Status der Eingänge abfragen
   Call EingängeAus
   If mlngPort < 1 Then
      MsgBox "Kein Com-Port geöffnet"
   Else
      With mclsComm
         ' Klasseneigenschaften auswerten und Steuerelemente setzen
         If .DCDstatus Then chkDCD.Value = True
         If .CTSstatus Then chkCTS.Value = True
         If .DSRstatus Then chkDSR.Value = True
         If .RINGstatus Then chkRI.Value = True
      End With
   End If
End Sub

Private Sub EingängeAus()
   ' Steuerelemente der Eingänge zurücksetzen
   chkCTS.Value = False
   chkDCD.Value = False
   chkDSR.Value = False
   chkRI.Value = False
End Sub

Private Sub cmdSetSettings_Click()
   ' Einstellungen aus Steuerelementen der Userform auslesen
   ' und an die Klasse übergeben
   On Error Resume Next
   If mlngPort < 1 Then
      MsgBox "Kein Com-Port geöffnet"
   Else
      With mclsComm
         .BaudRate = CLng(txtBaud)
         .EofChar = CByte(txtEofChar)
         .ErrorChar = CByte(txtErrorChar)
         .EvtChar = CByte(txtEvtChar)
         .XoffChar = CByte(txtXoffChar)
         .XonChar = CByte(txtXonChar)
         .StopBits = CDbl(txtStopBits)
         .XoffLim = CInt(txtXoffLim)
         .XonLim = CInt(txtXonLim)
         .Parity = CByte(txtParity)
         .DataBits = CByte(txtDataBits)
         
         .EnableParity = chkParity.Value
         .EnableDsrFlow = chkDsrOut.Value
         .EnableCtsFlow = chkCtsOut.Value
         If optDtrOff.Value Then .DtrFlowType = 0
         If optDtrOn.Value Then .DtrFlowType = 1
         If optDtrHandshake.Value Then .DtrFlowType = 2
         If optRtsOff.Value Then .RtsFlowControl = 0
         If optRtsOn.Value Then .RtsFlowControl = 1
         If optRtsHandshake.Value Then .RtsFlowControl = 2
         If optRtsToggle.Value Then .RtsFlowControl = 3
         .EnableErrReplace = chkErrReplace.Value
         .EnableXoffContinuesTx = chkXoffContTx.Value
         .EnableXonOffOut = chkXonXOffOutFlow.Value
         .EnableXonOffIn = chkXonXOffInFlow.Value
         .EnableNullStrip = chkNullStrip.Value
         .EnableAbortOnError = chkAbortOnError.Value
         .ReadIntervalTimeout = txtReadIntervalTimeout
         .ReadTotalTimeoutMultiplier = txtReadTotalTimeoutMultiplier
         .ReadTotalTimeoutConstant = txtReadTotalTimeoutConstant
         .WriteTotalTimeoutMultiplier = txtWriteTotalTimeoutMultiplier
         .WriteTotalTimeoutConstant = txtWriteTotalTimeoutConstant
         ' Klassenmethode zum Setzen der Eigenschaften aufrufen
         .SetComSettings
      End With
      ' Klick auf "Einstellungen abfragen" simulieren
      cmdReadSettings_Click
   End If
End Sub

Private Sub cmdLog_Click()
   txtLog = mclsComm.LogText
End Sub

Private Sub cmdReadSettings_Click()
   If mlngPort < 1 Then
      MsgBox "Kein Com-Port geöffnet"
   Else
      With mclsComm
         ' Klasseneigenschaften auslesen und die Steuerelemente
         ' der Userform setzen
         txtBaud = .BaudRate
         txtEofChar = .EofChar
         txtErrorChar = .ErrorChar
         txtEvtChar = .EvtChar
         txtXoffChar = .XoffChar
         txtXonChar = .XonChar
         txtStopBits = Format(.StopBits, "0.0")
         txtXoffLim = .XoffLim
         txtXonLim = .XonLim
         txtParity = .Parity
         txtDataBits = .DataBits
         chkParity.Value = .EnableParity
         chkDsrOut.Value = .EnableDsrFlow
         chkCtsOut.Value = .EnableCtsFlow
         If .DtrFlowType = 0 Then optDtrOff.Value = True
         If .DtrFlowType = 1 Then optDtrOn.Value = True
         If .DtrFlowType = 2 Then optDtrHandshake.Value = True
         If .RtsFlowControl = 0 Then optRtsOff.Value = True
         If .RtsFlowControl = 1 Then optRtsOn.Value = True
         If .RtsFlowControl = 2 Then optRtsHandshake.Value = True
         If .RtsFlowControl = 3 Then optRtsToggle.Value = True
         chkErrReplace.Value = .EnableErrReplace
         chkXoffContTx.Value = .EnableXoffContinuesTx
         chkXonXOffOutFlow.Value = .EnableXonOffOut
         chkXonXOffInFlow.Value = .EnableXonOffIn
         chkNullStrip.Value = .EnableNullStrip
         chkAbortOnError.Value = .EnableAbortOnError
         txtReadIntervalTimeout = .ReadIntervalTimeout
         txtReadTotalTimeoutMultiplier = .ReadTotalTimeoutMultiplier
         txtReadTotalTimeoutConstant = .ReadTotalTimeoutConstant
         txtWriteTotalTimeoutMultiplier = .WriteTotalTimeoutMultiplier
         txtWriteTotalTimeoutConstant = .WriteTotalTimeoutConstant
      End With
   End If
End Sub

Private Sub ClearSettings()
   ' Alle Einstellungs-Steuerelemente der Userform zurücksetzen
   txtBaud = ""
   txtEofChar = ""
   txtErrorChar = ""
   txtEvtChar = ""
   txtXoffChar = ""
   txtXonChar = ""
   txtStopBits = ""
   txtXoffLim = ""
   txtXonLim = ""
   txtParity = ""
   txtDataBits = ""
   chkParity.Value = False
   chkDsrOut.Value = False
   chkCtsOut.Value = False
   optDtrOff.Value = True
   optRtsOff.Value = True
   chkErrReplace.Value = False
   chkXoffContTx.Value = False
   chkXonXOffOutFlow.Value = False
   chkXonXOffInFlow.Value = False
   chkNullStrip.Value = False
   chkAbortOnError.Value = False
   txtReadIntervalTimeout = ""
   txtReadTotalTimeoutMultiplier = ""
   txtReadTotalTimeoutConstant = ""
   txtWriteTotalTimeoutMultiplier = ""
   txtWriteTotalTimeoutConstant = ""
End Sub
Private Sub cmdRec_Click()
   Dim lngTimeout As Long
   Dim strBuffer  As String
   On Error Resume Next
   ' Über die Klassenfunktion "Empfangen" Text im Eingangspuffer
   ' holen. Die Timeoutzeit in Sekunden legt die Zeit fest, in der
   ' in einer Schleife der Eingangspuffer laufend abgefragt wird
   If mlngPort < 1 Then
      MsgBox "Kein Com-Port  geöffnet"
   Else
      lngTimeout = CLng(txtTimeout.Text)
      strBuffer = mclsComm.Empfangen(lngTimeout)
      If strBuffer <> "" Then
          txtRet.Text = txtRet.Text & strBuffer & vbCrLf
      End If
   End If
End Sub
Private Sub cmdClearInput_Click()
   ' Textfeld "Senden" leeren
   txtRet.Text = ""
End Sub

Private Sub cmdSend_Click()
   ' Über die Klassenfunktion "Senden" Text an die Schnittstelle
   ' senden.
   If mlngPort < 1 Then
      MsgBox "Kein Com-Port  geöffnet"
   Else
      mclsComm.Senden txtSend.Text & vbCrLf
   End If
End Sub
Private Sub cmdClearSend_Click()
   ' Textfeld "Empfangen" leeren
   txtSend.Text = ""
End Sub

Private Sub chkTXD_Click()
   ' Ausgang TXD setzen
   On Error Resume Next
   If mblnBusy Then Exit Sub
   mblnBusy = True
   If mlngPort < 1 Then
      MsgBox "Kein Com-Port geöffnet"
   Else
      If chkTXD Then
         If mclsComm.TXD(True) Then
            chkTXD.Value = True
         Else
            chkTXD.Value = False
         End If
      Else
         mclsComm.TXD False
      End If
   End If
   mblnBusy = False
End Sub

Private Sub chkRTS_Click()
   ' Ausgang RTS setzen
   On Error Resume Next
   If mblnBusy Then Exit Sub
   mblnBusy = True
   If mlngPort < 1 Then
      MsgBox "Kein Com-Port geöffnet"
   Else
      If chkRTS Then
         If mclsComm.RTS(True) Then
            chkRTS.Value = True
         Else
            chkRTS.Value = False
         End If
      Else
         mclsComm.RTS False
      End If
   End If
   mblnBusy = False
End Sub

Private Sub chkDTR_Click()
   ' Ausgang DTR setzen
   On Error Resume Next
   If mblnBusy Then Exit Sub
   mblnBusy = True
   If mlngPort < 1 Then
      MsgBox "Kein Com-Port geöffnet"
   Else
      If chkDTR Then
         If mclsComm.DTR(True) Then
            chkDTR.Value = True
         Else
            chkDTR.Value = False
         End If
      Else
         mclsComm.DTR False
      End If
   End If
   mblnBusy = False
End Sub

Private Sub chkOpen_Click()
   ' Schnittstelle öffnen, wenn sie existiert
   On Error Resume Next
   If mblnBusy Then Exit Sub
   mblnBusy = True
   If chkOpen Then
      If mlngPort < 1 Then
         ' Klassenfunktion zum Öffnen aufrufen, Ergebnis auswerten
         mlngPort = mclsComm.KommunikationÖffnen(txtPort)
         If mlngPort < 1 Then
            chkOpen.Value = False
         Else
            Call cmdReadSettings_Click
            Call cmdReadStatus_Click
         End If
      Else
         MsgBox "Ein Com-Port ist bereits geöffnet"
      End If
   Else
      If mlngPort < 1 Then
         MsgBox "Kein Com-Port geöffnet"
      Else
         ' Steuerelemente Einstellungen zurücksetzen
         Call ClearSettings
         ' Klassenfunktion zum Schließen aufrufen
         mclsComm.KommunikationSchließen
         mlngPort = 0
      End If
      ' Steuerelemente Eingänge auf Aus setzen
      Call EingängeAus
   End If
   mblnBusy = False
End Sub

Private Sub cmdSOS_Click()
   Dim i       As Long
   Do
      i = i + 1
      If i > 50000 Then Exit Do
   Loop While mclsComm.KommunikationSchließen(i) = False
End Sub

Private Sub cmdStatus_Click()
   Dim varStatus  As Variant
   Dim varTemp    As Variant
   lsbStatus.Clear
   If mclsComm Is Nothing Then Exit Sub
   ' Status abfragen, Ergebnis ist Text, wobei jede Zeile durch
   ' ein vbCrLf getrennt ist. Daraus wird durch Split ein Array
   ' gemacht
   For Each varTemp In Split(mclsComm.GetStatus, vbCrLf)
      ' Jedes Element des Arrays in Listenfeld ausgeben
      lsbStatus.AddItem varTemp
   Next
End Sub

Private Sub txtBaud_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtEofChar_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtErrorChar_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtEvtChar_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtParity_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtReadIntervalTimeout_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789,", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtReadTotalTimeoutConstant_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789,", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtReadTotalTimeoutMultiplier_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789,", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtWriteTotalTimeoutConstant_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789,", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtWriteTotalTimeoutMultiplier_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789,", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtStopBits_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789,", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtTimeout_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtXoffChar_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtXoffLim_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtXonChar_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtXonLim_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtDataBits_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub   

Das Klasse clsCommPort

Diese Klasse kapselt die API-Aufrufe zum Umgang mit einer Comm-Schnittstelle. Nach außen hin werden verschiedene Methoden und Eigenschaften bereitgestellt. Diese Klasse wird benutzt, indem man ein Objekt daraus erzeugt.

Private mclsComm  As New clsCommPort

Die vorherige Deklaration erzeugt das Objekt beim ersten Zugriff, die folgende mit der zweiten Zeile, man bestimmt dann selbst den Zeitpunkt der Objekterstellung.

Private mclsComm  As clsCommPort
Set mclsComm  = New clsCommPort

Nach der Objekterstellung kann man die Eigenschaften setzen und auslesen, sowie die Methoden und Funktionen verwenden. Indem man mehrere Objekte erstellt, kann man nebeneinander auf verschiedene Schnittstellen zugreifen, jedes Objekt verfügt unabhängig von den anderen über einen eigenen Variablensatz.

Option Explicit
Private Type COMSTAT
   Bits As Long
   cbInQue As Long
   cbOutQue As Long
End Type
Private Type DCB
   DCBlength As Long
   BaudRate As Long
   fBitFields As Long
   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
End Type
Private Type COMMTIMEOUTS
   ReadIntervalTimeout As Long
   ReadTotalTimeoutMultiplier As Long
   ReadTotalTimeoutConstant As Long
   WriteTotalTimeoutMultiplier As Long
   WriteTotalTimeoutConstant As Long
End Type

#If VBA7 Then
   Private mlngComHandle                     As LongPtr
   Private Type SECURITY_ATTRIBUTES
      nLength As Long
      lpSecurityDescriptor As LongPtr
      bInheritHandle As Long
   End Type
   Private Declare PtrSafe Function SetCommTimeouts _
      Lib "kernel32" ( _
      ByVal hFile As LongPtr, _
      lpCommTimeouts As COMMTIMEOUTS _
      ) As Long
   Private Declare PtrSafe Function GetCommTimeouts _
      Lib "kernel32" ( _
      ByVal hFile As LongPtr, _
      lpCommTimeouts As COMMTIMEOUTS _
      ) As Long
   Private Declare PtrSafe Function CreateFile _
      Lib "kernel32" Alias "CreateFileA" ( _
      ByVal lpFileName As String, _
      ByVal dwDesiredAccess As Long, _
      ByVal dwShareMode As Long, _
      lpSecurityAttributes As SECURITY_ATTRIBUTES, _
      ByVal dwCreationDisposition As Long, _
      ByVal dwFlagsAndAttributes As Long, _
      ByVal hTemplateFile As LongPtr _
      ) As LongPtr
   Private Declare PtrSafe Function SetCommState _
      Lib "kernel32" ( _
      ByVal hCommDev As LongPtr, _
      lpDCB As DCB _
      ) As Long
   Private Declare PtrSafe Function GetCommState _
      Lib "kernel32" ( _
      ByVal nCid As LongPtr, _
      lpDCB As DCB _
      ) As Long
   Private Declare PtrSafe Function GetCommModemStatus _
      Lib "kernel32" ( _
      ByVal hFile As LongPtr, _
      lpModemStat As Long _
      ) As Long
   Private Declare PtrSafe Function SetCommBreak _
      Lib "kernel32" ( _
      ByVal nCid As LongPtr _
      ) As Long
   Private Declare PtrSafe Function ClearCommBreak _
      Lib "kernel32" ( _
      ByVal nCid As LongPtr _
      ) As Long
   Private Declare PtrSafe Function EscapeCommFunction _
      Lib "kernel32" ( _
      ByVal nCid As LongPtr, _
      ByVal nFunc As Long _
      ) As Long
   Private Declare PtrSafe Function CloseHandle _
      Lib "kernel32" ( _
      ByVal hObject As LongPtr _
      ) As Long
   Private Declare PtrSafe Function ReadFile _
      Lib "kernel32" ( _
      ByVal hFile As LongPtr, _
      ByVal lpBuffer As LongPtr, _
      ByVal nNumberOfBytesToRead As Long, _
      lpNumberOfBytesRead As Long, _
      ByVal lpOverlapped As LongPtr _
      ) As Long
   Private Declare PtrSafe Function WriteFile _
      Lib "kernel32" ( _
      ByVal hFile As LongPtr, _
      ByVal lpBuffer As LongPtr, _
      ByVal nNumberOfBytesToWrite As Long, _
      lpNumberOfBytesWritten As Long, _
      ByVal lpOverlapped As LongPtr _
      ) As Long
   Private Declare PtrSafe Function ClearCommError _
      Lib "kernel32" ( _
      ByVal hFile As LongPtr, _
      lpErrors As Long, _
      lpStat As COMSTAT _
      ) As Long
   Private Declare PtrSafe Function SetupComm _
      Lib "kernel32" ( _
      ByVal hFile As Long, _
      ByVal dwInQueue As Long, _
      ByVal dwOutQueue As Long _
      ) As Long
   Private Declare PtrSafe Function GetLastError _
      Lib "kernel32" () As Long
#Else
   Private mlngComHandle                     As Long
   Private Type SECURITY_ATTRIBUTES
      nLength As Long
      lpSecurityDescriptor As Long
      bInheritHandle As Long
   End Type
   Private Declare Function SetCommTimeouts _
      Lib "kernel32" ( _
      ByVal hFile As Long, _
      lpCommTimeouts As COMMTIMEOUTS _
      ) As Long
   Private Declare Function GetCommTimeouts _
      Lib "kernel32" ( _
      ByVal hFile As Long, _
      lpCommTimeouts As COMMTIMEOUTS _
      ) As Long
   Private Declare Function CreateFile _
      Lib "kernel32" Alias "CreateFileA" ( _
      ByVal lpFileName As String, _
      ByVal dwDesiredAccess As Long, _
      ByVal dwShareMode As Long, _
      lpSecurityAttributes As SECURITY_ATTRIBUTES, _
      ByVal dwCreationDisposition As Long, _
      ByVal dwFlagsAndAttributes As Long, _
      ByVal hTemplateFile 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
   Private Declare Function GetCommModemStatus _
      Lib "kernel32" ( _
      ByVal hFile As Long, _
      lpModemStat As Long _
      ) As Long
   Private Declare Function SetCommBreak _
      Lib "kernel32" ( _
      ByVal nCid As Long _
      ) As Long
   Private Declare Function ClearCommBreak _
      Lib "kernel32" ( _
      ByVal nCid As Long _
      ) As Long
   Private Declare Function EscapeCommFunction _
      Lib "kernel32" ( _
      ByVal nCid As Long, _
      ByVal nFunc As Long _
      ) As Long
   Private Declare Function CloseHandle _
      Lib "kernel32" ( _
      ByVal hObject As Long _
      ) As Long
   Private Declare Function ReadFile _
      Lib "kernel32" ( _
      ByVal hFile As Long, _
      ByVal lpBuffer As Long, _
      ByVal nNumberOfBytesToRead As Long, _
      lpNumberOfBytesRead As Long, _
      ByVal lpOverlapped As Long _
      ) As Long
   Private Declare Function WriteFile _
      Lib "kernel32" ( _
      ByVal hFile As Long, _
      ByVal lpBuffer As Long, _
      ByVal nNumberOfBytesToWrite As Long, _
      lpNumberOfBytesWritten As Long, _
      ByVal lpOverlapped As Long _
      ) As Long
   Private Declare Function ClearCommError _
      Lib "kernel32" ( _
      ByVal hFile As Long, _
      lpErrors As Long, _
      lpStat As COMSTAT _
      ) As Long
   Private Declare Function SetupComm _
      Lib "kernel32" ( _
      ByVal hFile As Long, _
      ByVal dwInQueue As Long, _
      ByVal dwOutQueue As Long _
      ) As Long
   Private Declare Function GetLastError _
      Lib "kernel32" () As Long
#End If
Private Const ONESTOPBIT                  As Long = 0
Private Const ONE5STOPBITS                As Long = 1
Private Const TWOSTOPBITS                 As Long = 2
   
Private Const GENERIC_READ                As Long = &H80000000
Private Const GENERIC_WRITE               As Long = &H40000000
Private Const OPEN_EXISTING               As Long = 3

Private Const SETDTR                      As Long = 5
Private Const SETRTS                      As Long = 3
Private Const CLRDTR                      As Long = 6
Private Const CLRRTS                      As Long = 4

Private Const MS_DSR_ON                   As Long = &H20&
Private Const MS_CTS_ON                   As Long = &H10&
Private Const MS_RING_ON                  As Long = &H40&
Private Const MS_RLSD_ON                  As Long = &H80&

Private mudtSettings                      As DCB
Private mlngBaudRate                      As Long
Private mintXonLim                        As Integer
Private mintXoffLim                       As Integer
Private mbyteParity                       As Byte
Private mbyteStopBits                     As Byte
Private mbyteXonChar                      As Byte
Private mbyteXoffChar                     As Byte
Private mbyteErrorChar                    As Byte
Private mbyteEofChar                      As Byte
Private mbyteEvtChar                      As Byte
Private mbyteDataBits                     As Byte

Private mblnParity                        As Boolean
Private mblnCTS                           As Boolean
Private mblnDSR                           As Boolean
Private mblnDSRSensitiv                   As Boolean
Private mblnXoffTx                        As Boolean
Private mblnXonOffOut                     As Boolean
Private mblnXonOffIn                      As Boolean
Private mblnErrRepl                       As Boolean
Private mblnNullStrip                     As Boolean
Private mblnAbortOnErr                    As Boolean
Private mbytRTS                           As Byte
Private mbytDTR                           As Byte

Private mlngReadIntervalTimeout           As Long
Private mlngReadTotalTimeoutMultiplier    As Long
Private mlngReadTotalTimeoutConstant      As Long
Private mlngWriteTotalTimeoutMultiplier   As Long
Private mlngWriteTotalTimeoutConstant     As Long
Private mblnLogWrite                      As Boolean
Private mstrLogString                     As String
Private mstrLogFile                       As String



#If VBA7 Then

   Public Function KommunikationSchließen( _
      Optional CommHandle As LongPtr _
      ) As Boolean
      Dim lngRet  As Long
      WriteLog "Öffentliche Funktion Kommunikation schließen"
      If CommHandle <> 0 Then
         ' Comhandle übergeben, dieses schließen
         If CloseHandle(CommHandle) <> 0 Then
            ' Schnittstelle erfolgreich geschlossen
            KommunikationSchließen = True
            WriteLog "Kommunikation geschlossen"
         End If
      Else
         ' Kein Handle übergeben, klasseninternes schließen
         If CloseHandle(mlngComHandle) <> 0 Then
            KommunikationSchließen = True
            mlngComHandle = 0
            WriteLog "Kommunikation geschlossen"
         End If
      End If
   End Function
   Public Function KommunikationÖffnen( _
      Optional strPort As String = "COM1" _
      ) As LongPtr
      Dim udtSecurity   As SECURITY_ATTRIBUTES
      Dim lngAccess     As Long
      Dim lngErr        As Long
      
      On Error Goto ErrHandler
      
      WriteLog "Öffentliche Funktion Kommunikation öffnen"
      
      If mlngComHandle > 0 Then Goto ErrHandler
      
      ' Zugriffsberechtigung setzen
      lngAccess = GENERIC_READ Or GENERIC_WRITE
      
      ' Struktur SECURITY_ATTRIBUTES ausfüllen
      With udtSecurity
         .nLength = 12
         .bInheritHandle = 0
         .lpSecurityDescriptor = 0
      End With
      
      ' Fehlerspeicher leeren
      lngErr = GetLastError
   
      ' Filehandle holen
      mlngComHandle = CreateFile( _
                        strPort, _
                        lngAccess, _
                        0&, _
                        udtSecurity, _
                        OPEN_EXISTING, _
                        0&, _
                        0&)
                        
      ' Fehlerspeicher auslesen
      lngErr = GetLastError
      
      If (lngErr <> 0) Or (mlngComHandle < 1) Then
         WriteLog "Kommunikation öffnen ist fehlgeschlagen"
         Goto ErrHandler
      End If
      
      ' Filehandle als Funktionsergebnis zurückgenben
      KommunikationÖffnen = mlngComHandle
      
      ' Einstellungen auslesen
      Call ReadComSettings
      Call ReadTimeoutSettings
      Exit Function
      
ErrHandler:
   
   End Function

#Else
   Public Function KommunikationSchließen( _
      Optional CommHandle As Long _
      ) As Boolean
      Dim lngRet  As Long
      WriteLog "Öffentliche Funktion Kommunikation schließen"
      If CommHandle <> 0 Then
         ' Comhandle übergeben, dieses schließen
         If CloseHandle(CommHandle) <> 0 Then
            ' Schnittstelle erfolgreich geschlossen
            KommunikationSchließen = True
            WriteLog "Kommunikation geschlossen"
         End If
      Else
         ' Kein Handle übergeben, klasseninternes schließen
         If CloseHandle(mlngComHandle) <> 0 Then
            KommunikationSchließen = True
            mlngComHandle = 0
            WriteLog "Kommunikation geschlossen"
         End If
      End If
   End Function
   Public Function KommunikationÖffnen( _
      Optional strPort As String = "COM1" _
      ) As Long
      Dim udtSecurity   As SECURITY_ATTRIBUTES
      Dim lngAccess     As Long
      Dim lngErr        As Long
      
      On Error Goto ErrHandler
      
      WriteLog "Öffentliche Funktion Kommunikation öffnen"
      
      If mlngComHandle > 0 Then Goto ErrHandler
      
      ' Zugriffsberechtigung setzen
      lngAccess = GENERIC_READ Or GENERIC_WRITE
      
      ' Struktur SECURITY_ATTRIBUTES ausfüllen
      With udtSecurity
         .nLength = 12
         .bInheritHandle = 0
         .lpSecurityDescriptor = 0
      End With
      
      ' Fehlerspeicher leeren
      lngErr = GetLastError
   
      ' Filehandle holen
      mlngComHandle = CreateFile( _
                        strPort, _
                        lngAccess, _
                        0&, _
                        udtSecurity, _
                        OPEN_EXISTING, _
                        0&, _
                        0&)
                        
      ' Fehlerspeicher auslesen
      lngErr = GetLastError
      
      If (lngErr <> 0) Or (mlngComHandle < 1) Then
         WriteLog "Kommunikation öffnen ist fehlgeschlagen"
         Goto ErrHandler
      End If
      
      ' Filehandle als Funktionsergebnis zurückgenben
      KommunikationÖffnen = mlngComHandle
      
      ' Einstellungen auslesen
      Call ReadComSettings
      Call ReadTimeoutSettings
      Exit Function
      
ErrHandler:
   
   End Function
#End If

Public Function Empfangen(Optional lngTimeout As Long = 5) As String
   Dim lngRet                 As Long
   Dim lngWritten             As Long
   Dim lngNeeded              As Long
   Dim lngComError            As Long
   Dim udtStat                As COMSTAT
   Dim dteTimeoutWaitForInput As Date
   Dim i                      As Long
   Dim abyteBuffer()          As Byte
   
   WriteLog "Öffentliche Funktion Empfangen"
   
   If mlngComHandle = 0 Then Exit Function
   
   If lngTimeout = 0 Then lngTimeout = 5
   
   ' Timeoutzeit in Sekunden festlegen
   dteTimeoutWaitForInput = Now + TimeSerial(0, 0, lngTimeout)
   
   ' Status holen
   If ClearCommError(mlngComHandle, lngComError, udtStat) = 0 Then
       WriteLog "API- Funktion ClearCommError fehlgeschlagen"
       Exit Function
   End If
   
   ' Anzahl Zeichen im Puffer auslesen
   lngNeeded = udtStat.cbInQue
   
   Do
      
      i = i + 1
      
      If lngNeeded > 0 Then
      
         ' Puffer anlegen
         ReDim abyteBuffer(lngNeeded)
         
         ' Empfangspuffer in der angelegten Größe auslesen
         lngRet = ReadFile( _
                     mlngComHandle, _
                     VarPtr(abyteBuffer(0)), _
                     lngNeeded, _
                     lngWritten, 0)
                     
         Empfangen = Empfangen & StrConv(abyteBuffer, vbUnicode)
                     
         ' Status holen
         If ClearCommError(mlngComHandle, lngComError, udtStat) = 0 Then
            WriteLog "API- Funktion ClearCommError fehlgeschlagen"
            Exit Do
         End If
         
         ' Anzahl Zeichen im Puffer auslesen
         lngNeeded = udtStat.cbInQue
         
         If lngNeeded = 0 Then Exit Do
            
      Else
      
         ' Überprüfen, ob Timeout erreicht. Wenn ja,
         ' Schleife verlassen
         If Now > dteTimeoutWaitForInput Then Exit Do
         
         ' Status holen
         If ClearCommError(mlngComHandle, lngComError, udtStat) = 0 Then
            WriteLog "API- Funktion ClearCommError fehlgeschlagen"
            Exit Do
         End If
         
         ' Anzahl Zeichen im Puffer auslesen
         lngNeeded = udtStat.cbInQue
         
      End If
      
      If (i Mod 100) = 0 Then DoEvents
       
   Loop
   
End Function

Public Function GetStatus() As String
   Dim udtStat                As COMSTAT
   Dim lngComError            As Long
   
   WriteLog "Öffentliche Funktion GetStatus"
   
   ' Status holen
   If ClearCommError(mlngComHandle, lngComError, udtStat) = 0 Then
      WriteLog "API- Funktion ClearCommError fehlgeschlagen"
      Exit Function
   End If
   
   ' Struktur Status auswerten
   With udtStat
      GetStatus = _
         "Bytes im Eingangspuffer : " & .cbInQue & vbCrLf
      GetStatus = GetStatus & _
         "Bytes im Ausgangspuffer : " & .cbOutQue & vbCrLf
      GetStatus = GetStatus & "Waiting for CTS signal = " & _
         CStr((.Bits And 2 ^ 0) <> 0) & vbCrLf
      GetStatus = GetStatus & "Waiting for DSR signal = " & _
         CStr((.Bits And 2 ^ 1) <> 0) & vbCrLf
      GetStatus = GetStatus & "Waiting for RLSD (DCD) signal = " & _
         CStr((.Bits And 2 ^ 2) <> 0) & vbCrLf
      GetStatus = GetStatus & "Waiting for XOFF char rec  = " & _
         CStr((.Bits And 2 ^ 3) <> 0) & vbCrLf
      GetStatus = GetStatus & "Waiting for XOFF char sent = " & _
         CStr((.Bits And 2 ^ 4) <> 0) & vbCrLf
      GetStatus = GetStatus & "EOF character sent = " & _
         CStr((.Bits And 2 ^ 5) <> 0) & vbCrLf
      GetStatus = GetStatus & "Character waiting for Tx  = " & _
         CStr((.Bits And 2 ^ 6) <> 0) & vbCrLf
   End With
End Function

Public Function Senden(Text As String) As Long
   Dim lngRet        As Long
   Dim lngWritten    As Long
   Dim abyteBuffer() As Byte
   
   WriteLog "Öffentliche Funktion Senden"
   
   If mlngComHandle = 0 Then Exit Function
   
   ' Text senden
   abyteBuffer = StrConv(Text, vbFromUnicode)
   lngRet = WriteFile(mlngComHandle, VarPtr(abyteBuffer(0)), Len(Text), lngWritten, 0)
   
   If lngRet = 0 Then
       WriteLog "API- Funktion WriteFile fehlgeschlagen"
   End If
   
   Senden = lngWritten
   
End Function

Public Function DTR(DTRAN As Boolean) As Boolean
   Dim lngRet As Long
   
   WriteLog "Öffentliche Funktion DTR"
   
   If DTRAN Then
       lngRet = EscapeCommFunction(mlngComHandle, SETDTR)
   Else
       lngRet = EscapeCommFunction(mlngComHandle, CLRDTR)
   End If
   If lngRet <> 0 Then
      DTR = True
      WriteLog "DTR = " & DTRAN
   End If
End Function

Public Function RTS(RTSAN As Boolean) As Boolean
   Dim lngRet As Long
   
   WriteLog "Öffentliche Funktion RTS"
   
   If RTSAN Then
       lngRet = EscapeCommFunction(mlngComHandle, SETRTS)
   Else
       lngRet = EscapeCommFunction(mlngComHandle, CLRRTS)
   End If
   
   If lngRet <> 0 Then
      RTS = True
      WriteLog "RTS = " & RTSAN
   End If
   
End Function

Public Function TXD(TXDAN As Boolean) As Boolean
   Dim lngRet As Long
   
   WriteLog "Öffentliche Funktion TXD"
   
   If TXDAN Then
       lngRet = SetCommBreak(mlngComHandle)
   Else
       lngRet = ClearCommBreak(mlngComHandle)
   End If
   
   If lngRet <> 0 Then
      TXD = True
      WriteLog "TXD = " & TXDAN
   End If
   
End Function

Public Function DCDstatus() As Boolean
   Dim lngStatus As Long
   
   WriteLog "Öffentliche Funktion DCD"
   
   If GetCommModemStatus(mlngComHandle, lngStatus) = 0 Then
      WriteLog "API-Funktion GetCommModemStatus fehlgeschlagen"
   End If
   
   DCDstatus = IIf(lngStatus And MS_RLSD_ON, True, False)
   WriteLog "DCD-Status = " & DCDstatus
End Function

Public Function RINGstatus() As Boolean
   Dim lngStatus As Long
   
   WriteLog "Öffentliche Funktion RING"
   
   If GetCommModemStatus(mlngComHandle, lngStatus) = 0 Then
      WriteLog "API-Funktion GetCommModemStatus fehlgeschlagen"
   End If
   
   RINGstatus = IIf(lngStatus And MS_RING_ON, True, False)
   WriteLog "Ring-Status = " & RINGstatus
End Function

Public Function CTSstatus() As Boolean
   Dim lngStatus As Long
   
   WriteLog "Öffentliche Funktion CTS"
   
   If GetCommModemStatus(mlngComHandle, lngStatus) = 0 Then
      WriteLog "API-Funktion GetCommModemStatus fehlgeschlagen"
   End If
   
   CTSstatus = IIf(lngStatus And MS_CTS_ON, True, False)
   WriteLog "CTS-Status = " & CTSstatus
End Function

Public Function DSRstatus() As Boolean
   Dim lngStatus As Long
   
   WriteLog "Öffentliche Funktion DSR"
   
   If GetCommModemStatus(mlngComHandle, lngStatus) = 0 Then
      WriteLog "API-Funktion GetCommModemStatus fehlgeschlagen"
   End If
   
   DSRstatus = IIf(lngStatus And MS_DSR_ON, True, False)
   WriteLog "DSR-Status = " & DSRstatus
End Function

#If VBA7 Then
   Public Function ComHandle() As LongPtr
      ComHandle = mlngComHandle
   End Function
#Else
   Public Function ComHandle() As Long
      ComHandle = mlngComHandle
   End Function
#End If

Private Sub Class_Initialize()
   ' mblnLogWrite = True
   mstrLogFile = ThisWorkbook.Path & "\LogSeriell.txt"
End Sub

Private Sub Class_Terminate()
   KommunikationSchließen
End Sub

Public Sub ReadComSettings()

   WriteLog "Interne Sub ReadComSettings"
   
   mudtSettings.DCBlength = LenB(mudtSettings)
   
   ' Struktur dcb zum Auslesen an die API-Funktion übergeben
   GetCommState mlngComHandle, mudtSettings
   
   ' Struktur dcb auswerten
   With mudtSettings
      GetBitFieldsInfo .fBitFields
      mlngBaudRate = .BaudRate
      mintXonLim = .XonLim
      mintXoffLim = .XoffLim
      mbyteParity = .Parity
      mbyteStopBits = .StopBits
      mbyteXonChar = .XonChar
      mbyteXoffChar = .XoffChar
      mbyteErrorChar = .ErrorChar
      mbyteEofChar = .EofChar
      mbyteEvtChar = .EvtChar
      mbyteDataBits = .ByteSize
      WriteLog "BaudRate = " & mlngBaudRate
      WriteLog "XonLim = " & mintXonLim
      WriteLog "XoffLim = " & mintXoffLim
      WriteLog "Parity = " & mbyteParity
      WriteLog "StopBits = " & mbyteStopBits
      WriteLog "XonChar = " & mbyteXonChar
      WriteLog "XoffChar = " & mbyteXoffChar
      WriteLog "ErrorChar = " & mbyteErrorChar
      WriteLog "EofChar = " & mbyteEofChar
      WriteLog "EvtChar = " & mbyteEvtChar
      WriteLog "ByteSize = " & mbyteDataBits
   End With
   
   Call ReadTimeoutSettings
   
End Sub


Public Sub SetComSettings()

   WriteLog "Interne Sub SetComSettings"
   
   ' Struktur dcb ausfüllen
   With mudtSettings
      .DCBlength = LenB(mudtSettings)
      .fBitFields = SetBitFieldsInfo()
      .BaudRate = mlngBaudRate
      .XonLim = mintXonLim
      .XoffLim = mintXoffLim
      .Parity = mbyteParity
      .StopBits = mbyteStopBits
      .XonChar = mbyteXonChar
      .XoffChar = mbyteXoffChar
      .ErrorChar = mbyteErrorChar
      .EofChar = mbyteEofChar
      .EvtChar = mbyteEvtChar
      .ByteSize = mbyteDataBits
      WriteLog "BaudRate = " & mlngBaudRate
      WriteLog "XonLim = " & mintXonLim
      WriteLog "XoffLim = " & mintXoffLim
      WriteLog "Parity = " & mbyteParity
      WriteLog "StopBits = " & mbyteStopBits
      WriteLog "XonChar = " & mbyteXonChar
      WriteLog "XoffChar = " & mbyteXoffChar
      WriteLog "ErrorChar = " & mbyteErrorChar
      WriteLog "EofChar = " & mbyteEofChar
      WriteLog "EvtChar = " & mbyteEvtChar
      WriteLog "ByteSize = " & mbyteDataBits
   End With
   
   ' Struktur dcb zum Setzen an die API-Funktion übergeben
   If SetCommState(mlngComHandle, mudtSettings) = 0 Then
      WriteLog "API-Funktion SetCommState fehlgeschlagen"
   End If
   
   ' Einstellungen Timeout setzen
   Call SetTimeoutSettings
   
   ' Einstellungen neu auslesen
   Call ReadComSettings
   
End Sub

Private Sub ReadTimeoutSettings()
   Dim udtCommtimeouts As COMMTIMEOUTS
   
   WriteLog "Interne Sub ReadTimeoutSettings"
   
   ' Klassenweite Variablen zurücksetzen
   mlngReadIntervalTimeout = 0
   mlngReadTotalTimeoutMultiplier = 0
   mlngReadTotalTimeoutConstant = 0
   mlngWriteTotalTimeoutMultiplier = 0
   mlngWriteTotalTimeoutConstant = 0
   If mlngComHandle = 0 Then Exit Sub
   
   ' Struktur COMMTIMEOUTS ausfüllen lassen
   If GetCommTimeouts(mlngComHandle, udtCommtimeouts) = 0 Then
      WriteLog "API-Funktion GetCommTimeouts fehlgeschlagen"
   End If
   
   ' Struktur COMMTIMEOUTS auswerten und in klassenweit
   ' gültigen Variablen speichern
   With udtCommtimeouts
      mlngReadIntervalTimeout = .ReadIntervalTimeout
      mlngReadTotalTimeoutMultiplier = .ReadTotalTimeoutMultiplier
      mlngReadTotalTimeoutConstant = .ReadTotalTimeoutConstant
      mlngWriteTotalTimeoutMultiplier = .WriteTotalTimeoutMultiplier
      mlngWriteTotalTimeoutConstant = .WriteTotalTimeoutConstant
   End With
End Sub

Private Sub SetTimeoutSettings()
   Dim udtCommtimeouts As COMMTIMEOUTS
   If mlngComHandle = 0 Then Exit Sub
   ' Struktur COMMTIMEOUTS ausfüllen lassen
   
   WriteLog "Interne Prozedur SetTimeoutSettings"
   
   With udtCommtimeouts
      .ReadIntervalTimeout = mlngReadIntervalTimeout
      .ReadTotalTimeoutMultiplier = mlngReadTotalTimeoutMultiplier
      .ReadTotalTimeoutConstant = mlngReadTotalTimeoutConstant
      .WriteTotalTimeoutMultiplier = mlngWriteTotalTimeoutMultiplier
      .WriteTotalTimeoutConstant = mlngWriteTotalTimeoutConstant
   End With
   
   ' Zum Setzen die Struktur COMMTIMEOUTS an die API übergeben
   If SetCommTimeouts(mlngComHandle, udtCommtimeouts) = 0 Then
      WriteLog "API-Funktion SetCommTimeouts fehlgeschlagen"
   End If
End Sub

Private Sub GetBitFieldsInfo(lngBitField As Long)

   WriteLog "Interne Funktion GetBitFieldsInfo"
   
   ' Bit #0: Binary-Mode, bei Schnittstellen immer 1
   ' Bit #1: enable parity checking
   mblnParity = ((lngBitField And 2 ^ 1) <> 0)
   ' Bit #2: CTS output flow control
   mblnCTS = ((lngBitField And 2 ^ 2) <> 0)
   ' Bit #3: DSR output flow control
   mblnDSR = ((lngBitField And 2 ^ 3) <> 0)
   ' Bit #4: DTR flow control type
   ' Bit #5: DTR flow control type
   ' 0=DTR_CONTROL_DISABLE
   ' 1=DTR_CONTROL_ENABLE
   ' 2=DTR_CONTROL_HANDSHAKE
   mbytDTR = mbytDTR + IIf((lngBitField And 2 ^ 4) <> 0, 1, 0)
   mbytDTR = mbytDTR + IIf((lngBitField And 2 ^ 5) <> 0, 2, 0)
   ' Bit #6: DSR sensitivity
   mblnDSRSensitiv = ((lngBitField And 2 ^ 6) <> 0)
   ' Bit #7: XOFF continues Tx
   mblnXoffTx = ((lngBitField And 2 ^ 7) <> 0)
   ' Bit #8: XON/XOFF out flow control
   mblnXonOffOut = ((lngBitField And 2 ^ 8) <> 0)
   ' Bit #9: XON/XOFF in flow control
   mblnXonOffIn = ((lngBitField And 2 ^ 9) <> 0)
   ' Bit #10: enable error replacement
   mblnErrRepl = ((lngBitField And 2 ^ 10) <> 0)
   ' Bit #11: enable null stripping
   mblnNullStrip = ((lngBitField And 2 ^ 11) <> 0)
   ' Bit #12: RTS flow control
   ' Bit #13: RTS flow control
   ' 0=RTS_CONTROL_DISABLE
   ' 1=RTS_CONTROL_ENABLE
   ' 2=RTS_CONTROL_HANDSHAKE
   ' 3=RTS_CONTROL_TOGGLE
   mbytRTS = mbytRTS + IIf((lngBitField And 2 ^ 12) <> 0, 1, 0)
   mbytRTS = mbytRTS + IIf((lngBitField And 2 ^ 13) <> 0, 2, 0)
   ' Bit #14: abort reads/writes on error l
   mblnAbortOnErr = ((lngBitField And 2 ^ 14) <> 0)
End Sub

Private Function SetBitFieldsInfo() As Long
   ' Die entsprechenden Bits der Flag-Variablen setzen
   Dim lngBitField As Long
   
   WriteLog "Interne Funktion SetBitFieldsInfo"
   
   ' Bit #0: Binary-Mode, bei Schnittstellen immer 1
   lngBitField = lngBitField Or 2 ^ 0
   ' Bit #1: enable parity checking
   If mblnParity Then lngBitField = lngBitField Or 2 ^ 1
   ' Bit #2: CTS output flow control
   If mblnCTS Then lngBitField = lngBitField Or 2 ^ 2
   ' Bit #3: DSR output flow control
   If mblnDSR Then lngBitField = lngBitField Or 2 ^ 3
   ' Bit #4: DTR flow control type
   ' Bit #5: DTR flow control type
   ' 0=DTR_CONTROL_DISABLE
   ' 1=DTR_CONTROL_ENABLE
   ' 2=DTR_CONTROL_HANDSHAKE
   If (mbytDTR And 2 ^ 0) <> 0 Then lngBitField = lngBitField Or 2 ^ 4
   If (mbytDTR And 2 ^ 1) <> 0 Then lngBitField = lngBitField Or 2 ^ 5
   ' Bit #6: DSR sensitivity
   If mblnDSRSensitiv Then lngBitField = lngBitField Or 2 ^ 6
   ' Bit #7: XOFF continues Tx
   If mblnXoffTx Then lngBitField = lngBitField Or 2 ^ 7
   ' Bit #8: XON/XOFF out flow control
   If mblnXonOffOut Then lngBitField = lngBitField Or 2 ^ 8
   ' Bit #9: XON/XOFF in flow control
   If mblnXonOffIn Then lngBitField = lngBitField Or 2 ^ 9
   ' Bit #10: enable error replacement
   If mblnErrRepl Then lngBitField = lngBitField Or 2 ^ 10
   ' Bit #11: enable null stripping
   If mblnNullStrip Then lngBitField = lngBitField Or 2 ^ 11
   ' Bit #12: RTS flow control
   ' Bit #13: RTS flow control
   ' 0=RTS_CONTROL_DISABLE
   ' 1=RTS_CONTROL_ENABLE
   ' 2=RTS_CONTROL_HANDSHAKE
   ' 3=RTS_CONTROL_TOGGLE
   If (mbytRTS And 2 ^ 0) <> 0 Then lngBitField = lngBitField Or 2 ^ 12
   If (mbytRTS And 2 ^ 1) <> 0 Then lngBitField = lngBitField Or 2 ^ 13
   ' Bit #14: abort reads/writes on error l
   If mblnAbortOnErr Then lngBitField = lngBitField Or 2 ^ 11
   ' Ab Bit #15 alles reserviert (ller)
   SetBitFieldsInfo = lngBitField
End Function

Private Sub WriteLog(LogString As String)
   Dim FF         As Long
   Dim i          As Long
   Dim strLog     As String
   On Error Resume Next
   If Not mblnLogWrite Then Exit Sub
   mstrLogString = Format(Now, "DD.MM.YYYY hh:nn:ss") & " : " & _
      LogString & vbCrLf & mstrLogString
   FF = FreeFile
   i = LOF(FF)
   Open mstrLogFile For Binary As FF
      i = LOF(FF)
      strLog = String(i, 0)
      Get #FF, , strLog
      strLog = Format(Now, "DD.MM.YYYY hh:nn:ss") & " : " & _
         LogString & vbCrLf & strLog
      Put #FF, 1, strLog
   Close
End Sub
Public Function GetLogString() As String
   GetLogString = mstrLogString
End Function

' Bitfield Bit Nr.: #1
Public Property Get EnableParity() As Boolean
   EnableParity = mblnParity
End Property
Public Property Let EnableParity(ByVal vNewValue As Boolean)
   mblnParity = vNewValue
End Property

' Bitfield Bit Nr.: #2
Public Property Get EnableCtsFlow() As Boolean
   EnableCtsFlow = mblnCTS
End Property
Public Property Let EnableCtsFlow(ByVal vNewValue As Boolean)
   mblnCTS = vNewValue
End Property

' Bitfield Bit Nr.: #3
Public Property Get EnableDsrFlow() As Boolean
   EnableDsrFlow = mblnDSR
End Property
Public Property Let EnableDsrFlow(ByVal vNewValue As Boolean)
   mblnDSR = vNewValue
End Property

' Bitfield Bit Nr.: #4, #5
Public Property Get DtrFlowType() As Byte
   DtrFlowType = mbytDTR
End Property
Public Property Let DtrFlowType(ByVal vNewValue As Byte)
   ' 0=DTR_CONTROL_DISABLE
   ' 1=DTR_CONTROL_ENABLE
   ' 2=DTR_CONTROL_HANDSHAKE
   If vNewValue > 2 Then
      mbytDTR = 0
   Else
      mbytDTR = vNewValue
   End If
End Property

' Bitfield Bit Nr.: #6
Public Property Get EnableDSRSensitive() As Boolean
   EnableDSRSensitive = mblnDSRSensitiv
End Property
Public Property Let EnableDSRSensitive(ByVal vNewValue As Boolean)
   mblnDSRSensitiv = vNewValue
End Property

' Bitfield Bit Nr.: #7
Public Property Get EnableXoffContinuesTx() As Boolean
   EnableXoffContinuesTx = mblnXoffTx
End Property
Public Property Let EnableXoffContinuesTx(ByVal vNewValue As Boolean)
   mblnXoffTx = vNewValue
End Property

' Bitfield Bit Nr.: #8
Public Property Get EnableXonOffOut() As Boolean
   EnableXonOffOut = mblnXonOffOut
End Property
Public Property Let EnableXonOffOut(ByVal vNewValue As Boolean)
   mblnXonOffOut = vNewValue
End Property

' Bitfield Bit Nr.: #9
Public Property Get EnableXonOffIn() As Boolean
   EnableXonOffIn = mblnXonOffIn
End Property
Public Property Let EnableXonOffIn(ByVal vNewValue As Boolean)
   mblnXonOffIn = vNewValue
End Property

' Bitfield Bit Nr.: #10
Public Property Get EnableErrReplace() As Boolean
   EnableErrReplace = mblnErrRepl
End Property
Public Property Let EnableErrReplace(ByVal vNewValue As Boolean)
   mblnErrRepl = vNewValue
End Property

' Bitfield Bit Nr.: #11
Public Property Get EnableNullStrip() As Boolean
   EnableNullStrip = mblnNullStrip
End Property
Public Property Let EnableNullStrip(ByVal vNewValue As Boolean)
   mblnNullStrip = vNewValue
End Property

' Bitfield Bit Nr.: #12, #13
Public Property Get RtsFlowControl() As Byte
   RtsFlowControl = mbytRTS
End Property
Public Property Let RtsFlowControl(ByVal vNewValue As Byte)
   ' 0=RTS_CONTROL_DISABLE
   ' 1=RTS_CONTROL_ENABLE
   ' 2=RTS_CONTROL_HANDSHAKE
   ' 3=RTS_CONTROL_TOGGLE
   If vNewValue > 3 Then
      mbytRTS = 0
   Else
      mbytRTS = vNewValue
   End If
End Property

' Bitfield Bit Nr.: #14
Public Property Get EnableAbortOnError() As Boolean
   EnableAbortOnError = mblnAbortOnErr
End Property
Public Property Let EnableAbortOnError(ByVal vNewValue As Boolean)
   mblnAbortOnErr = vNewValue
End Property

Public Property Get EvtChar() As Byte
   EvtChar = mbyteEvtChar
End Property
Public Property Let EvtChar(ByVal vNewValue As Byte)
   mbyteEvtChar = vNewValue
End Property

Public Property Get EofChar() As Byte
   EofChar = mbyteEofChar
End Property
Public Property Let EofChar(ByVal vNewValue As Byte)
   mbyteEofChar = vNewValue
End Property

Public Property Get ErrorChar() As Byte
   ErrorChar = mbyteErrorChar
End Property
Public Property Let ErrorChar(ByVal vNewValue As Byte)
   mbyteErrorChar = vNewValue
End Property

Public Property Get XoffChar() As Byte
   XoffChar = mbyteXoffChar
End Property
Public Property Let XoffChar(ByVal vNewValue As Byte)
   mbyteXoffChar = vNewValue
End Property

Public Property Get XonChar() As Byte
   XonChar = mbyteXonChar
End Property
Public Property Let XonChar(ByVal vNewValue As Byte)
   mbyteXonChar = vNewValue
End Property

Public Property Get StopBits() As Double
   Select Case mbyteStopBits
      Case ONE5STOPBITS
         StopBits = 1.5
      Case TWOSTOPBITS
         StopBits = 2
      Case Else
         StopBits = 1
   End Select
End Property
Public Property Let StopBits(ByVal vNewValue As Double)
   Select Case Format(vNewValue * 10, "0")
      Case "15"
         mbyteStopBits = ONE5STOPBITS
      Case "20"
         mbyteStopBits = TWOSTOPBITS
      Case Else
         mbyteStopBits = ONESTOPBIT
   End Select
End Property

Public Property Get Parity() As Byte
   Parity = mbyteParity
End Property
Public Property Let Parity(ByVal vNewValue As Byte)
   Select Case Format(vNewValue, "0")
      Case "1" 'PARITY_ODD
         mbyteParity = 1
      Case "2" 'PARITY_EVEN
         mbyteParity = 2
      Case "3" 'PARITY_MARK
         mbyteParity = 3
      Case "4" 'PARITY_SPACE
         mbyteParity = 4
      Case Else 'PARITY_NONE
         mbyteParity = 0
   End Select
End Property

Public Property Get XoffLim() As Integer
   XoffLim = mintXoffLim
End Property
Public Property Let XoffLim(ByVal vNewValue As Integer)
   mintXoffLim = vNewValue
End Property

Public Property Get XonLim() As Integer
   XonLim = mintXonLim
End Property
Public Property Let XonLim(ByVal vNewValue As Integer)
   mintXonLim = vNewValue
End Property

Public Property Get BaudRate() As Long
   BaudRate = mlngBaudRate
End Property
Public Property Let BaudRate(ByVal vNewValue As Long)
   mlngBaudRate = vNewValue
End Property

Public Property Get DataBits() As Byte
   DataBits = mbyteDataBits
End Property
Public Property Let DataBits(ByVal vNewValue As Byte)
   mbyteDataBits = vNewValue
End Property

Public Property Get ReadIntervalTimeout() As Long
   ReadIntervalTimeout = mlngReadIntervalTimeout
End Property
Public Property Let ReadIntervalTimeout(ByVal vNewValue As Long)
   mlngReadIntervalTimeout = vNewValue
End Property

Public Property Get ReadTotalTimeoutMultiplier() As Long
   ReadTotalTimeoutMultiplier = mlngReadTotalTimeoutMultiplier
End Property
Public Property Let ReadTotalTimeoutMultiplier(ByVal vNewValue As Long)
   mlngReadTotalTimeoutMultiplier = vNewValue
End Property

Public Property Get ReadTotalTimeoutConstant() As Long
   ReadTotalTimeoutConstant = mlngReadTotalTimeoutConstant
End Property
Public Property Let ReadTotalTimeoutConstant(ByVal vNewValue As Long)
   mlngReadTotalTimeoutConstant = vNewValue
End Property

Public Property Get WriteTotalTimeoutMultiplier() As Long
   WriteTotalTimeoutMultiplier = mlngWriteTotalTimeoutMultiplier
End Property
Public Property Let WriteTotalTimeoutMultiplier(ByVal vNewValue As Long)
   mlngWriteTotalTimeoutMultiplier = vNewValue
End Property

Public Property Get WriteTotalTimeoutConstant() As Long
   WriteTotalTimeoutConstant = mlngWriteTotalTimeoutConstant
End Property
Public Property Let WriteTotalTimeoutConstant(ByVal vNewValue As Long)
   mlngWriteTotalTimeoutConstant = vNewValue
End Property


Public Property Get LogText() As String
   LogText = mstrLogString
End Property

Public Property Get LogWrite() As Boolean
   LogWrite = mblnLogWrite
End Property
Public Property Let LogWrite(ByVal vNewValue As Boolean)
   mblnLogWrite = vNewValue
End Property

Public Property Let LogFile(ByVal vNewValue As String)
   mstrLogFile = vNewValue
End Property
Public Property Get LogFile() As String
   LogFile = mstrLogFile
End Property

Wer näheres über das eigentlich verwendete Protokoll  und die Spezifikationen der seriellen Schnittstelle erfahren möchte, sollte eine Suchmaschine verwenden. Die Internetseite http://de.wikipedia.org/wiki/EIA-232 ist auch eine gute Anlaufstelle.

Die bereitgestellten Eigenschaften und Methoden der Klasse werden nachfolgend nur kurz angesprochen, ohne Garantie auf Vollständigkeit oder Richtigkeit.

Die Eigenschaft DataBits

Die Eigenschaft DataBits legt die Anzahl der Datenbits fest.

Die Eigenschaft BaudRate

Die Eigenschaft BaudRate legt die Baudrate fest.

Die Eigenschaft Parity, EnableParity

Die Eigenschaft Parity legt die Parität fest, wenn die Eigenschaft EnableParity gesetzt ist. Möglich sind  die Werte PARITY_ODD (1), PARITY_EVEN (2), PARITY_MARK (3), PARITY_SPACE (4) und PARITY_NONE (0).

Die Eigenschaft StopBits

Die Eigenschaft StopBits legt die Anzahl der Stopbits fest. Möglich sind  die Werte ONE5STOPBITS (1,5), TWOSTOPBITS (2) und ONESTOPBIT (1).

Die Eigenschaften ErrorChar, EnableErrReplace

Die Eigenschaft ErrorChar legt die das Zeichen fest, welches bei einem Fehler verwendet wird, wenn die Eigenschaft EnableErrReplace gesetzt ist.

Die Eigenschaft EnableAbortOnError

Die Eigenschaft EnableAbortOnError legt fest, ob bei einem Fehler abgebrochen wird.

Die Eigenschaft EofChar

Die Eigenschaft EofChar legt die das Zeichen fest, welches das Ende des Inputs signalisiert.

Die Eigenschaft EvtChar

Die Eigenschaft EvtChar legt die das Zeichen fest, welches ein Ereignis signalisiert.

Die Eigenschaften XonLim, XoffLim,  XoffChar,  XonChar sowie EnableXoffContinuesTx , EnableXonOffOut, EnableXonOffIn,

Diese Eigenschaften sind für das XON/XOFF-Protokoll zuständig. Beim Verwenden dieses Protokolls steuert die Empfangsstation den Datenfluss mit den beiden Steuerzeichen XON und XOFF. Ist der Empfänger bereit, sendet er beispielsweise das XON-Steuerzeichen, kann er keine Daten aufnehmen, sendet er XOFF.

Die Eigenschaft RtsFlowControl

Die Eigenschaft RtsFlowControl legt die Flusskontrolle (RTS/CTS)  fest. Möglich sind die Werte RTS_CONTROL_ENABLE (1), RTS_CONTROL_HANDSHAKE (2), RTS_CONTROL_TOGGLE
 (3), PARITY_SPACE (4) und RTS_CONTROL_DISABLE (0).

Die Eigenschaft DtrFlowType

Die Eigenschaft DtrFlowType legt die Flusskontrolle (DTR)  fest. Möglich sind die Werte DTR_CONTROL_ENABLE (1), DTR_CONTROL_HANDSHAKE (2) und DTR_CONTROL_DISABLE (0).

Die Eigenschaft EnableNullStrip

Die Eigenschaft EnableNullStrip legt fest, ob beim Empfangen Nullzeichen ignoriert werden.

Die Eigenschaft EnableCtsFlow

Die Eigenschaft EnableCtsFlow legt fest, ob die CTS-Flusskontrolle eingeschaltet ist. Eine logische Null am CTS-Eingang ist ein Signal der Gegenstelle, dass sie Daten entgegennehmen kann.

Die Eigenschaft EnableDsrFlow

Die Eigenschaft EnableDsrFlow legt fest, ob die DSR-Flusskontrolle eingeschaltet ist. Eine logische Null am DSR-Eingang ist ein Signal der Datenübertragungseinrichtung (z.B. Modem), dass sie betriebsbereit ist.

Die Eigenschaften WriteTotalTimeoutConstant, WriteTotalTimeoutMultiplier, ReadTotalTimeoutConstant, ReadTotalTimeoutMultiplier und ReadIntervalTimeout

Die Eigenschaft ReadIntervalTimeout legt die Wartezeit auf den Eingang eines Zeichens in Millisekunden pro Zeichen fest. ReadTotalTimeoutConstant legt die Zeit bis zu einem Abbruch der Leseoperation in Millisekunden fest,  hinzu kommt noch die Zeit, die durch  ReadTotalTimeoutMultiplier in Millisekunden pro Zeichen festgelegt wird.

Die Eigenschaft WriteTotalTimeoutConstant legt die Zeit bis zu einem Abbruch der Schreiboperation in Millisekunden fest, hinzu kommt noch die Zeit, die durch  WriteTotalTimeoutMultiplier in Millisekunden pro Zeichen angegeben wird.

Die Prozedur ReadComSettings

Die Prozedur ReadComSettings liest die aktuellen Einstellungen einer geöffneten Comm-Schnittstelle aus und speichert sie in klassenweit gültigen Variablen.

Dazu wird die Struktur mudtSettings  vom Typ DCB zusammen mit dem Handle der geöffneten Schnittstelle an die API-Funktion GetCommState übergeben. Zuvor muss noch das Element DCBlength der Struktur DCB mit der Länge der Struktur in Bytes gefüllt werden.

Anschließend enthält diese Struktur die ausgelesenen Informationen. Der Aufruf der Funktion GetBitFieldsInfo dient dazu, aus der Long-Variablen des Elements fBitFields verschiedene Informationen zu extrahieren. In der Variablen stellen einzelne oder mehrere Bits sogenannte Flags dar und repräsentieren verschiedene gesetzte oder nicht gesetzte Eigenschaften der Schnittstelle.

Danach wird die interne Funktion ReadTimeoutSettings aufgerufen, in der die eingestellten Timeout-Einstellungen ausgelesen werden.

Die Prozedur SetComSettings

Die Methode SetComSettings setzt die aktuellen Einstellungen einer geöffneten Comm-Schnittstelle.

 Zu Beginn muss in der Struktur DCB das Element DCBlength mit der Länge der Struktur und dessen andere Elemente mit den Informationen der klassenweit gültigen Variablen gefüllt werden. Der Aufruf der Funktion SetBitFieldsInfo dient dazu, eine Long-Variable zu erhalten, in der einzelne oder mehrere Bits sogenannte Flags darstellen und verschiedene gesetzte oder nicht gesetzte Eigenschaften der Schnittstelle repräsentieren. Das Element fBitFields der Struktur DCB nimmt diesen Wert auf.

Zum Setzen der in der Struktur DCB steckenden Eigenschaften wird diese zusammen mit dem Handle der geöffneten Schnittstelle an die API-Funktion SetCommState übergeben. Schließlich wird noch die interne Funktion SetTimeoutSettings aufgerufen, in der die Timeout-Einstellungen gesetzt werden.

Die Prozedur ReadTimeoutSettings

Die interne Prozedur ReadTimeoutSettings liest die aktuellen Timeout-Einstellungen einer geöffneten Comm-Schnittstelle aus. Dazu wird eine Struktur vom Typ COMMTIMEOUTS zusammen mit dem Comm-Handle an die Funktion GetCommTimeouts übergeben. Nach der Rückkehr enthält die Struktur die ausgelesenen Einstellungen, welche in klassenweit gültigen Variablen gespeichert werden.

Die Prozedur SetTimeoutSettings

Die interne Prozedur SetTimeoutSettings setzt die Timeout-Einstellungen einer geöffneten Comm-Schnittstelle. Dazu wird eine mit den Inhalten der klassenweit gültigen Variablen ausgefüllten Struktur vom Typ COMMTIMEOUTS zusammen mit dem Comm-Handle an die Funktion SetCommTimeouts übergeben.

Die interne Prozedur WriteLog

Die interne Prozedur WriteLog setzt einen String zusammen, der die Logdaten enthält. Übergeben wird ein Text, der um die aktuelle Zeit ergänzt, an den Anfang des Variableninhalts der klassenweit gültigen Variablen mstrLogString gesetzt wird.

Ist die Variable mblnLogWrite auf Wahr gesetzt, wird die Textdatei, deren Position in der Variablen mstrLogFile steht, um den aktuellen Eintrag ergänzt.

Die Eigenschaft LogText

Die Eigenschaft LogText liefert einen String, der die Logdaten der Klasse enthält.

Die Eigenschaft LogFile

Die Eigenschaft LogFile liefert und legt den Namen und Pfad der Logdatei fest.

Die Eigenschaft LogWrite

Die Eigenschaft LogWrite legt fest, dass der Logtext kontinuierlich in eine Datei ausgegeben wird.