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.
Hoffe das Ihr mir dabei weiter helfen könnt.
Gruß Frank
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: