Com: Fehler 8021

01/02/2011 - 11:08 von W. Wolf | Report spam
Hallo,

ab und zu schlàgt hier der Fehler 8021
"Interner Fehler beim Abrufen des DCB-Blocks
für den Anschluss" auf. Gelesen wird per
MSCOMM32 von einer virtuellen Com (USB to COM).
Das geht manchmal gut, manchmal kommt es zu den
genannten Fehler. Kennt den jemand? Kann ich
was dagegen tun?

Schönen Gruß
W. wolf
 

Lesen sie die antworten

#1 Hermie
01/02/2011 - 14:00 | Warnen spam
Musst mal gucken, ob Dir das hilft, mir hat es geholfen:

Du musst den Code in eine Klasse clsCommPort packen und dann als
Replacement für das Microsoft-Control verwenden.

Ich weiß nicht mehr, wo ich das herhabe, und ich glaube, ich habe auch
etwas angepasst.

Geht auf jeden Fall bei mir unter XP und Vista und wirft nicht diesen
Fehler auf.
Das war doch der, wo dann das ganze Control nicht mehr ging, oder?

Ich hatte das Microsoft-Control mal in eine ActiveX-Exe gepackt, die ich
dann abschiessen und neu laden kann, wenn sowas passiert.

Aber irgendeinen anderen Fehler gab es dann trotzdem noch, deshalb bin
ich auf den untenstehenden Ansatz umgestiegen.

Viele Grüße,
Hermie

Option Explicit

'Private mvarVariable As String
Private m_iLastWorkingPort%

Private m_lTextFileHandle As Long
Private m_iComPort As Integer
Private m_sComSettings As String
Private IntervalValue As Integer
Private m_sLastData As String

Private DataInRead As Boolean
Private DataSend As String, DataToWaitFor As String, SendAndWait As
Boolean, SendAndWaitRetries As Integer
Private MaxChars As Integer
Public Event SendAndReceived(DataSend As String, DataReceived As String,
DataToWaitFor As String)
Public Event DataIn()

Private Type COMSTAT
fCtsHold As Long
fDsrHold As Long
fRlsdHold As Long
fXoffHold As Long
fXoffSent As Long
fEof As Long
fTxim As Long
fReserved As Long
cbInQue As Long
cbOutQue As Long
End Type
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_NO_BUFFERING = &H20000000
Private Const FILE_FLAG_WRITE_THROUGH = &H80000000
Private Type COMMTIMEOUTS
ReadIntervalTimeout As Long
ReadTotalTimeoutMultiplier As Long
ReadTotalTimeoutConstant As Long
WriteTotalTimeoutMultiplier As Long
WriteTotalTimeoutConstant As Long
End Type
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
Private Declare Function ClearCommError Lib "kernel32" (ByVal hFile As
Long, lpErrors As Long, lpStat As COMSTAT) As Long
Private Declare Function BuildCommDCBAndTimeouts Lib "kernel32" Alias
"BuildCommDCBAndTimeoutsA" (ByVal lpDef As String, lpDCB As DCB,
lpCommTimeouts As COMMTIMEOUTS) As Long
Private Declare Function apiBuildCommDCB Lib "kernel32" Alias
"BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
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 apiSetCommState Lib "kernel32" Alias
"SetCommState" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long,
ByVal dwFlags As Long) As Long
Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long,
lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead
As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long,
lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long,
lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFile& Lib "kernel32" Alias "CreateFileA"
(ByVal lpFileName$, ByVal dwDesiredAccess&, ByVal dwShareMode&, ByVal
lpSecurityAttributes&, ByVal dwCreationDisposition&, ByVal
dwFlagsAndAttributes&, ByVal hTemplateFile&)
Private Declare Function CloseHandle& Lib "kernel32" (ByVal hObject&)
Private Declare Function FlushFileBuffers& Lib "kernel32" (ByVal hFile&)
'Standard-Eigenschaftswerte:
Const m_def_IsPortOpen = 0
'Eigenschaftsvariablen:
Private m_bIsPortOpen As Boolean


Public Function GetData() As String

m_sLastData = ReadComm32()

GetData = m_sLastData

'Erase that data from our buffer
m_sLastData = ""

End Function

Public Function WriteData(ByVal uString As String) As Boolean
On Error GoTo ErrHandler

WriteData = WriteComm32(uString)

Exit Function
ErrHandler:
Debug.Print err.Description
Debug.Assert False
End Function
'Public Property Let Variable(ByVal vData As String)
' mvarVariable = vData
'End Property
'
'Public Property Get Variable() As String
' Variable = mvarVariable
'End Property

Public Property Get ComPort() As Integer
ComPort = m_iComPort
End Property

Public Property Let ComPort(ByVal New_ComPort As Integer)
m_iComPort = New_ComPort
' PropertyChanged "ComPort"
End Property


Private Sub Class_Initialize()

m_sLastData = ""
DataInRead = False
SendAndWaitRetries = 10
m_iComPort = 1
m_sComSettings = "9600,N,8,1"

m_bIsPortOpen = m_def_IsPortOpen

End Sub
Private Sub pOpenPort()
On Error GoTo ErrHandler

Dim iLine%

'Reset
m_bIsPortOpen = False

Dim sFile$
sFile = "COM" & m_iComPort & ":"

Dim ComSetup As DCB
Dim Answer
Dim Stat As COMSTAT
Dim RetVal As Long
Dim CtimeOut As COMMTIMEOUTS
Dim BarDCB As DCB

' Open the communications port for read/write (&HC0000000).
' Must specify existing file (3).
Dim lTestHandle&
lTestHandle = CreateFile(sFile, &HC0000000, 0, 0, 3, 0, 0)

If lTestHandle = -1 Then
'We already had a handle
'Or another app opened this port. Since we cannot determine
what went wrong, we'll just assume that everything went fine
m_iComPort = m_iLastWorkingPort
m_bIsPortOpen = True
Exit Sub
Else
m_iLastWorkingPort = m_iComPort
m_lTextFileHandle = lTestHandle
m_bIsPortOpen = True
End If

'Setup Time Outs for com port
CtimeOut.ReadIntervalTimeout = 200
CtimeOut.ReadTotalTimeoutConstant = 1
CtimeOut.ReadTotalTimeoutMultiplier = 1
CtimeOut.WriteTotalTimeoutConstant = 1
CtimeOut.WriteTotalTimeoutMultiplier = 1

RetVal = SetCommTimeouts(m_lTextFileHandle, CtimeOut)
If RetVal = -1 Then
' iLine = 2
' retval = GetLastError()
' GoTo ErrHandler
' MsgBox "Unable to set timeouts for port " & m_iComPort & "
Error: " & retval
' retval = CloseHandle(m_lTextFileHandle)
Exit Sub
End If
RetVal = apiBuildCommDCB(m_sComSettings, BarDCB)
If RetVal = -1 Then
iLine = 3
' retval = GetLastError()
' GoTo ErrHandler
' MsgBox "Unable to build Comm DCB " & ComSettings & " Error: " &
retval
' retval = CloseHandle(m_lTextFileHandle)
Exit Sub
End If
RetVal = apiSetCommState(m_lTextFileHandle, BarDCB)
If RetVal = -1 Then
iLine = 4
' retval = GetLastError()
' GoTo ErrHandler

' MsgBox "Unable to set Comm DCB " & ComSettings & " Error: " &
retval
' retval = CloseHandle(m_lTextFileHandle)
Exit Sub
End If

m_bIsPortOpen = True
Exit Sub
ErrHandler:
MsgBox err.Number & ", " & err.Description & ", lasterr: " & RetVal & ",
where: " & iLine
End Sub
Private Function ReadComm32() As String
On Error GoTo ErrHandler

Dim RetBytes As Long
Dim i As Integer
Dim ReadStr As String
Dim bRead(256) As Byte
Dim RetVal As Long

RetVal = ReadFile(m_lTextFileHandle, bRead(0), 256, RetBytes, 0)
ReadStr = ""
If (RetBytes > 0) Then ' And (RetBytes < 256)
For i = 0 To RetBytes - 1
ReadStr = ReadStr & Chr(bRead(i))
Next i
End If

ReadComm32 = ReadStr

Exit Function
ErrHandler:
Debug.Print err.Description
Debug.Assert False
End Function

Private Function WriteComm32(ByVal uString As String) As Boolean
On Error GoTo ErrHandler

Dim lRetBytes As Long
Dim lValLen As Long
Dim lRetVal As Long
Dim bRead(256) As Byte

For lValLen = 0 To Len(uString) - 1
bRead(lValLen) = Asc(Mid(uString, lValLen + 1, 1))
Next lValLen

lRetVal = WriteFile(m_lTextFileHandle, bRead(0), Len(uString),
lRetBytes, 0)

If lRetBytes = Len(uString) Then
WriteComm32 = True
Else
WriteComm32 = False
End If

Exit Function
ErrHandler:
Debug.Assert False
End Function
Public Property Let PortOpen(ByVal uOpen As Boolean)
On Error GoTo ErrHandler

If uOpen Then
' If m_bIsPortOpen Then
' Call pClosePort
' End If
' If Not m_bIsPortOpen Then
Call pOpenPort
' End If
Else
' If m_bIsPortOpen Then
Call pClosePort
' End If
End If

Exit Property
ErrHandler:
Debug.Print err.Description
Debug.Assert False
End Property
Public Property Get PortOpen() As Boolean

PortOpen = m_bIsPortOpen

End Property
Public Property Get IsPortOpen() As Boolean
IsPortOpen = m_bIsPortOpen
End Property
Private Sub FlushComm()
On Error GoTo ErrHandler

FlushFileBuffers (m_lTextFileHandle)

Exit Sub
ErrHandler:
Debug.Assert False
End Sub
Private Sub pClosePort()
On Error Resume Next

Dim l&
l = CloseHandle(m_lTextFileHandle)
m_bIsPortOpen = False
If err.Number <> 0 Then err.Clear

End Sub
Private Sub Class_Terminate()

Call pClosePort

End Sub

Ähnliche fragen