199 lines
6.1 KiB
Plaintext
199 lines
6.1 KiB
Plaintext
VERSION 5.00
|
|
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
|
|
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
|
|
Begin VB.Form frmRS232Test
|
|
Caption = "Form1"
|
|
ClientHeight = 8940
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 10920
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 8940
|
|
ScaleWidth = 10920
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin MSCommLib.MSComm MSComm1
|
|
Index = 0
|
|
Left = 360
|
|
Top = 8160
|
|
_ExtentX = 1005
|
|
_ExtentY = 1005
|
|
_Version = 393216
|
|
DTREnable = -1 'True
|
|
End
|
|
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
|
|
Height = 7755
|
|
Left = 0
|
|
TabIndex = 0
|
|
Top = 120
|
|
Width = 10035
|
|
_ExtentX = 17701
|
|
_ExtentY = 13679
|
|
_Version = 393216
|
|
End
|
|
Begin VB.Label lblAutosize
|
|
BorderStyle = 1 'Fest Einfach
|
|
Caption = "Label1"
|
|
Height = 315
|
|
Left = 6780
|
|
TabIndex = 1
|
|
Top = 8280
|
|
Width = 795
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmRS232Test"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
|
|
|
|
Private mstrBuffer(20) As String
|
|
|
|
Private Enum Spalte
|
|
Spalte_COMPORT = 1
|
|
Spalte_Config = 2
|
|
Spalte_Event = 3
|
|
Spalte_LenData = 4
|
|
Spalte_Data = 5
|
|
|
|
End Enum
|
|
|
|
Private Sub Form_Load()
|
|
Dim iPort As Integer
|
|
MSFlexGrid1.Rows = 1
|
|
|
|
Me.Visible = True
|
|
|
|
MSFlexGrid1.Cols = Spalte_Data + 1
|
|
MSFlexGrid1.TextMatrix(0, Spalte_COMPORT) = "COM"
|
|
MSFlexGrid1.TextMatrix(0, Spalte_Config) = "Config"
|
|
MSFlexGrid1.TextMatrix(0, Spalte_Event) = "Event"
|
|
MSFlexGrid1.TextMatrix(0, Spalte_LenData) = "Länge"
|
|
MSFlexGrid1.TextMatrix(0, Spalte_Data) = "Data -"
|
|
|
|
For iPort = 1 To 20
|
|
load MSComm1(iPort)
|
|
MSFlexGrid1.AddItem iPort
|
|
OpenComPort iPort
|
|
Next
|
|
|
|
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
|
End Sub
|
|
|
|
Private Function OpenComPort(iPort As Integer) As Boolean
|
|
On Error GoTo Errorhandler
|
|
If MSComm1(iPort).PortOpen = False Then
|
|
MSComm1(iPort).CommPort = iPort
|
|
|
|
With MSComm1(iPort)
|
|
.Handshaking = comNone
|
|
|
|
.RThreshold = 1 ' Event feuern, sobald x Zeichen empfangen wird
|
|
.InBufferSize = 1024
|
|
.RTSEnable = False
|
|
.DTREnable = False
|
|
.EOFEnable = False
|
|
End With
|
|
|
|
MSComm1(iPort).PortOpen = True
|
|
OpenComPort = True
|
|
End If
|
|
Exit Function
|
|
Errorhandler:
|
|
MSFlexGrid1.TextMatrix(iPort, Spalte_Event) = Err.Description
|
|
End Function
|
|
|
|
Private Sub CloseComPort(iPort As Integer)
|
|
On Error GoTo Errorhandler
|
|
If MSComm1(iPort).PortOpen = True Then
|
|
MSComm1(iPort).PortOpen = False
|
|
End If
|
|
Exit Sub
|
|
Errorhandler:
|
|
End Sub
|
|
|
|
Private Sub Form_Unload(Cancel As Integer)
|
|
Dim iPort As Integer
|
|
For iPort = 1 To 20
|
|
CloseComPort iPort
|
|
Next
|
|
End Sub
|
|
|
|
|
|
Private Sub MSComm1_OnComm(Index As Integer)
|
|
Dim intComEvent As Integer
|
|
Dim strComEvent As String
|
|
Dim strData As String
|
|
Dim arTelegramme() As String
|
|
Dim iAnzahlTeilZeilenendzeichen As Integer
|
|
|
|
intComEvent = MSComm1(Index).CommEvent
|
|
|
|
|
|
Select Case intComEvent
|
|
' Errors
|
|
Case comEventBreak ' A Break was received.
|
|
strComEvent = "comEventBreak"
|
|
Case comEventCDTO ' CD (RLSD) Timeout.
|
|
strComEvent = "comEventCDTO"
|
|
Case comEventCTSTO ' CTS Timeout.
|
|
strComEvent = "comEventCTSTO"
|
|
Case comEventDSRTO ' DSR Timeout.
|
|
strComEvent = "comEventDSRTO"
|
|
Case comEventFrame ' Framing Error.
|
|
strComEvent = "comEventFrame"
|
|
Case comEventOverrun ' Data Lost.
|
|
strComEvent = "comEventOverrun"
|
|
Case comEventRxOver ' Receive buffer overflow.
|
|
strComEvent = "comEventRxOver"
|
|
Case comEventRxParity ' Parity Error.
|
|
strComEvent = "comEventRxParity"
|
|
Case comEventTxFull ' Transmit buffer full.
|
|
strComEvent = "comEventTxFull"
|
|
Case comEventDCB ' Unexpected error retrieving DCB]
|
|
strComEvent = "comEventDCB"
|
|
Case comEvCD ' Change in the CD line.
|
|
strComEvent = "comEvCD"
|
|
Case comEvCTS ' Change in the CTS line.
|
|
strComEvent = "comEvCTS"
|
|
Case comEvDSR ' Change in the DSR line.
|
|
strComEvent = "comEvDSR"
|
|
Case comEvRing ' Change in the Ring Indicator.
|
|
strComEvent = "comEvRing"
|
|
Case comEvReceive ' Received RThreshold # of chars. Lese ale emfangene Daten in Einbauplatz eigenen Buffer
|
|
strComEvent = "comEvReceive"
|
|
Case comEvSend ' There are SThreshold number of characters in the transmit buffer.
|
|
strComEvent = "comEvSend"
|
|
Case comEvEOF ' An EOF character was found
|
|
strComEvent = "comEvEOF"
|
|
Case Else
|
|
strComEvent = "unknown"
|
|
End Select
|
|
|
|
MSFlexGrid1.TextMatrix(Index, Spalte_Event) = strComEvent
|
|
Debug.Print "Event (" & Index & "): " & strComEvent
|
|
|
|
If intComEvent = comEvReceive Then
|
|
strData = MSComm1(Index).Input
|
|
' an Buffer anhängen
|
|
mstrBuffer(Index) = mstrBuffer(Index) & strData
|
|
arTelegramme = Split(mstrBuffer(Index), vbCrLf)
|
|
' letztes Telegramm vor dem letzten ZEILENENDZEICHEN
|
|
iAnzahlTeilZeilenendzeichen = UBound(arTelegramme)
|
|
If iAnzahlTeilZeilenendzeichen > 0 Then
|
|
' Es gibt ein Zeilenendzeichen, also
|
|
' letztes Telegramm bis zum Zeilenendzeichen lesen
|
|
strData = arTelegramme(UBound(arTelegramme) - 1)
|
|
MSFlexGrid1.TextMatrix(Index, Spalte_Data) = strData
|
|
' nächstes Fragment ggF merken für nächstes Telegramm
|
|
mstrBuffer(Index) = arTelegramme(UBound(arTelegramme))
|
|
Else
|
|
MSFlexGrid1.TextMatrix(Index, Spalte_Data) = mstrBuffer(Index)
|
|
End If
|
|
End If
|
|
|
|
|
|
End Sub
|