Initial commit 3
This commit is contained in:
Rowlander
@@ -0,0 +1,334 @@
|
||||
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
|
||||
Reference in New Issue
Block a user