335 lines
8.8 KiB
OpenEdge ABL
335 lines
8.8 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "CFMBus"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
|
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
|
|
'==============================================================================
|
|
'
|
|
' File : CFMBus
|
|
' Author : Andreas Schmidt, Reinhard Henning
|
|
' Date : 27.01.1999
|
|
' Version: 0.01
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' Abstaktion eines FM85P.
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' History:
|
|
'
|
|
' Author : Andreas Schmidt, Reinhard Henning
|
|
' Date : 27.01.1999
|
|
' Version: 0.01
|
|
'
|
|
' Erste Version mit Reinhard Henning.
|
|
'
|
|
'==============================================================================
|
|
|
|
Option Explicit
|
|
|
|
' Private Member
|
|
' --------------
|
|
' MSComm-Control für den Bus
|
|
Private WithEvents m_comm As MSComm
|
|
Attribute m_comm.VB_VarHelpID = -1
|
|
|
|
' Menge der FM85P-Karten in dem Bus
|
|
Private m_collFM85P As Collection
|
|
|
|
' Letzter Fehlercode der seriellen Schnittstelle
|
|
Private m_nError As Integer
|
|
|
|
' Software Inputbuffer der seriellen Kommunikation
|
|
Private m_sInputBuffer As String
|
|
|
|
' Hardware Adresse des zuletzt angesprochenen Zählers
|
|
Private m_nLastFM85 As Integer
|
|
|
|
' Constructor
|
|
'
|
|
Private Sub Class_Initialize()
|
|
Set m_collFM85P = New Collection
|
|
End Sub
|
|
|
|
' Destructor
|
|
'
|
|
Public Sub Class_Terminate()
|
|
On Error Resume Next
|
|
m_comm.PortOpen = False
|
|
End Sub
|
|
|
|
|
|
' Adresse des zuletzt angesprochenen Zählers für CFM85P speichern
|
|
'
|
|
'
|
|
Public Sub SetLastFM(nAdresse As Integer)
|
|
m_nLastFM85 = nAdresse
|
|
End Sub
|
|
|
|
Public Function GetLastFM()
|
|
GetLastFM = m_nLastFM85
|
|
End Function
|
|
|
|
|
|
' Objektverknüpfung zum MSComm Objekt in Form frmSerial
|
|
'
|
|
' @param comm MSComm-Control für die serielle Kommunikation
|
|
'
|
|
Public Sub setMScomm(comm As MSComm)
|
|
Dim comport As Integer
|
|
|
|
On Error Resume Next
|
|
Set m_comm = comm
|
|
' Einstellungen setzen
|
|
comport = g_App.Settings.getCOMPort(DEVPORT_FMBus)
|
|
If comport > 0 Then
|
|
m_comm.CommPort = comport
|
|
|
|
m_comm.DTREnable = True ' notwendig für FM85.P
|
|
m_comm.EOFEnable = False ' noch zu klären
|
|
|
|
If g_App.Settings.FM85Settings <> "" Then
|
|
m_comm.Settings = g_App.Settings.FM85Settings
|
|
End If
|
|
|
|
WriteToLog "FM85 COM Settings: " & m_comm.Settings
|
|
|
|
m_comm.RThreshold = 1 'Event bei jedem Empfang
|
|
m_comm.InputLen = 0
|
|
|
|
m_comm.PortOpen = True
|
|
Else
|
|
'wenn die Prüfstation Software
|
|
'an einer manuellen Prüfstation gestartet wird...
|
|
If comport = 0 Then
|
|
ErrorMsg ("Es gibt keinen Eintrag für die COM Schnittstelle des FM85 Bus in der Pruef2000.ini!")
|
|
Else
|
|
' deaktiviert, z.B. -1
|
|
End If
|
|
End If
|
|
If Err Then
|
|
ErrorMsg ("Fehler beim Öffnen der Seriellen Schnittstelle des FM85 Bus an COM " & comport)
|
|
m_comm.PortOpen = False
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
Public Function GetMSComm() As MSComm
|
|
Set GetMSComm = m_comm
|
|
End Function
|
|
|
|
|
|
' Neues FM85P-Objekt erzeugen und in die Collection des Bus aufnehmen.
|
|
'
|
|
' @param nAdress Adresse für das neue FM85P-Objekt
|
|
' (Adressen starten mit 1 und sind nicht mit dem Index
|
|
' des FM85P zu verwechseln!)
|
|
'
|
|
' @return true = neues FM85P-Objekt erzeugt und gespeichert,
|
|
' false = Fehler, FM85P-Objekt wurde dem Bus-Objekt nicht
|
|
' hinzugefügt
|
|
'
|
|
Public Function addFM85P(nAdress As Integer)
|
|
Dim fm85p As New CFM85P
|
|
|
|
fm85p.setFMBus Me
|
|
fm85p.setAdress nAdress
|
|
|
|
' FM85P in Menge der abhängigen Objekte aufnehmen
|
|
m_collFM85P.Add fm85p, CStr(nAdress)
|
|
|
|
addFM85P = True
|
|
|
|
End Function
|
|
|
|
' @return Anzahl der FM85P im Bus
|
|
'
|
|
Public Function getFM85PCount() As Integer
|
|
getFM85PCount = m_collFM85P.Count
|
|
End Function
|
|
|
|
' @param index Index des FM85P, beginnend bei 1
|
|
' @return Referenz auf das FM85P-Objekt mit dem angegebenen Index
|
|
'
|
|
Public Function getFM85P(Index As Integer) As CFM85P
|
|
Set getFM85P = m_collFM85P.Item(Index)
|
|
End Function
|
|
|
|
' @return Daten aus Inputbuffer
|
|
'
|
|
Public Function getData() As String
|
|
getData = m_sInputBuffer
|
|
End Function
|
|
|
|
' Daten auf serielle Schnittstelle senden
|
|
'
|
|
' @param s an den seriellen Bus zu sendener String
|
|
'
|
|
Public Function send(s As String) As Boolean
|
|
Dim strTmp As String
|
|
On Error GoTo FMBusSendErr
|
|
DoEvents
|
|
|
|
'DebugMsg "sende an FM85Bus: '" & s & "'"
|
|
If g_blnFM85log Then
|
|
WriteToFM85Log s & vbCr, ">"
|
|
End If
|
|
|
|
|
|
If m_comm.PortOpen = False Then
|
|
Debug.Print "Fehler beim Senden an FM85Bus: Schnittstelle ist nicht offen"
|
|
send = False
|
|
Exit Function
|
|
End If
|
|
|
|
strTmp = m_comm.Input
|
|
If m_sInputBuffer <> "" Then
|
|
Debug.Print "Im FM85 Empfangs-Buffer ist: " & m_sInputBuffer & strTmp
|
|
m_sInputBuffer = ""
|
|
End If
|
|
|
|
' Auf Serielle schreiben
|
|
m_comm.Output = s & vbCr
|
|
|
|
Debug.Print "an FM85 gesendet: '" + s + "'"
|
|
send = True
|
|
Exit Function
|
|
|
|
FMBusSendErr:
|
|
send = False
|
|
' TODO: Fehler sichtbar machen, protokollieren...
|
|
DebugMsg ("Fehler: Konnte '" & s & "' nicht an FMBus senden." & vbCrLf & "Error: " & Err.Description)
|
|
End Function
|
|
|
|
' Eingabe von serieller Schnittstelle
|
|
'
|
|
' @param nTimeoutMillis Anzahl der max. zu wartenden Millisekunden
|
|
'
|
|
Public Function receive(nTimeoutMillis As Integer) As String
|
|
Dim msEnd As Long
|
|
'Dim lngSTartTime
|
|
'lngSTartTime = GetTickCount
|
|
|
|
On Error GoTo FMBusReceiveErr
|
|
msEnd = GetTickCount() + CLng(nTimeoutMillis)
|
|
Do
|
|
' TODO: Von Serieller lesen!
|
|
DoEvents
|
|
If Right$(m_sInputBuffer, 1) = vbCr Or g_Abbruch Then
|
|
|
|
If g_blnFM85log Then
|
|
WriteToFM85Log m_sInputBuffer, "<"
|
|
End If
|
|
|
|
If Not g_Abbruch Then
|
|
receive = Left(m_sInputBuffer, Len(m_sInputBuffer) - 1)
|
|
Debug.Print "empfangen: " & m_sInputBuffer
|
|
'DoTimingLog "Antwort '" & m_sInputBuffer & "' nach " & lngSTartTime - GetTickCount & " ms"
|
|
End If
|
|
Exit Do
|
|
End If
|
|
receive = m_sInputBuffer
|
|
If g_Abbruch = True Then Exit Function
|
|
Loop While GetTickCount() <= msEnd
|
|
|
|
'WriteToLog "von FM85 empfangen: '" + receive + "'"
|
|
|
|
' 'Geändert A. Pfeiffer am 28.05.2004
|
|
' If receive = "" Or receive = "0" Then
|
|
' WriteToLog "DiffTickCount: " & GetTickCount() - msEnd
|
|
' WriteToLog "von FM85 empfangen: '" + receive + "'"
|
|
' End If
|
|
|
|
|
|
m_sInputBuffer = ""
|
|
Exit Function
|
|
|
|
FMBusReceiveErr:
|
|
receive = ""
|
|
' Fehler sichtbar machen, protokollieren...
|
|
WriteToLog "FM85Bus.receive(" & nTimeoutMillis & ") Fehler: " & Err.Description
|
|
Exit Function
|
|
End Function
|
|
|
|
' Event-Handler für das MS-Comm Control
|
|
'
|
|
Private Sub m_comm_OnComm()
|
|
Dim sTmp As String
|
|
Select Case m_comm.CommEvent
|
|
Case comEvReceive
|
|
sTmp = m_comm.Input
|
|
m_sInputBuffer = m_sInputBuffer & sTmp
|
|
'Debug.Print "FM85Bus sendet '" & sTmp & "'" & vbCrLf
|
|
Case Default
|
|
MsgBox ("noch unbekanntes Event")
|
|
End Select
|
|
End Sub
|
|
|
|
' Liegt ein Fehler vor?
|
|
'
|
|
' @return true = Fehler liegt vor, Fehlerbeschreibung kann
|
|
' mit getErrorCode/getErrorDesc eingeholt
|
|
' werden
|
|
' false = alles OK
|
|
'
|
|
Public Function hasError() As Boolean
|
|
hasError = (m_nError <> 0)
|
|
End Function
|
|
|
|
' @return Interner Code des letzten Fehlers
|
|
' (siehe modFM85P.bas)
|
|
'
|
|
Public Function getErrorCode() As Integer
|
|
getErrorCode = m_nError
|
|
End Function
|
|
|
|
' @return Erläuterung zu dem letzten Fehler
|
|
'
|
|
Public Function getErrorDesc() As String
|
|
Select Case m_nError
|
|
Case Default
|
|
getErrorDesc = ""
|
|
End Select
|
|
End Function
|
|
|
|
|
|
Public Function dialog(SendeString As String, ErwarteString As String) As Boolean
|
|
' Sollte nur aufgerufen wenn mind. 1 Byte in der Antwort-Zeile zu erwarten ist
|
|
' Gibt True zurück, wenn der zu erwartende String in der Antwort anthalten ist
|
|
' oder der zu erwartende String leer ist
|
|
|
|
Dim EmpfangendeDaten As String
|
|
Dim WdhZaehler As Integer
|
|
|
|
WdhZaehler = 0
|
|
|
|
Do While WdhZaehler < 3
|
|
send (SendeString)
|
|
EmpfangendeDaten = receive(1000)
|
|
If InStr(1, EmpfangendeDaten, ErwarteString) = 0 Then
|
|
WdhZaehler = WdhZaehler + 1
|
|
DebugMsg "'" & ErwarteString & "' erwartet, aber '" & EmpfangendeDaten & "' erhalten!"
|
|
If g_Abbruch Then Exit Function
|
|
' Unerwartete Antwort
|
|
' Anfrage Wiederholen oder Fehlermeldung
|
|
Else
|
|
dialog = True
|
|
Exit Function
|
|
End If
|
|
Loop
|
|
ErrorMsg ("Eine zu erwartende Antwort wurde vom FM85 nicht zurückgesendet. Die Prüfung sollte abgebrochen werden.")
|
|
dialog = False
|
|
End Function
|