RS 232 Daten gehen verlohren

Jaeko

Grünschnabel
Hallo User,
ich möchte mich erstmal vorstellen.
mein Name ist Frank und ich bin 55 Jahre alt.
Ich beschäftige mich seit geraumer Zeit damit Daten über die RS 232 auszulesen und dann
graphisch in Excel aufzuarbeiten. Das funktioniert soweit. Die Daten kommen von einem
µC über den UART zum PC. Das funktioniert.
Ich habe mir die Daten über ein Terminal Programm anzeigen lassen dabei gab es keine
Fehler.
Lasse ich das gleich mir dann über Excel anzeigen bekomme ich Fehler in der graphischen
Darstellung weil auf einmal Daten weg sind und ich weiss nicht warum. Im Terminalprogramm
sind ja immer alle Daten da. Bei den Daten handelt es sich um einfache Zahlen von 0 bis 9.

Die Daten werden als einfacher String übertragen. Der Datenstring sieht wie folgt aus.
9911111111190 das ist alles.
Die Bedeutung des Datenstring ist:
99 - Bahnnummer
1 - Kegel die gefallen sind max. 9
Die letzte 0 steht dafür ob es ein Kranzhand war.

Wenn ich nun das Excel Programm laufen lasse passiert folgendes.
Es kommt vor das die Würfe 1 und 2 richtig im PC ankommen und auch graphisch ausgegeben
werden, also der empfangene String zB. 9911111111190 ( alle Kegel gefallen also 9 ).
Dann sag ich mal sollte wieder 9911111111190 ankommen, war der 3 Wurf. Jetzt wird mir
aber auf einmal nur sowas angezeigt 11111190. Also die ersten 5 Zeichen sind weg.
Bei den nächsten würfen stimmt das dann wieder usw. das verstehe ich nicht.

Hier mal der Code vom Klassenmodul. Den Programmcode habe ich aus dem Internet
nicht das gemeint wird der ist von mir. Ehrlich gesagt sind da ein paar Programmzeilen
drin die sind für mich Böhmische Dörfer und ich will mich nicht mit fremden Federn schmücken.
Visual Basic:
Option Explicit
Dim klk As Integer
Private Type DCB
    DCBlength As Long
    BaudRate As Long
    '...................
    fBinary As Long
    fParity As Long
    fOutxCtsFlow As Long
    fOutxDsrFlow As Long
    fDtrControl As Long
    fDsrSensitivity As Long
    fTXContinueOnXoff As Long
    fOutX As Long
    fInX As Long
    fErrorChar As Long
    fNull As Long
    fRtsControl As Long
    fAbortOnError As Long
    fDummy2 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
End Type


' DTR Control Flow Values
Const DTR_CONTROL_DISABLE = &H0
Const DTR_CONTROL_ENABLE = &H1
Const DTR_CONTROL_HANDSHAKE = &H2
                                       
' RTS Control Flow Values
Const RTS_CONTROL_DISABLE = &H0
Const RTS_CONTROL_ENABLE = &H1
Const RTS_CONTROL_HANDSHAKE = &H2
Const RTS_CONTROL_TOGGLE = &H3

Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const OPEN_EXISTING = 3
Const FILE_ATTRIBUTE_NORMAL = &H80


' PURGE function flags.
Const PURGE_TXABORT = &H1     '  Kill the pending/current writes to the comm port.
Const PURGE_RXABORT = &H2     '  Kill the pending/current reads to the comm port.
Const PURGE_TXCLEAR = &H4     '  Kill the transmit queue if there.
Const PURGE_RXCLEAR = &H8     '  Kill the receive queue if there.

' Escape Functions (not necassary!)
Const SETRTS = 3                   ' Set RTS high
Const CLRRTS = 4                   ' Set RTS low
Const SETDTR = 5                   ' Set DTR high
Const CLRDTR = 6                   ' Set DTR low
Const SETBREAK = 8                 ' Set the device break line.
Const CLRBREAK = 9                 ' Clear the device break line.


'  Modem Status Flags
Const MS_CTS_ON = &H10 'The CTS (clear-to-send) signal is on.
Const MS_DSR_ON = &H20 'The DSR (data-set-ready) signal is on.
Const MS_RING_ON = &H40 'The ring indicator signal is on.
Const MS_RLSD_ON = &H80 'The RLSD (receive-line-signal-detect) signal is on.

' Error Flags
Const CE_RXOVER = &H1     ' Receive Queue overflow
Const CE_OVERRUN = &H2    ' Receive Overrun Error
Const CE_RXPARITY = &H4   ' Receive Parity Error
Const CE_FRAME = &H8      ' Receive Framing error
Const CE_BREAK = &H10     ' Break Detected
Const CE_TXFULL = &H100   ' TX Queue is full

Private Type COMMTIMEOUTS
    ReadIntervalTimeout As Long
    ReadTotalTimeoutMultiplier As Long
    ReadTotalTimeoutConstant As Long
    WriteTotalTimeoutMultiplier As Long
    WriteTotalTimeoutConstant As Long
End Type

Private Type COMSTAT
        fBitFields As Long
        cbInQue As Long
        cbOutQue As Long
End Type

Private Type CommRec
    bCommPort As Byte
    boPortOpen As Boolean
    lTimeout As Long
    boTimeout As Boolean
    lInputLen As Integer
    sSettings As String
    iInBufferSize As Integer
    iOutBufferSize As Integer
    tDCB As DCB
    tCOMMTIMEOUTS As COMMTIMEOUTS
    EOL As String * 1
    EOL_On As Boolean
End Type

Private Type CommRecSav
    lHandleSav As Long
    tDCBSav As DCB
    tCOMMTIMEOUTSSav As COMMTIMEOUTS
End Type


Const FileName = "VBAComm"      ' Full name : "VBAComm" + CommPort + ".dat"
Dim lHandle As Long
Dim tCOMSTAT As COMSTAT
Dim tCommRec As CommRec
Dim tCRSav As CommRecSav
Dim sFileName As String



Private Declare PtrSafe Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Private Declare PtrSafe 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

Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Private Declare PtrSafe Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, lpBuffer As Any, ByVal _
                        nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
                        lpOverlapped As Any) As Long
                       
Private Declare PtrSafe Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal _
                        nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _
                        lpOverlapped As Any) As Long
                      
Private Declare PtrSafe Function SetCommState Lib "kernel32" (ByVal nCid As Long, ByRef lpDCB As DCB) As Long
Private Declare PtrSafe Function GetCommState Lib "kernel32" (ByVal nCid As Long, ByRef lpDCB As DCB) As Long
Private Declare PtrSafe Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, _
                        lpCommTimeouts As COMMTIMEOUTS) As Long
Private Declare PtrSafe Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, _
                        lpCommTimeouts As COMMTIMEOUTS) As Long
                       
Private Declare PtrSafe Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function SetupCOMM Lib "kernel32" Alias "SetupComm" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Private Declare PtrSafe Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
Private Declare PtrSafe Function EscapeCommFunction Lib "kernel32" (ByVal hFile As Long, ByVal nFunc As Long) As Long
Private Declare PtrSafe Function SetCommBreak Lib "kernel32" (ByVal nCid As Long) As Long
Private Declare PtrSafe Function ClearCommBreak Lib "kernel32" (ByVal nCid As Long) As Long
Private Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long
Private Declare PtrSafe Function GetCommModemStatus Lib "kernel32" (ByVal hFile As Long, lpModemStat As Long) As Long
Private Sub Class_Initialize()
    SetUp_DCB
    With tCommRec
        .lTimeout = 0
        .bCommPort = 1
        .boPortOpen = False
        .iInBufferSize = 1024
        .iOutBufferSize = 1024
        .lInputLen = 1
        .EOL = Chr(10) ' EOL=End of line (Terminator) , LF=Line feed
        .EOL_On = True 'EOL will be added at the end of the String
        .boTimeout = False
    End With
End Sub

Public Property Let PurgeBuffer(ByVal lFlags As Integer)
    If tCommRec.boPortOpen Then
        Call PurgeComm(lHandle, ByVal lFlags)
    End If
End Property
Public Property Get Timeout() As Boolean
    Timeout = tCommRec.boTimeout
End Property
Public Property Let InputLen(ByVal lLen As Integer)
    tCommRec.lInputLen = lLen
End Property
Public Property Let EOL_Terminator(sEOL As String)
    tCommRec.EOL = sEOL
End Property
Public Property Let EOL_On(boEOL As Boolean)
    tCommRec.EOL_On = boEOL
End Property
Public Property Get InBufferCount() As Integer
    Dim lBuf, lErrors, lStartTime As Long
    lStartTime = GetTickCount
    With tCommRec
        .boTimeout = False
        Do
          Call ClearCommError(lHandle, lErrors, tCOMSTAT)
          lBuf = GetTickCount
          If (lBuf - lStartTime) < 0 Then lStartTime = lBuf + .lTimeout
        Loop Until (lBuf - lStartTime) >= .lTimeout Or tCOMSTAT.cbInQue >= .lInputLen
        If tCOMSTAT.cbInQue < .lInputLen Then .boTimeout = True
    End With
    InBufferCount = tCOMSTAT.cbInQue
End Property
Public Property Get OutBufferCount() As Integer
    Dim lBuf, lErrors As Long
    With tCommRec
        Call ClearCommError(lHandle, lErrors, tCOMSTAT)
        OutBufferCount = tCOMSTAT.cbOutQue
    End With
End Property

 Public Property Get ReadLine() As String     *****HIER VERMUTE ICH DEN FEHLER******
'Reads comm until Char=<LF>* or TimeOut
'* Or user defined character
    Dim sLine_ As String
    Dim sChar As String * 1
    Dim bChar As Byte
    Dim lNumread, lStartTime, lBuf As Long
    sLine_ = ""
    sChar = ""
    With tCommRec
        .boTimeout = False
        lStartTime = GetTickCount
        Do
             Call ReadFile(lHandle, ByVal sChar, 1, lNumread, ByVal CLng(0))
             If lNumread > 0 Then
                bChar = Asc(sChar)
               If bChar = Asc(.EOL) Then Exit Do
               If bChar > 31 And bChar < 128 Then sLine_ = sLine_ + sChar
             End If
             lBuf = GetTickCount
             If (lBuf - lStartTime) < 0 Then lStartTime = lBuf + tCommRec.lTimeout
        Loop Until (lBuf - lStartTime) >= tCommRec.lTimeout
        If bChar <> Asc(.EOL) Then .boTimeout = True
        ReadLine = sLine_
        If ReadLine <> "" Then
            Worksheets(1).Range("cq15").Value = ReadLine
            klk = klk + 1
        End If
    End With
    'PurgeBuffer = PURGE_RXCLEAR 'Delete all character behind EOF
End Property

Public Property Let PortOpen(ByVal bState As Boolean)
    Dim FileNum As Integer
    Dim sPortNum, sCommPort As String
    If tCommRec.boPortOpen And bState Then Exit Property
    With tCommRec
        If bState Then
            If .bCommPort >= 1 Or .bCommPort <= 4 Then
                sPortNum = Right(Str(.bCommPort), 1)
                sCommPort = "COM" & sPortNum
                sFileName = FileName + sPortNum + ".tmp"
                FileNum = FreeFile
                Open sFileName For Binary As #FileNum Len = Len(tCRSav)
                Get #FileNum, 1, tCRSav
                If tCRSav.lHandleSav <> 0 Then
                    lHandle = tCRSav.lHandleSav
                    Call SetCommState(lHandle, tCRSav.tDCBSav)
                    Call SetCommTimeouts(lHandle, tCRSav.tCOMMTIMEOUTSSav)
                    Call CloseHandle(tCRSav.lHandleSav)
                    .boPortOpen = False
                End If
                Close #FileNum
                lHandle = CreateFile(sCommPort, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, _
                                    FILE_ATTRIBUTE_NORMAL, 0)
                If lHandle <> -1 Then
                    .boPortOpen = True
                    Call GetCommState(lHandle, tCRSav.tDCBSav)
                    Call GetCommTimeouts(lHandle, tCRSav.tCOMMTIMEOUTSSav)
                    FileNum = FreeFile
                    Open sFileName For Binary As #FileNum Len = Len(tCRSav)
                    tCRSav.lHandleSav = lHandle
                    Put #FileNum, 1, tCRSav
                    Close #FileNum
                    Call SetCommState(lHandle, .tDCB)
                    With .tCOMMTIMEOUTS
                        .ReadIntervalTimeout = &HFFFFFFFF
                        .ReadTotalTimeoutMultiplier = 0
                        .ReadTotalTimeoutConstant = 0
                        .WriteTotalTimeoutMultiplier = 0
                        .WriteTotalTimeoutConstant = 0
                    End With
                    Call SetCommTimeouts(lHandle, .tCOMMTIMEOUTS)
                Else
                    .boPortOpen = False
                End If
            End If
        Else
            If .boPortOpen Then
                Call SetCommTimeouts(lHandle, tCRSav.tCOMMTIMEOUTSSav)
                Call SetCommState(lHandle, tCRSav.tDCBSav)
                Call CloseHandle(lHandle)
                On Error Resume Next
                Kill sFileName
                .boPortOpen = False
            End If
        End If
    End With
End Property

Public Property Get PortOpen() As Boolean
    PortOpen = tCommRec.boPortOpen
End Property

Public Property Let CommPort(bPort As Byte)
  tCommRec.bCommPort = bPort
End Property

Public Property Let Settings(sSettings As String)
    ' Parameter: "Baudrate,Parity,Databits, Stopbits"
    Call BuildCommDCB(sSettings, tCommRec.tDCB)  'Create device control block
    If tCommRec.boPortOpen Then
        Call SetCommState(lHandle, tCommRec.tDCB)
    End If
End Property
Public Property Let Handshaking(iHandshaking As Integer)
' Parameter: "None", "RTS", "DTR" or  "XOnXOff"
    With tCommRec.tDCB
        Select Case iHandshaking
            Case 0 ' NONE
                 .fBinary = 1
                 .fDsrSensitivity = 1
                 .fDtrControl = DTR_CONTROL_ENABLE
                 .fRtsControl = RTS_CONTROL_ENABLE
                 .fInX = 0
                 .fOutX = 0
            Case 1 ' RTS
                 .fBinary = 1
                 .fDsrSensitivity = 1
                 .fDtrControl = DTR_CONTROL_HANDSHAKE
                 .fRtsControl = RTS_CONTROL_HANDSHAKE
                 .fInX = 0
                 .fOutX = 0
                 '+ fOutxDsrFlow
            Case 2 ' DTR
                 .fBinary = 1
                 .fDsrSensitivity = 1
                 .fDtrControl = DTR_CONTROL_HANDSHAKE
                 .fRtsControl = RTS_CONTROL_ENABLE
                 .fInX = 0
                 .fOutX = 0
                 '+ fOutxDsrFlow
            Case 3 ' XONXOFF
                 .fBinary = 1
                 .fDsrSensitivity = 1
                 .fDtrControl = DTR_CONTROL_ENABLE
                 .fRtsControl = RTS_CONTROL_ENABLE
                 .fInX = 1
                 .fOutX = 1
        End Select
     End With
     If tCommRec.boPortOpen Then
        Call SetCommState(lHandle, tCommRec.tDCB)
     End If
End Property

Public Property Get Input_() As String
'If ReadStr=True, read all characters, which are in the input queue
    Dim sChar As String * 1
    Dim sDat As String
    Dim lNumread, lStartTime, lI As Long
    Dim bBuf    As Byte
    sDat = ""
    sChar = Space(1)
    'lStartTime = GetTickCount
    With tCommRec
        For lI = 1 To .lInputLen
            Call ReadFile(lHandle, ByVal sChar, 1, lNumread, ByVal CLng(0))
                If lNumread > 0 Then
                    sDat = sDat + sChar
                End If
        Next lI
    End With
        Input_ = sDat
End Property
Public Property Let Output_(sChar As String)
    ' Write all characters to COMx
    Dim WrittenChar As Long
    If tCommRec.boPortOpen Then
        Call WriteFile(lHandle, ByVal sChar, Len(sChar), WrittenChar, ByVal CLng(0))
    End If
End Property

Public Property Let WriteLine(sChar As String)
    ' Write all characters to COMx and add EOL char if it's enabled
    Dim WrittenChar As Long
    With tCommRec
        If .EOL_On Then sChar = sChar & .EOL
        If tCommRec.boPortOpen Then
           Call WriteFile(lHandle, ByVal sChar, Len(sChar), WrittenChar, ByVal CLng(0))
        End If
    End With
End Property
Public Property Let Wait_ms(lTime As Long)
    Dim lTickCount, lBuf As Long
   
    lTickCount = GetTickCount
    lTickCount = lTickCount + lTime
    lBuf = GetTickCount
    Do Until lBuf > lTickCount ' Add Check if <0 !
        lBuf = GetTickCount
        If lBuf < 0 Then lBuf = 0
    Loop
End Property

Private Sub Class_Terminate()
    If tCommRec.boPortOpen Then
        Call SetCommTimeouts(lHandle, tCRSav.tCOMMTIMEOUTSSav)
        Call SetCommState(lHandle, tCRSav.tDCBSav)
        Call CloseHandle(lHandle)
        Kill sFileName
    End If

End Sub

Public Property Get TimeOut_ms() As Long
    TimeOut_ms = tCommRec.lTimeout
End Property

Public Property Let TimeOut_ms(ByVal lTime_ As Long)
    tCommRec.lTimeout = lTime_
End Property
Public Property Get LineState() As Long ' GetLineState
    Dim State As Long
    LineState = 0
    With tCommRec
        If .boPortOpen Then
            Call GetCommModemStatus(lHandle, LineState)
        End If
    End With
End Property
Public Property Let LineState(ByVal Mask As Long) 'SetLineState
    With tCommRec
        If .boPortOpen Then Call EscapeCommFunction(lHandle, Mask)
    End With
End Property

Public Property Let InBufferSize(ByVal Buf As Integer)
    With tCommRec
        If .boPortOpen Then
            .iInBufferSize = Buf
                Call SetupCOMM(lHandle, .iInBufferSize, .iOutBufferSize)
            End If
        End With
End Property
Public Property Let OutBufferSize(ByVal Buf As Integer)
        With tCommRec
            If .boPortOpen Then
                .iOutBufferSize = Buf
                Call SetupCOMM(lHandle, .iInBufferSize, .iOutBufferSize)
            End If
        End With
End Property
Private Sub SetUp_DCB()
    With tCommRec.tDCB
        .DCBlength = 80
        .BaudRate = 4800
        .fBinary = 1
        .fParity = 1
        .fOutxCtsFlow = 1
        .fOutxDsrFlow = 1
        .fDtrControl = 1
        .fDsrSensitivity = 1
        .fTXContinueOnXoff = 1
        .fOutX = 0
        .fInX = 0
        .fErrorChar = 1
        .fNull = 1
        .fRtsControl = 1
        .fAbortOnError = 1
        .fDummy2 = 1
        .wReserved = 0
        .XonLim = -1
        .XoffLim = -1
        .ByteSize = 8
        .Parity = 1
        .StopBits = 1
        .XonChar = 17
        .XoffChar = 19
        .ErrorChar = 0
        .EofChar = 0
        .EvtChar = 0
        .wReserved = 0
    End With
End Sub

Hoffe das Ihr mir dabei weiter helfen könnt.

Gruß Frank
 
Zuletzt bearbeitet von einem Moderator:
Als erstes musst du eingrenzen, wo das PRoblem auftritt.
Ich habe deinen Code nicht gelesen. Es ist zuviel Code um ienfach mal schnell reinzuschauen. Also setz dir mal ein Breakpoint im Code, dort wo der String empfangen wird. Dann schau mal, ob dort der String schon abgeschnitten wird. Wenn nicht, verfolge den Code und schaue wo es passiert.

Dann postest du den ensptechenden Abschnitt. Ev. mit einigen Code-Kommentaren, damit wir auch wissen, was der Code da bewerkstelligen soll.
 
Hallo da bin ich wieder.
Ich habe heute mal was rumgespielt und kann sagen das die Daten die über die RS 232 zum PC gesendet werden
korrekt sind.
 
Der Fehler liegt also hier.

Code:
 Public Property Get ReadLine() As String
'Reads comm until Char=<LF>* or TimeOut
'* Or user defined character
    Dim sLine_ As String
    Dim sChar As String * 1
    Dim bChar As Byte
    Dim lNumread, lStartTime, lBuf As Long
    sLine_ = ""
    sChar = ""
    With tCommRec
        .boTimeout = False
        lStartTime = GetTickCount
        Do
             Call ReadFile(lHandle, ByVal sChar, 1, lNumread, ByVal CLng(0))
             If lNumread > 0 Then
                bChar = Asc(sChar)
               If bChar = Asc(.EOL) Then Exit Do
               If bChar > 47 And bChar < 58 Then sLine_ = sLine_ + sChar '***31 + 128***
               Worksheets(1).Range("cq15").Value = sLine_
               ***klk = klk + 1***
             End If
           *** DoEvents***
            ***If Worksheets("Wurfanzeige").cmdStop.Caption = "Training gestoppt" Then***
                ***Exit Do***
            ***End If***
             lBuf = GetTickCount
             If (lBuf - lStartTime) < 0 Then lStartTime = lBuf + tCommRec.lTimeout
        ***
        ***klk = 0***
        If bChar <> Asc(.EOL) Then .boTimeout = True
        ReadLine = sLine_
        If ReadLine <> "" Then
            'Worksheets(1).Range("cq15").Value = ReadLine
            'klk = klk + 1
        End If
    End With
    'PurgeBuffer = PURGE_RXCLEAR 'Delete all character behind EOF
End Property

Ich habe im ursprünglichen Code etwas geändert und das scheint jetzt zu funktionieren.
Nicht sehr elegant aber erstmal geht es.
Das mit den *** sind die Änderungen zum ursprünglichen Code.
Der Fehler warum die Daten verloren gehen rührt wohl daher das die Do .... Loop Schleife nicht richtig
abgearbeitete wird. Vermutung ist: Loop Until (lBuf - lStartTime) >= tCommRec.lTimeout.
So das: If bChar > 47 And bChar < 58 Then sLine_ = sLine_ + sChar nicht in der Loopschleife
abgearbeitet wird. Mein Verständnis von der Loopschleife ist, dass sLine=sLine+sChar immer
hochgezählt wird bis Chr(10) EOL erkannt wird oder wie im Ursrungscode Time out erreicht wird.
Genau das macht der Ursprungscode nicht, die Loopschleife wird nur einmal durchlaufen.
Ich würde gerne verstehen warum das mit dem Ursprungscode nicht geht. Da fehlt mir im Moment
jede Fantasie für.

Das soll´s erstmal soweit sein, hoffe ich habe mich auch richtig ausgedrückt damit Ihr versteht
was ich meine.

Gruß Frank
 
Fehler hat sich eingeschlichen.
So ist der von mir geänderte Code.

Code:
 Public Property Get ReadLine() As String
'Reads comm until Char=<LF>* or TimeOut
'* Or user defined character
    Dim sLine_ As String
    Dim sChar As String * 1
    Dim bChar As Byte
    Dim lNumread, lStartTime, lBuf As Long
    sLine_ = ""
    sChar = ""
    With tCommRec
        .boTimeout = False
        lStartTime = GetTickCount
        Do
             Call ReadFile(lHandle, ByVal sChar, 1, lNumread, ByVal CLng(0))
             If lNumread > 0 Then
                bChar = Asc(sChar)
               If bChar = Asc(.EOL) Then Exit Do
               If bChar > 47 And bChar < 58 Then sLine_ = sLine_ + sChar '31 + 128
               Worksheets(1).Range("cq15").Value = sLine_
               klk = klk + 1
             End If
            DoEvents
            If Worksheets("Wurfanzeige").cmdStop.Caption = "Training gestoppt" Then
                Exit Do
            End If
             lBuf = GetTickCount
             If (lBuf - lStartTime) < 0 Then lStartTime = lBuf + tCommRec.lTimeout
        Loop Until klk = 14 '(lBuf - lStartTime) >= tCommRec.lTimeout
        klk = 0
        If bChar <> Asc(.EOL) Then .boTimeout = True
        ReadLine = sLine_
        If ReadLine <> "" Then
            'Worksheets(1).Range("cq15").Value = ReadLine
            'klk = klk + 1
        End If
    End With
    'PurgeBuffer = PURGE_RXCLEAR 'Delete all character behind EOF
End Property
 
Sorry, ich sehe grad keinen Fehler. Ist es gelöst?
Wenn nicht, was für ein Fehler tritt wo auf?
 
Moin Forum.
Ich hab mir mal Gedanken über die Funktion und die anzusprechende API gemacht.
Hier mal meine Gedanken dazu. Die Funktion wird beim Programmstart aus dem Modul
angesprochen und die Parameter übernommen.
Wird die Funktion angesprochen werden die Variablen deklariert. Dann wird
  1. .boTimeout = False
  2. lStartTime = GetTickCount
gesetzt bzw lStarttime übernimmt GetTickCount.

Dann wird die API ReadFile über Call angesprochen.
Ist es richtig das die API so arbeitet:
- lies das erste Zeichen, denke das sagt die 1 aus
- wofür die anderen Parameter sind das weiss ich nicht
Dann weiter im Code. Prüfe ob lNumread > 0 ist. Wenn ja dann bChar = Asc(sChar).
Ist dann If bChar = Asc(.EOL) Then Exit Do also Loopschleife verlassen.
Ist dies nicht der Fall dann weiter mit If bChar > 47 And bChar < 58 Then sLine_ = sLine_ + sChar.
Also sLine wird nach und nach mit den ASC Zeichen gefüllt bis EOL Zeichen erkannt wird.
Worksheets(1).Range("cq15").Value = sLine_ dient nur für mich als Anzeige in einer Excelzel

DoEvents
If Worksheets("Wurfanzeige").cmdStop.Caption = "Training gestoppt"
Exit Do
End If
Das ist auch von mir eingefügt um die Loopschleife zu verlassen.

Dann wird lBuf = GetTickCount wieder aktualisiert.
Als nächtes wird dann If (lBuf - lStartTime) < 0 Then lStartTime = lBuf + tCommRec.lTimeout geprüft.
Diese Bedingung kann meines Erachtens nie erfüllt werden. Also was soll das dann oder hab ich das falsch
verstanden. Für mich ist diese Programmzeile unnötig.

Als nächstes dann Loop Until (lBuf - lStartTime) >= tCommRec.lTimeout.
Das heist für mich die Loopschleife solange durchlaufen bis die Timeout Zeit zB. 1000ms erreicht ist
bzw EOL erkannt wird.
Danach dann den Rest des Code durchlaufen.

Als ich das gestern getestet habe hat eben If bChar > 47 And bChar < 58 Then sLine_ = sLine_ + sChar
nicht funktioniert. Komisch aber ich verstehe es nicht.
Hoffe das ich den Code richtig verstanden habe. Wenn nicht bitte erklärt mir das mal.

Gruß Frank
 
Ich sag mal so gestern mit meinen Änderungen hat es funktioniert.
Nur so ganz hab ich das nicht verstanden.
 
Zurück