laatzen/Pruef2000/source/frmRS232Test.frm

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<6E>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