bei Verwendung eines leicht modifizierten LosslessTracers (vollständiges Makro s. weiter unten) kommt es immer nach einiger Zeit zu folgendem Fehler:
- Screenshot_Fehler.png (178.39 KiB) Viewed 5067 times
Wie im Beispiel aus dem Screenshot wird der alte Tracer noch problemlos gespeichert und der neue gestartet und während der Laufzeit tritt dann der Fehler auf. Der Rechner wurde in der Zwischenzeit mehrmals neu gestartet. Automatische Updates, Virenscan etc. sind deaktiviert. Es läuft parallel eine weitere Steuersoftware, die aber keinerlei Probleme hatte.
Ich bin ratlos, wo das Problem herkommt und hoffe auf Hilfe.
Grüße
Anja Brunberg
Code: Select all
'------------------------------------------------------------------------------
'FILE DESCRIPTION: Lossless Tracer ==> angepasst
'------------------------------------------------------------------------------
Sub LTracer()
'DESCRIPTION: Traces messages without losses and stores the data in multiple trace files
' Modify as required
const DefaultDestDir = "d:\Messdaten\Trace"
const DefaultConnection = "PCANLight_USB_16@pcan_usb"
const MessagesPerTracer = 100000
' Explicit Variable declarations
Dim CurrentTracer, NextTracer
Dim doc, wnd
Dim TracerNumber, NewTop
Dim IsRunning
Dim DestDir, Connection
' Prompt for the destination directory
DestDir = InputBox("Destination Directory:", "LosslessTrace", DefaultDestDir)
If DestDir = "" Then Exit Sub
'DestDir = DefaultDestDir
' Make sure the selected directory exists
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(DestDir) Then
MsgBox "The selected directory does not exist!",,"LosslessTrace"
Exit Sub
End If
Set NextTracer = Nothing
IsRunning = True
TracerNumber = 0
NewTop = 250
If ActiveProject Is Nothing Then
' Create and configure a new project
NewProject "LLoslessTracer", ""
' Prompt for connection
Connection = InputBox("Select Connection:", "LosslessTrace", DefaultConnection)
Dim conn
Set conn = Connections.Add(Connection)
conn.IsEnabled = True
If Not conn.IsEnabled Then
MsgBox "Error while enabling the connection!",,"LosslessTrace"
Exit Sub
End If
End If
Set doc = Documents.Add(peDocumentKindTrace)
Set wnd = doc.ActiveWindow
wnd.Left = 0
wnd.Top = 0
wnd.Height = 250
wnd.Width = 500
Set CurrentTracer = wnd.Object.Tracer
CurrentTracer.BufferType = peTraceBufferTypeLinear
CurrentTracer.BufferSize = MessagesPerTracer
CurrentTracer.Start
Do While IsRunning
' Tracer records data until the filling level reaches 95%
Do While IsRunning And (CurrentTracer.FillingLevel < 95)
' Prepare next tracer at a filling level of 90%
If (NextTracer Is Nothing) And (CurrentTracer.FillingLevel > 90) Then
Set doc = Documents.Add(peDocumentKindTrace)
Set wnd = doc.ActiveWindow
' Arrange new tracer window
wnd.Left = 0
wnd.Top = NewTop
wnd.Height = 250
wnd.Width = 500
if (NewTop = 0) Then
NewTop = 250
Else
NewTop = 0
End If
Set NextTracer = wnd.Object.Tracer
NextTracer.BufferType = peTraceBufferTypeLinear
NextTracer.BufferSize = MessagesPerTracer
End If
Wait 50
IsRunning = CurrentTracer.TraceState = peTraceStarted
Loop
If IsRunning Then
NextTracer.Start
CurrentTracer.Stop
End If
' Save data of current tracer
If CurrentTracer.FillingLevel > 0 Then
TracerNumber = TracerNumber + 1
CurrentTracer.Document.Save DestDir & "\Trace" & TracerNumber & ".trc"
' Wait until data is saved
Do While CurrentTracer.TraceState = peTraceSaving
Wait 10
Loop
Wait 100
End If
' Close old tracer window
CurrentTracer.Document.Close peSaveChangesNo
Set CurrentTracer = NextTracer
Set NextTracer = Nothing
Loop
End Sub
