marekf/laatzen
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
3ca162ca73
laatzen/Pruef2000/source/modIECCOM.bas
Rowlander 70e2645059 Initial commit 3
2021-10-01 11:11:04 +02:00

3472 lines
119 KiB
QBasic
Raw Blame History

Attribute VB_Name = "modIECCOM"
Option Explicit
'Fehlercodes, die von den einzelnen Functionen zurückgeworfen werden:
' - Positive Zahlenwerte sollten Rückgabewerte aus der DLL sein
' 0 OK - kein Fehler
' -1 Fehler bei Portinitialisierung
' -2 Fehler bei Schichtinitialisierung
' -3 Fehler beim Senden der Daten
' -4 Fehler beim Empfangen der Daten
' -5 Fehler beim Erneuten Senden (Slave-Auslesevorgang)
' -7 Ungerade Adressen oder ungerade Anzahl von Byte nicht zulässig
' -10 Ungültiger Funktionsparameter
' -11 Zuviele Bytes sollen bei MemoryRead ausgelesen werden, was bei Benutztung des Buffers nicht geht
' -20 IdentNo stimmt nicht mit vorgegebener überein
' -50 Schloss konnte nicht gesetzt werden 'Prüfungsinitialisierung / Prüfungsabschluß
' -51 OptoKopf-Timeout konnte nicht gesetzt werden ' " / "
' -52 SystemZeit konnte nicht gesetzt werden ' " / "
' -53 Liegenschaftsnr. konnte nicht gesetzt werden ' " / "
' -54 FabNo. konnte nicht gesetzt werden (falls doch notwendig 'Prüfungsinitialisierung
' -55 TemperatureTransferLock konnte nicht zurückgesetzt werden 'Prüfungsabschluß
' -56 Set_special_mode konnte nicht zurückgesetzt werden 'Prüfungsinitialisierung
' -60 fp_Bereich konnte nicht gesetzt werden
' -61 Geberkonstante(_Neu1)_m konnte nicht gesetzt werden
' -62 Geberkonstante(_Neu2)_m konnte nicht gesetzt werden
' -63 Offset(_Neu1)_m3ph konnte nicht gesetzt werden
' -64 Offset(_Neu2)_m3ph konnte nicht gesetzt werden
' -65 SteilheitGeber_nsp°C konnte nicht gesetzt werden
' -66 OffsetGeber_ns konnte nicht gesetzt werden
' -70 Fehler beim Lesen des Speicherabbildes
' -80 Der zurückgegebene Scaling-Wert ist unbekannt/falsch
' -85 Unbekannter Fehler bei GetMemoryImageVersion1
' -86 Ungültige Länge bei GetMemoryImageVersion1 (Teil1)
' -87 Ungültige Länge bei GetMemoryImageVersion1 (Teil2)
' -99 Sonstiger Fehler
'############################################################################
Private mintOpenPortNr As Integer 'Die Nummer des zuletzt geöffneten COM-Ports.
'Ist die Nummer=0, dann wurde der Port noch nicht geöffnet oder er
'ist bereits wieder geschlossen worden
Private Const BAUDRATE As Long = 2400
Private Const SLAVEADDRESS As Long = 254
Private Const SCHICHT2MODE As Long = 2
Private Const MANTISSENGENAUIGKEIT As Byte = 5 'Stellen hinter dem "Mantissen-Komma" -> 2.12345E-13
Private Type COMPORT_TYPE
COMport As Long ' Comport: 0=Default,1=Com1, 2=Com2......
BAUDRATE As Long ' Baudrate: 300.....
ByteSize As Long ' Datenbits 4-8
Parity As Long ' Parity 0-4=none,odd,even,mark,space
StopBits As Long ' StopBits 0,1,2 =1,1.5,2
End Type
Private Type Schicht2_Para_Type
AFeld As Byte ' Adress-Feld Slave.
Mode As Byte ' Legt das Protokoll fest.
Timeout As Long ' Timeout in ms.
End Type
Private Type SlavePara_Type
C_Feld As Byte
A_Feld As Byte
CI_Feld As Byte
End Type
Private Declare Function InitCom Lib "ieccom32.dll" (ComPara As COMPORT_TYPE, ByVal Reserve As String) As Long
Private Declare Function CloseCom Lib "ieccom32.dll" (ByVal Reserve As String) As Long
'Private Declare Function ZVEI Lib "ieccom32.dll" (ByVal lenSBuffer As Long, ByVal SBuffer As String, lenEBuffer As Long, ByVal EBuffer As String) As Long
Private Declare Function InitSchicht2 Lib "ieccom32.dll" (SCHICHT2_PARA As Schicht2_Para_Type, ByVal Reserve As String) As Long
Private Declare Function Normalize Lib "ieccom32.dll" (ByVal Reserve As String) As Long
Private Declare Function RequestData Lib "ieccom32.dll" (ByVal EDaten As String, ByVal Reserve As String) As Long
Private Declare Function SendData Lib "ieccom32.dll" (ByVal CI_Feld As Long, ByVal sDaten As String, ByVal LenSDaten As Long, ByVal EDaten As String, SlavePara As SlavePara_Type, ByVal Reserve As String) As Long
'Private Declare Sub OutputTrace Lib "ieccom32.dll" (ByVal TextStr As String)
'Private Declare Function Get_Spy Lib "ieccom32.dll" (ByVal EDaten As String, ByVal Len_EDaten As Long) As Long
'Private Declare Function GetDLLVersion Lib "ieccom32.dll" () As Long
'Private Declare Function SetKopfOn Lib "ieccom32.dll" (ByVal TimeOut As Long) As Long
'Private Declare Function SetKopfOff Lib "ieccom32.dll" () As Long
Private Declare Sub delaytime Lib "ieccom32.dll" (ByVal MSec As Long)
'Private Declare Function SwitchOpto Lib "ieccom32.dll" (ByVal OptoFlag As Long) As Long
'Private Declare Function SendOptoHeader Lib "ieccom32.dll" () As Long
Private Enum DEVICETYPE_ENUM
DeviceTypeOther = 0
DeviceTypeOil = 1
DeviceTypeElectricity = 2
DeviceTypeGas = 3
DeviceTypeHeat = 4
DeviceTypeSteam = 5
DeviceTypeWarmWater = 6
DeviceTypeWater = 7
DeviceTypeHeatCostAllocator = 8
DeviceTypeCompressedAir = 9
DeviceTypeCoolingLoadMeterOutlet = &HA
DeviceTypeCoolingLoadMeterInlet = &HB
DeviceTypeHeatVolumeMeasuredAtFlowTemperatureInlet = &HC
DeviceTypeHeatCoolingLoadMeter = &HD
DeviceTypeBusOrSystemComponent = &HE
DeviceTypeUnknown = &HF
DeviceTypeHotWater = &H15
DeviceTypeColdWater = &H16
DeviceTypeDualRegisterWaterMeter = &H17
DeviceTypePressure = &H18
DeviceTypeADConverter = &H19
End Enum
Private Enum MEMORYTYPE_ENUM 'Nur hiermit werden die Funtionen von Außen aufgerufen
enuMaster__RAM = 0
enuMasterEEPROM = 1
enuSlave___RAM = 2
enuSlave_FLASH = 3
End Enum
'Kombinierter Wert aus Adresse und Anzahl Byte * &H1000000
'-> 4 Bytes (LONG) von denen das 1. für die ByteAnzahl steht
'Somit bleiben 3 Bytes für die Adressierung = 16 MegaByte (sollte für einen Zähler reichen!)
Private Enum MEMORYMASTERRAMADRESSANDSIZE_ENUM
enuMem_Scaling = &H1000225
enuMem_Schloss = &H100022F
enuMem_EneryVolumePart1 = &H8000232 'Dier ersten 8 Bytes der Kategorie-2B-Daten
enuMem_EneryVolumePart2 = &H1200023A 'Die letzten 18 Bytes der Kategorie-2A-Daten
enuMem_EneryVolumePart3 = &HC00024C 'Die ersten 12 Bytes der Kategorie-3A-Daten
enuMem_EneryVolumePart4 = &H1600025A 'Die nächsten 22 Bytes der Kategorie-3A-Daten
'enuMem_EneryVolumePart5 = &HA000266 'Der nächste 10-Byte-Block der Kategorie-3A-Daten
enuMem_EneryVolumePart5 = &H7000272 'Der letzte 7-Byte-Block der Kategorie-3A-Daten
enuMem_Energy_hr = &H4000236
enuMem_Energy = &H400023A
enuMem_Volume = &H400023E
enuMem_Error = &H3000254 'ErrorWord + Fatal_error_byte
enuMem_Liegenschaft = &H400027C
enuMem_IDENTNR = &H4000280
enuMem_Fab_Nr = &H4000284
enuMem_DateTime = &H6000296 '4 Bytes + 1 Byte für Checksumme + 1 Byte für Sekunden
enuMem_Flow_fp = &H40003A0
enuMem_Temp_to_slave_trans = &H20002B6 'Temperature_to_slave_transfere -> Kann mit dem Wert 5A0F unterbunden werden
enuMem_Opto_off_timer = &H20002CA
enuMem_TV_fp = &H4000398 'Vorlauftemperatur
enuMem_TR_fp = &H400039C 'Rücklauftemperatur
enuMem_T = &H8000398 'Vorlauftemperatur und Nachlauftemperatur in einem Duchgang lesen (geht schneller)
' enuMem_NOWA_energy_hr = &H40003BE 'NOWA Energie Register high resolution BCD *10^scaling [0,01mW] oder [0,01J]
' enuMem_NOWA_energy_lr = &H40003C2 'NOWA Energie Register low resolution BCD *10^scaling [kW] oder [MJ]
enuMem_NOWA_energy = &H80003BE 'Beide vorhergehenden Felder werden aus performancegründen zusammen ausgelesen
enuMem_NOWA_volume_fp = &H40003C6 'NOWA Volumen Register float *10^scaling [l]
enuMem_OpenClose = &H1000965 'Über diese Adresse wird das Schloss geöffnet oder geschlossen
End Enum
Private Enum MEMORYMASTEREEPROMADRESSANDSIZE_ENUM
enuMem_FP_ZeroflowTemperature = &H40003F8 ' gespeicherte Zeroflow Temperatur
enuMem_FP_ZeroflowDiffTof = &H40003FC ' gespeicherte Zeroflow DiffTof
enuMem_Info_Pruefung = &H20003F6 ' gespeicherte Info Pruefung
End Enum
Private Enum MEMORYSLAVERAMADRESSANDSIZE_ENUM
enuMem_host_command = &H1000200 'Name war z. Zt. der Programmierung unbekannt -> mal in der Memory-Map nachschauen
enuMem_FP_Temperature = &H4000202
'Folgende 5 Werte werden bei der Auslieferung zurückgesetzt
enuMem_FP_Vol_kum = &H4000216 'kum. Gesamtvolumen
enuMem_status_info = &H1000254 'Slave Statusinfo
enuMem_lifetime_cnt_fast_rate = &H2000262 'Limitcounter für schnelle Meßrate
enuMem_lifetime_cnt_pruefpulse = &H2000264 'Limitcounter für Prüfimpulse
enuMem_special_mode = &H1000276
enuMem_Flp_DiffTof = &H4000244 ' FLP_DiffTof = zu messende Ultraschalllaufzeit im Slave RAM
End Enum
Private Enum MEMORYSLAVEFLASHADRESSANDSIZE_ENUM
enuMem_Slave_FLASH_Firmware_Version = &H10010B2 'Slave_FLASH_Firmware_Version
enuMem_FP_O_Geber = &H400100E
enuMem_FP_K_Geber1 = &H4001012
enuMem_FP_K_Geber2 = &H4001016
enuMem_FP_Flow_Min = &H400101E
enuMem_FP_Flow_Max = &H4001022
enuMem_FP_QOffset1 = &H4001026
enuMem_FP_QOffset2 = &H400102A
enuMem_FP_ST_Geber = &H400102E
enuMem_FP_Bereich = &H4001080
enuMem_FP_ImpulsWertigkeit = &H4001084
enuMem_FP_ImpulsWertigkeit_Pruef = &H4001088
enuMem_PulseMode_write = &H10010AB
enuMem_PulseMode_read = &H20010AA ' eigentlich 10AB
enuMem_FP_Flow_Simu = &H40010AE
End Enum
Private Const SCHLOSSAUF = &HA0
Private Const SCHLOSS_ZU = &H5
Public Type USZAEHLERERRORTYP
strDisplayString As String 'Im Display angezeigter String
'Error_W_nibble
bln_Slave_timeout_error As Boolean 'timeout during slave communication
bln_Slave_low_level_error As Boolean 'low level error during slave communication
bln_Slave_ASIC_error As Boolean 'ASIC error
bln_Slave_fatal_error As Boolean 'copy of Slave_fatal_error but visible in LCD
'Error_Z_nibble (for ever latched errors)
bln_ADW_error As Boolean 'min. one time sensor/ADW error
bln_EEP_error As Boolean 'min. one time eeprom error
bln_RAM_latched_error As Boolean 'min. one time RAM_CS_error
bln_Fatal_latched_error As Boolean 'min. one time Fatal_error
' Error_Y_nibble (ram/eeprom)
bln_EEP_write_error As Boolean 'eeprom write error
bln_EEP_read_error As Boolean 'eeprom read error
bln_RAM_CS_error As Boolean 'ram-checksum error
bln_Fatal_error As Boolean 'any error in Fatal_error_nibble
'Error_X_nibble (sensor/ADW)
bln_S_change_error As Boolean 'Sensors changed
bln_S_short_error As Boolean 'sensor/s - short
bln_S_open_R_error As Boolean 'sensor "Rücklauf" open
bln_S_open_V_error As Boolean 'sensor "Vorlauf" open
'Restliche Nibbles werden bis jetzt noch nicht ausgwertet
' Fatal_error_nibble (same address like Info_nibble, lower nibble)
' Info_nibble (same address like Fatal_error_nibble, upper nibble)
End Type
'Für Übergabe eines kompletten Datenheaders
Public Type DATAHEADER_TYPE
strIdentNo As String * 8
strManID As String * 3
bytVersion As Byte
enuDeviceType As DEVICETYPE_ENUM
bytAccessNr As Byte
bytStatus As Byte
End Type
Public Enum USTYP_ENUM
enuUS_TypError = 0
enuUS_Pollustat = 1
enuUS_Polluflow = 2
End Enum
Public Enum TEMPERATUR_ENUM
enuTemp_Vorlauf = 0
enuTemp_Ruecklauf = 1
enuTemp_DeltaVorlaufRuecklauf = 2
End Enum
Public Function ScanPort(ByVal intPortNr As Integer, Optional bytAnzahlWiederholungen As Byte = 0) As Long
On Error GoTo Scanport_Error
Dim lngReturn As Long
Dim strReserve As String
ScanPort = -99001
lngReturn = ComPort_Open(intPortNr, bytAnzahlWiederholungen)
If lngReturn <> 0 Then
ScanPort = lngReturn
Else
lngReturn = Normalize(strReserve)
ComPort_Close
If lngReturn = 0 Then
ScanPort = 0
Else
' 0 Erfolgreich durchgeführt.
' 1 Fehler : Port nicht initialisiert.
' 2 Fehler : (WriteComm).
' 3 Fehler : Keine Antwort.
ScanPort = -4
End If
End If
Exit Function
Scanport_Error:
ScanPort = -99001
End Function
Public Function GetUSTyp(ByVal intPortNr As Integer, ByRef enuUSTyp As USTYP_ENUM, Optional ByRef lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim udtUSerror As USZAEHLERERRORTYP
On Error GoTo GetUSTyp_Error
GetUSTyp = -99002
enuUSTyp = enuUS_TypError
lngReturn = GetErrorStatus(intPortNr, udtUSerror, lngIdentNoForVerification)
If lngReturn = 0 Then
'Wenn beide gleich -> Pollustat
If (udtUSerror.bln_S_open_V_error = udtUSerror.bln_S_open_R_error) Then
enuUSTyp = enuUS_Pollustat
Else
If (udtUSerror.bln_S_open_V_error = True) Then
enuUSTyp = enuUS_Polluflow
Else
enuUSTyp = enuUS_TypError
End If
End If
End If
GetUSTyp = lngReturn
GetUSTyp = 0
Exit Function
GetUSTyp_Error:
GetUSTyp = -99002
End Function
'############################### GetImageVersion1 - liest ein fest definiertes Speicherabbild aus #################################################
Public Function GetMemoryImageVersion1(ByVal intPortNr As Integer, ByRef strResult As String, Optional ByRef lngIdentNoForVerification As Long = -1)
GetMemoryImageVersion1 = -99
On Error GoTo GetMemoryImageVersion1_Error
Dim lngReturn As Long
Dim lngLaenge As Long
Dim strTeil1 As String
Dim strTeil2 As String
' Const lngStart1 As Long = &H1000: Const lngLaenge1 As Long = &H2E + 4
Const lngStart1 As Long = &H100E: Const lngLaenge1 As Long = 9 * 4
Const lngStart2 As Long = &H1080: Const lngLaenge2 As Long = &H32 + 1
Const lngLaengeLuecke As Long = lngStart2 - lngStart1 - lngLaenge1
delaytime 100
lngReturn = GetSpeicherAbbild(intPortNr, enuSlave_FLASH, lngStart1, lngLaenge1, strTeil1, True, False, lngIdentNoForVerification)
If lngReturn <> 0 Then
GetMemoryImageVersion1 = lngReturn
Exit Function
End If
If (Len(strTeil1) / 2 <> lngLaenge1) Then
' Ungültige Länge !!!
GetMemoryImageVersion1 = -86
Exit Function
End If
delaytime 100
lngReturn = GetSpeicherAbbild(intPortNr, enuSlave_FLASH, lngStart2, lngLaenge2, strTeil2, False, True, lngIdentNoForVerification)
If lngReturn <> 0 Then
GetMemoryImageVersion1 = lngReturn
Exit Function
End If
If (Len(strTeil2) / 2 <> lngLaenge2) Then
' Ungültige Länge !!!
GetMemoryImageVersion1 = -87
Exit Function
End If
strResult = strTeil1 & String$(lngLaengeLuecke * 2, ".") & strTeil2
GetMemoryImageVersion1 = 0
Exit Function
GetMemoryImageVersion1_Error:
GetMemoryImageVersion1 = -85
End Function
'############################### Funktionen zur Vorbereitung und Abschluß einer Prüfung #################################
Public Function PruefungsInitialisierung(ByVal intPortNr As Integer) As Long
On Error GoTo PruefungsInitialisierung_Error
Dim lngReturn As Long
Dim blnResult As Boolean
Dim intResult As Integer
Dim dtmResult As Date
Dim strResult As String
PruefungsInitialisierung = -99011
'Schloss öffnen
lngReturn = SetSchloss(intPortNr, True)
If lngReturn <> 0 Then
PruefungsInitialisierung = lngReturn
Exit Function
End If
'Überprüfen !
lngReturn = GetSchloss(intPortNr, blnResult)
If lngReturn <> 0 Then
PruefungsInitialisierung = lngReturn
Exit Function
End If
If blnResult = False Then
PruefungsInitialisierung = -50
Exit Function
End If
'OptoKopf-Timeout auf 60*24 = 1440 = 24 Stunden setzen
lngReturn = Set_Opto_off_timer(intPortNr, 1440)
If lngReturn <> 0 Then
PruefungsInitialisierung = lngReturn
Exit Function
End If
'Überprüfen
lngReturn = Get_Opto_off_timer(intPortNr, intResult)
If lngReturn <> 0 Then
PruefungsInitialisierung = lngReturn
Exit Function
End If
If (1440 - intResult) > 1 Then '1 Minute Differenz zulassen, da eventuell gerade 1 Minute in der Systemuhr umgesprungen ist
PruefungsInitialisierung = -51
Exit Function
End If
'Special-Mode auf jeden Fall abschalten!
lngReturn = Set_special_mode(intPortNr, False)
If lngReturn <> 0 Then
PruefungsInitialisierung = lngReturn
Exit Function
End If
'Überprüfen !
lngReturn = Get_special_mode(intPortNr, blnResult)
If lngReturn <> 0 Then
PruefungsInitialisierung = lngReturn
Exit Function
End If
If blnResult = True Then 'Dieser Fall wäre für die Prüfung ziemlich übel !!!
PruefungsInitialisierung = -56
Exit Function
End If
'Uhrzeit auf den aktuellen Tag und auf 0:30 Uhr morgens setzen (es bleiben 23,5 Stunden für die Prüfung)
Dim dtmNewDateValue As Date
dtmNewDateValue = DateValue(Now) + TimeSerial(0, 30, 0)
lngReturn = SetDateTime(intPortNr, dtmNewDateValue)
If lngReturn <> 0 Then
PruefungsInitialisierung = lngReturn
Exit Function
End If
'Überprüfen
lngReturn = GetDateTime(intPortNr, dtmResult)
If lngReturn <> 0 Then
PruefungsInitialisierung = lngReturn
Exit Function
End If
If Abs((dtmResult - dtmNewDateValue) * 24 * 60 * 60) > 10 Then 'mehr als Zehn Sekunden Abweichung
PruefungsInitialisierung = -52
Exit Function
End If
PruefungsInitialisierung = 0
Exit Function
PruefungsInitialisierung_Error:
PruefungsInitialisierung = -99011
End Function
Public Function PruefungsAbschluss(ByVal intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
On Error GoTo PruefungsAbschluss_Error
Dim lngReturn As Long
Dim blnResult As Boolean
Dim dtmResult As Date
Dim strResult As String
PruefungsAbschluss = -99012
'Uhrzeit auf die aktuellen Tag und auf die aktuelle Uhrzeit setzen
Dim dtmNewDateValue As Date
dtmNewDateValue = Now()
lngReturn = SetDateTime(intPortNr, dtmNewDateValue, lngIdentNoForVerification)
If lngReturn <> 0 Then
PruefungsAbschluss = lngReturn
Exit Function
End If
'Überprüfen
lngReturn = GetDateTime(intPortNr, dtmResult, lngIdentNoForVerification)
If lngReturn <> 0 Then
PruefungsAbschluss = lngReturn
Exit Function
End If
If Abs((dtmResult - dtmNewDateValue) * 24 * 60 * 60) > 10 Then 'mehr als Zehn Sekunden Abweichung
PruefungsAbschluss = -52
Exit Function
End If
'OptoKopf-Timeout auf Standartwert von 60 Minuten setzen
lngReturn = Set_Opto_off_timer(intPortNr, 60, lngIdentNoForVerification)
If lngReturn <> 0 Then
PruefungsAbschluss = lngReturn
Exit Function
End If
'Überprüfung -> Ist hier unwichtig -> Der Wert geht von alleine auf 0
'Volume-Reset ???
'TemperatureTransferLock wegnehmen
lngReturn = SetTemperatureTransferLock(intPortNr, False, lngIdentNoForVerification)
If lngReturn <> 0 Then
PruefungsAbschluss = lngReturn
Exit Function
End If
'Überprüfen !
lngReturn = GetTemperatureTransferLock(intPortNr, blnResult, lngIdentNoForVerification)
If lngReturn <> 0 Then
PruefungsAbschluss = lngReturn
Exit Function
End If
If blnResult = True Then 'Temperatur kann nicht gemessen werden -> Zähler darf so nicht ausgeliefert werden !!!
PruefungsAbschluss = -55
Exit Function
End If
PruefungsAbschluss = 0
Exit Function
PruefungsAbschluss_Error:
PruefungsAbschluss = -99012
End Function
'############################### Funktionen zum Lesen und schreiben aller Justage-Werte ##############################
'Liest insgesamt 7 Parameter aus (
Public Function GetOffsetAndGeberAndBereich(ByVal intPortNr As Integer, ByRef USParameter As JustageParameter_Type, Optional lngIdentNoForVerification As Long = -1) As Long
On Error GoTo GetOffsetAndGeberAndBereich_Error
Dim lngReturn As Long
GetOffsetAndGeberAndBereich = -99021
Dim USReturnParam As JustageParameter_Type
lngReturn = GetGeberKonstanten(intPortNr, USReturnParam.Geberkonstante1_IST_m, USReturnParam.Geberkonstante2_IST_m, USReturnParam.SteilheitGeber_nsp°C, USReturnParam.OffsetGeber_ns, lngIdentNoForVerification)
If lngReturn <> 0 Then
GetOffsetAndGeberAndBereich = lngReturn
Exit Function
End If
lngReturn = GetOffsetKonstanten(intPortNr, USReturnParam.Offset1_IST_m3ph, USReturnParam.Offset2_IST_m3ph, lngIdentNoForVerification)
If lngReturn <> 0 Then
GetOffsetAndGeberAndBereich = lngReturn
Exit Function
End If
lngReturn = Get_FP_Bereich(intPortNr, USReturnParam.Bereich_ns, lngIdentNoForVerification)
If lngReturn <> 0 Then
GetOffsetAndGeberAndBereich = lngReturn
Exit Function
End If
USParameter = USReturnParam
GetOffsetAndGeberAndBereich = 0
Exit Function
GetOffsetAndGeberAndBereich_Error:
GetOffsetAndGeberAndBereich = -99021
End Function
Public Function SetOffsetAndGeberAndBereich(ByVal intPortNr As Integer, ByRef USParameter As JustageParameter_Type, Optional lngIdentNoForVerification As Long = -1) As Long
On Error GoTo SetOffsetAndGeberAndBereich_Error
Dim lngReturn As Long
SetOffsetAndGeberAndBereich = -99022
lngReturn = SetGeberKonstanten(intPortNr, USParameter.Geberkonstante_Neu1_m, USParameter.Geberkonstante_Neu2_m, USParameter.SteilheitGeber_nsp°C, USParameter.OffsetGeber_ns, lngIdentNoForVerification)
If lngReturn <> 0 Then
SetOffsetAndGeberAndBereich = lngReturn
Exit Function
End If
lngReturn = SetOffsetKonstanten(intPortNr, USParameter.Offset_Neu1_m3ph, USParameter.Offset_Neu2_m3ph, lngIdentNoForVerification)
If lngReturn <> 0 Then
SetOffsetAndGeberAndBereich = lngReturn
Exit Function
End If
lngReturn = Set_FP_Bereich(intPortNr, USParameter.Bereich_ns, lngIdentNoForVerification)
If lngReturn <> 0 Then
SetOffsetAndGeberAndBereich = lngReturn
Exit Function
End If
SetOffsetAndGeberAndBereich = 0
Exit Function
SetOffsetAndGeberAndBereich_Error:
SetOffsetAndGeberAndBereich = -99022
End Function
'Diese Function Arbeitet wie die vorhergehende, aber mit zusätzlicher Überprüfung !
Public Function SetOffsetAndGeberAndBereichWhithCheck(ByVal intPortNr As Integer, ByRef USParameter As JustageParameter_Type, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim USReturnParameter As JustageParameter_Type
On Error GoTo SetOffsetAndGeberAndBereichWhithCheck_Error
SetOffsetAndGeberAndBereichWhithCheck = -99020
lngReturn = SetOffsetAndGeberAndBereich(intPortNr, USParameter, lngIdentNoForVerification)
If lngReturn <> 0 Then
SetOffsetAndGeberAndBereichWhithCheck = lngReturn
Exit Function
End If
lngReturn = GetOffsetAndGeberAndBereich(intPortNr, USReturnParameter, lngIdentNoForVerification)
If lngReturn <> 0 Then
SetOffsetAndGeberAndBereichWhithCheck = lngReturn
Exit Function
End If
If RoundMantisse(USParameter.Bereich_ns, MANTISSENGENAUIGKEIT) <> USReturnParameter.Bereich_ns Then
SetOffsetAndGeberAndBereichWhithCheck = -60: Exit Function
End If
If RoundMantisse(USParameter.Geberkonstante_Neu1_m, MANTISSENGENAUIGKEIT) <> USReturnParameter.Geberkonstante1_IST_m Then
SetOffsetAndGeberAndBereichWhithCheck = -61: Exit Function
End If
If RoundMantisse(USParameter.Geberkonstante_Neu2_m, MANTISSENGENAUIGKEIT) <> USReturnParameter.Geberkonstante2_IST_m Then
SetOffsetAndGeberAndBereichWhithCheck = -62: Exit Function
End If
If RoundMantisse(USParameter.Offset_Neu1_m3ph, MANTISSENGENAUIGKEIT) <> USReturnParameter.Offset1_IST_m3ph Then
SetOffsetAndGeberAndBereichWhithCheck = -63: Exit Function
End If
If RoundMantisse(USParameter.Offset_Neu2_m3ph, MANTISSENGENAUIGKEIT) <> USReturnParameter.Offset2_IST_m3ph Then
SetOffsetAndGeberAndBereichWhithCheck = -64: Exit Function
End If
If RoundMantisse(USParameter.SteilheitGeber_nsp°C, MANTISSENGENAUIGKEIT) <> USReturnParameter.SteilheitGeber_nsp°C Then
SetOffsetAndGeberAndBereichWhithCheck = -65: Exit Function
End If
If RoundMantisse(USParameter.OffsetGeber_ns, MANTISSENGENAUIGKEIT) <> USReturnParameter.OffsetGeber_ns Then
SetOffsetAndGeberAndBereichWhithCheck = -66: Exit Function
End If
'Alles OK
SetOffsetAndGeberAndBereichWhithCheck = 0
Exit Function
SetOffsetAndGeberAndBereichWhithCheck_Error:
SetOffsetAndGeberAndBereichWhithCheck = -99020
End Function
Public Function SetImpulsWertigkeitAndPulseMode(ByVal intPortNr As Integer, ByVal FP_Impulswertigkeit As Double, ByVal FP_Impulswertigkeit_Pruef As Double, ByVal PulseMode As Byte, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
On Error GoTo SetImpulsWertigkeitAndPulseMode_Error
lngReturn = Set_FP_ImpulsWertigkeit(intPortNr, FP_Impulswertigkeit, lngIdentNoForVerification)
If lngReturn <> 0 Then
SetImpulsWertigkeitAndPulseMode = lngReturn
Exit Function
End If
lngReturn = Set_FP_ImpulsWertigkeit_Pruef(intPortNr, FP_Impulswertigkeit_Pruef, lngIdentNoForVerification)
If lngReturn <> 0 Then
SetImpulsWertigkeitAndPulseMode = lngReturn
Exit Function
End If
lngReturn = Set_PulseMode(intPortNr, PulseMode, lngIdentNoForVerification)
If lngReturn <> 0 Then
SetImpulsWertigkeitAndPulseMode = lngReturn
Exit Function
End If
SetImpulsWertigkeitAndPulseMode = 0
Exit Function
SetImpulsWertigkeitAndPulseMode_Error:
SetImpulsWertigkeitAndPulseMode = -99022
End Function
'################## Den jedesmal gelieferten Datenheader einzeln auslesen und auswerten ###############################################
Public Function GetDataHeader(ByVal intPortNr As Integer, ByRef udtDataHeader As DATAHEADER_TYPE) As Long
On Error GoTo GetDataHeader_Error
Dim lngReturn As Long
Dim strSDaten As String
Dim strEDaten As String
GetDataHeader = -99030
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetDataHeader = lngReturn
Else
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
If lngReturn <> 0 Then
ComPort_Close
GetDataHeader = -3
Else
'Senden hat geklappt -> Jetzt empfangene Daten auslesen
Dim strReserve As String
strEDaten = String(1024, " ") & Chr$(0)
strReserve = ""
lngReturn = RequestData(strEDaten, strReserve)
ComPort_Close
If lngReturn = 0 Then
strEDaten = DLL2Hex(strEDaten)
udtDataHeader.strIdentNo = GetDecodedIdentOrFabNo(CByte(Asc(Mid$(strEDaten, 1, 1))), _
CByte(Asc(Mid$(strEDaten, 2, 1))), _
CByte(Asc(Mid$(strEDaten, 3, 1))), _
CByte(Asc(Mid$(strEDaten, 4, 1))))
udtDataHeader.strManID = GetManID(Asc(Mid$(strEDaten, 5, 1)), Asc(Mid$(strEDaten, 6, 1)))
udtDataHeader.bytVersion = CByte(Asc(Mid$(strEDaten, 7, 1)))
udtDataHeader.enuDeviceType = CByte(Asc(Mid$(strEDaten, 8, 1)))
udtDataHeader.bytAccessNr = CByte(Asc(Mid$(strEDaten, 9, 1)))
udtDataHeader.bytStatus = CByte(Asc(Mid$(strEDaten, 10, 1)))
GetDataHeader = 0
Else
GetDataHeader = -4
End If
End If
End If
Exit Function
GetDataHeader_Error:
GetDataHeader = -99030
End Function
'############################## IdentNr lesen und schreiben ######################################################################
Public Function GetIdentNo(ByVal intPortNr As Integer, ByRef strResult As String) As Long
'Die IdentNr steht immer im Header und braucht daher nicht direkt aus dem Speicher ausgelesen
'werden. Diese Function hat daher nur eine Wrapper-Funktionalität
Dim udtDataHeader As DATAHEADER_TYPE
Dim lngReturn As Long
lngReturn = GetDataHeader(intPortNr, udtDataHeader)
If lngReturn = 0 Then
strResult = udtDataHeader.strIdentNo
GetIdentNo = 0
Else
strResult = ""
GetIdentNo = lngReturn
End If
End Function
Public Function SetIdentNo(ByVal intPortNr As Integer, ByVal lngIdentNo As Long) As Long
'Es wird ein spezieller Befehl benutzt, nicht direkt in den Speicher geschrieben
On Error GoTo SetIdentNo_Error
SetIdentNo = -99040
Dim lngReturn As Long
Dim strSDaten As String
Dim strEDaten As String
Dim strIdentNo As String
If lngIdentNo < 0 Or lngIdentNo > 99999999 Then
SetIdentNo = -10
Exit Function
End If
strIdentNo = Format$(lngIdentNo, "00000000")
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
SetIdentNo = lngReturn
Else
'Anwendungsdaten zusammensetzen, die über den Langsatz an den Slave gesendet werden
strSDaten = Chr$(&HC) & Chr$(&H79) & _
DLL2Hex(Right$(strIdentNo, 2) & Mid$(strIdentNo, 5, 2)) & _
DLL2Hex(Mid$(strIdentNo, 3, 2) & Left$(strIdentNo, 2))
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
ComPort_Close
If lngReturn <> 0 Then
If lngReturn = -2 Or lngReturn = -1 Then
SetIdentNo = lngReturn
Else
SetIdentNo = -3
End If
Else
SetIdentNo = 0
End If
End If
Exit Function
SetIdentNo_Error:
SetIdentNo = -99040
End Function
'#################### Liegenschaftsnummer lesen und schreiben ################################################
Public Function GetLiegenschaft(ByVal intPortNr As Integer, ByRef strResult As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetLiegenschaft = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Liegenschaft, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Format$(GetLongValueFrom4ByteString(strResult), "00000000")
Else
strResult = ""
End If
GetLiegenschaft = lngReturn
End If
End Function
Public Function SetLiegenschaft(ByVal intPortNr As Integer, ByVal lngDaten As Long) As Long
'Es wird ein spezieller Befehl benutzt, nicht direkt in den Speicher geschrieben
On Error GoTo SetLiegenschaft_Error
SetLiegenschaft = -99060
Dim lngReturn As Long
Dim strSDaten As String
Dim strEDaten As String
Dim strLiegenschaft As String
If lngDaten < 0 Or lngDaten > 99999999 Then
SetLiegenschaft = -10
Exit Function
End If
strLiegenschaft = Format$(lngDaten, "00000000")
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
SetLiegenschaft = lngReturn
Else
'Anwendungsdaten zusammensetzen, die über den Langsatz an den Slave gesendet werden
strSDaten = Chr$(&HC) & Chr$(&HFD) & Chr$(&H10) ' "set customer loc."
strSDaten = strSDaten & DLL2Hex((Right$(strLiegenschaft, 2) & Mid$(strLiegenschaft, 5, 2))) & _
DLL2Hex((Mid$(strLiegenschaft, 3, 2) & Left$(strLiegenschaft, 2)))
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
ComPort_Close
If lngReturn <> 0 Then
SetLiegenschaft = lngReturn
Else
'Senden hat geklappt -> Rückmeldung kommt nicht ???
SetLiegenschaft = 0
End If
End If
Exit Function
SetLiegenschaft_Error:
SetLiegenschaft = -99060
End Function
'#################### Fabrikationsnummer lesen und schreiben ################################################
Public Function GetFabNo(ByVal intPortNr As Integer, ByRef strResult As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetFabNo = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Fab_Nr, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Format$(GetLongValueFrom4ByteString(strResult), "00000000")
GetFabNo = 0
Else
strResult = ""
GetFabNo = lngReturn
End If
End If
End Function
Public Function SetFabNo(ByVal intPortNr As Integer, ByVal lngDaten As Long) As Long
'Es wird ein spezieller Befehl benutzt, nicht direkt in den Speicher geschrieben
On Error GoTo SetFabNo_Error
SetFabNo = -99070
Dim lngReturn As Long
Dim strSDaten As String
Dim strEDaten As String
Dim strFabNo As String
If lngDaten < 0 Or lngDaten > 99999999 Then
SetFabNo = -10
Exit Function
End If
strFabNo = Format$(lngDaten, "00000000")
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
SetFabNo = lngReturn
Else
'Anwendungsdaten zusammensetzen, die über den Langsatz an den Slave gesendet werden
strSDaten = Chr$(&HC) & Chr$(&H78) '???
strSDaten = strSDaten & DLL2Hex((Right$(strFabNo, 2) & Mid$(strFabNo, 5, 2))) & _
DLL2Hex((Mid$(strFabNo, 3, 2) & Left$(strFabNo, 2)))
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
ComPort_Close
If lngReturn <> 0 Then
SetFabNo = lngReturn
Else
'Senden hat geklappt -> Rückmeldung kommt nicht ???
SetFabNo = 0
End If
End If
Exit Function
SetFabNo_Error:
SetFabNo = -99070
End Function
'##################################### Datum/Uhrzeit lesen und setzen ###########################################################################
'Die Systemzeit des Zählers wird sekundengenau gelesen und gesetzt
'Die Sommerzeit wird nicht berücksichtigt!
Public Function GetDateTime(ByVal intPortNr As Integer, ByRef dtmResult As Date, Optional lngIdentNoForVerification As Long = -1) As Long
On Error GoTo GetDateTime_Error
Dim lngReturn As Long
Dim strResult As String
GetDateTime = -99081
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetDateTime = lngReturn
Else
strResult = ""
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_DateTime, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
Dim DT1 As Integer
Dim DT2 As Integer
Dim dt3 As Integer
Dim dt4 As Integer
Dim dt6 As Integer
DT1 = Asc(Mid$(strResult, 1, 1))
DT2 = Asc(Mid$(strResult, 2, 1))
dt3 = Asc(Mid$(strResult, 3, 1))
dt4 = Asc(Mid$(strResult, 4, 1))
'dt5 -> Checksumme wird beim auslesen ignoriert
dt6 = Asc(Mid$(strResult, 6, 1))
Dim intYear As Integer
Dim bytYear As Byte
Dim bytMonth As Byte
Dim bytDay As Byte
Dim bytHour As Byte
Dim bytMinute As Byte
Dim bytSecond As Byte
bytSecond = dt6
bytMinute = DT1 And &H3F 'Nur die letzten 6 Bits enthalten die Minute
bytHour = DT2 And &H1F 'Nur die letzten 5 Bits enthalten die Stunde
bytDay = dt3 And &H1F 'Nur die letzten 5 Bits enthalten den Tag
bytMonth = dt4 And &HF 'Nur die letzten 4 Bits enthalten den Monat
dt4 = dt4 And &HF0 'Nur die ersten 4 Bits enthalten die ersten 4 Bits des Jahres (von insgesamt 7 Bits)
dt3 = dt3 And &HE0 'Nur die ersten 3 Bits enthalten die letzten 3 Bits des Jahres
bytYear = (dt4 / &H2) + (dt3 / &H20)
If bytYear < 80 Then
intYear = 2000 + bytYear
Else
intYear = 1900 + bytYear
End If
dtmResult = DateSerial(intYear, bytMonth, bytDay) + TimeSerial(bytHour, bytMinute, bytSecond)
GetDateTime = 0
Else
GetDateTime = lngReturn
End If
End If
Exit Function
GetDateTime_Error:
GetDateTime = -99081
End Function
Public Function SetDateTime(ByVal intPortNr As Integer, ByVal dtmDaten As Date, Optional lngIdentNoForVerification As Long = -1) As Long
On Error GoTo SetDateTime_Error
SetDateTime = -99082
Dim lngReturn As Long
Dim strDaten As String
'Dim strSDaten As String
'Dim strEDaten As String
Dim DT1 As Integer
Dim DT2 As Integer
Dim dt3 As Integer
Dim dt4 As Integer
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
SetDateTime = lngReturn
Else
'Anwendungsdaten zusammensetzen, die über den Langsatz an den Slave gesendet werden
DT1 = Minute(dtmDaten)
DT2 = Hour(dtmDaten)
dt3 = Day(dtmDaten)
dt3 = dt3 + (((Year(dtmDaten) Mod 100) And &H7) * &H20) 'die letzten 3 Bits nehmen, um 5 Bits nach links schieben und auf das "Tagesbyte" packen
dt4 = Month(dtmDaten)
dt4 = dt4 + ((Year(dtmDaten) Mod 100) And &HF8) * &H2 'die ersten 5 Bits nehmen, um eine Bit nach links schieben und auf das "Monatsbyte" packen
strDaten = Chr$(DT1) & Chr$(DT2) & Chr$(dt3) & Chr$(dt4) & Chr$((DT1 + DT2 + dt3 + dt4) Mod 256) & Chr$(Second(dtmDaten))
lngReturn = SetValueOnMasterRam(intPortNr, enuMem_DateTime, strDaten, lngIdentNoForVerification)
' strSDaten = Chr$(&H4) & Chr$(&H6D)
' strSDaten = strSDaten & Chr$(dt1) & Chr$(dt2) & Chr$(dt3) & Chr$(dt4)
' strEDaten = String(1024, " ") & Chr$(0)
' lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
ComPort_Close
If lngReturn <> 0 Then
SetDateTime = lngReturn
Else
'Senden hat geklappt -> Gibt keine Rückmeldung
SetDateTime = 0
End If
End If
Exit Function
SetDateTime_Error:
SetDateTime = -99082
End Function
'################### Volume ##################################################################################
'Der Gesamtzählerstand in m³ wird ausgelesen - Man kan ihn mit ResetVolumeAndEnergy auf 0 setzten
Public Function GetVolume(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim bytScaling As Byte
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetVolume = lngReturn
Else
lngReturn = GetScaling(intPortNr, bytScaling, lngIdentNoForVerification)
If lngReturn <> 0 Then
ComPort_Close
GetVolume = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Volume, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
dblResult = GetLongValueFrom4ByteString(strResult) / 1000
Select Case bytScaling
Case 0:
Case 1: dblResult = dblResult * 10
Case 2: dblResult = dblResult * 100
Case 3: dblResult = dblResult * 1000
Case Else
GetVolume = -80
Exit Function
End Select
Else
dblResult = 0
End If
GetVolume = lngReturn
End If
End If
End Function
'################### Energy ##################################################################################
'Der Gesamtzählerstand in MWh wird ausgelesen - Man kan ihn mit ResetVolumeAndEnergy auf 0 setzten
Public Function GetEnergy(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim bytScaling As Byte
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetEnergy = lngReturn
Else
lngReturn = GetScaling(intPortNr, bytScaling, lngIdentNoForVerification)
If lngReturn <> 0 Then
ComPort_Close
GetEnergy = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Energy, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
dblResult = GetLongValueFrom4ByteString(strResult) / 1000
Select Case bytScaling
Case 0:
Case 1: dblResult = dblResult * 10
Case 2: dblResult = dblResult * 100
Case 3: dblResult = dblResult * 1000
Case Else
GetEnergy = -80
Exit Function
End Select
GetEnergy = 0
Else
dblResult = 0
GetEnergy = lngReturn
End If
End If
End If
End Function
'############### Eine Funktion, die für die Prüfung/Justage wohl kaum gebraucht wird, nur zur Information dient #############################################
Public Function Get_Slave_FLASH_Firmware_Version(ByVal intPortNr As Integer, ByRef bytResult As Byte, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_Slave_FLASH_Firmware_Version = lngReturn
Else
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_Slave_FLASH_Firmware_Version, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
bytResult = Asc(Left$(strResult, 1))
Get_Slave_FLASH_Firmware_Version = 0
Else
bytResult = 0
Get_Slave_FLASH_Firmware_Version = lngReturn
End If
End If
End Function
'###################### Reset der Zählerstandes ##########################################################################
'Aber Achtung: Die Werte im "Archiv" geben darüber Aufschluss, wie die Zählerstände vorher mal waren!
Public Function ResetVolumeAndEnergy(ByVal intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
ResetVolumeAndEnergy = -99
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
ResetVolumeAndEnergy = lngReturn
Else
strDaten = String(128, Chr$(0))
lngReturn = SetValueOnMasterRam(intPortNr, enuMem_EneryVolumePart1, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetVolumeAndEnergy = lngReturn
Else
strDaten = String(128, Chr$(0))
lngReturn = SetValueOnMasterRam(intPortNr, enuMem_EneryVolumePart2, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetVolumeAndEnergy = lngReturn
Else
strDaten = String(128, Chr$(0))
lngReturn = SetValueOnMasterRam(intPortNr, enuMem_EneryVolumePart3, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetVolumeAndEnergy = lngReturn
Else
strDaten = String(128, Chr$(0))
lngReturn = SetValueOnMasterRam(intPortNr, enuMem_EneryVolumePart4, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetVolumeAndEnergy = lngReturn
Else
strDaten = Chr$(&H2) & Chr$(&H0) & Chr$(&HFF) & Chr$(&HFF)
strDaten = strDaten & (Chr$(&H0) & Chr$(&H0) & Chr$(&H0))
lngReturn = SetValueOnMasterRam(intPortNr, enuMem_EneryVolumePart5, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetVolumeAndEnergy = lngReturn
Else
ResetVolumeAndEnergy = 0
End If
End If
End If
End If
End If
ComPort_Close
End If
End Function
Public Function ResetFPVolKumStatusLifeTime(ByVal intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
ResetFPVolKumStatusLifeTime = -99
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
ResetFPVolKumStatusLifeTime = lngReturn
Else
strDaten = String(4, Chr$(0))
lngReturn = SetValueOnSlaveRam(intPortNr, enuMem_FP_Vol_kum, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetFPVolKumStatusLifeTime = lngReturn
Else
strDaten = String(1, Chr$(0))
lngReturn = SetValueOnSlaveRam(intPortNr, enuMem_status_info, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetFPVolKumStatusLifeTime = lngReturn
Else
strDaten = String(2, Chr$(0))
lngReturn = SetValueOnSlaveRam(intPortNr, enuMem_lifetime_cnt_fast_rate, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetFPVolKumStatusLifeTime = lngReturn
Else
strDaten = String(2, Chr$(0))
lngReturn = SetValueOnSlaveRam(intPortNr, enuMem_lifetime_cnt_pruefpulse, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
ResetFPVolKumStatusLifeTime = lngReturn
Else
ResetFPVolKumStatusLifeTime = 0
End If
End If
End If
End If
ComPort_Close
End If
End Function
'########################## T_fp #######################################################################################################
'Die gerade gemessene Temperatur (auch im Display zu sehen )
Public Function Get_T_fp(ByVal intPortNr As Integer, ByVal Messort As TEMPERATUR_ENUM, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_T_fp = lngReturn
Else
dblResult = 0
If (Messort = enuTemp_Vorlauf) Then
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_TV_fp, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_T_fp = 0
Else
Get_T_fp = lngReturn
End If
ElseIf (Messort = enuTemp_Ruecklauf) Then
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_TR_fp, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_T_fp = 0
Else
Get_T_fp = lngReturn
End If
ElseIf (Messort = enuTemp_DeltaVorlaufRuecklauf) Then
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_T, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 8)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(Left$(strResult, 4)))), MANTISSENGENAUIGKEIT)
dblResult = dblResult - RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(Right$(strResult, 4)))), MANTISSENGENAUIGKEIT)
Get_T_fp = 0
Else
Get_T_fp = lngReturn
End If
End If
End If
End Function
'########################## Flow_fp #######################################################################################################
'Der gerade gemessene Durchfluß (auch im Display zu sehen ) in m³/h
Public Function Get_Flow_fp(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_Flow_fp = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Flow_fp, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_Flow_fp = 0
Else
dblResult = 0
Get_Flow_fp = lngReturn
End If
End If
End Function
'########################## NOWA_energy #######################################################################################################
'Einheit in kWh (ist nach NOWA_Stop immer 0 und zeigt erst nach NOWA_Stop das richtige an, weil sonst nur in großen Zeitabständen der Wert aktualisiert wird)
Public Function Get_NOWA_energy(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim bytScaling As Byte
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_NOWA_energy = lngReturn
Else
lngReturn = GetScaling(intPortNr, bytScaling, lngIdentNoForVerification)
If lngReturn <> 0 Then
ComPort_Close
Get_NOWA_energy = lngReturn
Else
'lngReturn = GetValueFromMasterRam(intPortNr, enuMem_NOWA_energy_hr, strResult, lngIdentNoForVerification)
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_NOWA_energy, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
dblResult = GetLongValueFrom4ByteString(Right$(strResult, 4)) + _
GetLongValueFrom4ByteString(Left$(strResult, 4)) / 100000000
Select Case bytScaling
Case 0:
Case 1: dblResult = dblResult * 10
Case 2: dblResult = dblResult * 100
Case 3: dblResult = dblResult * 1000
Case Else
Get_NOWA_energy = -80
Exit Function
End Select
Get_NOWA_energy = 0
Else
dblResult = 0
Get_NOWA_energy = lngReturn
End If
End If
End If
End Function
'########################## NOWA_volume_fp #######################################################################################################
'Einheit in l (ist nach NOWA_Stop immer 0 und zeigt erst nach NOWA_StopNOWA_Stop das richtige an, weil sonst nur in großen Zeitabständen der Wert aktualisiert wird)
Public Function Get_NOWA_volume_fp(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim bytScaling As Byte
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_NOWA_volume_fp = lngReturn
Else
lngReturn = GetScaling(intPortNr, bytScaling, lngIdentNoForVerification)
If lngReturn <> 0 Then
ComPort_Close
Get_NOWA_volume_fp = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_NOWA_volume_fp, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult)))
Select Case bytScaling
Case 0:
Case 1: dblResult = dblResult * 10
Case 2: dblResult = dblResult * 100
Case 3: dblResult = dblResult * 1000
Case Else
Get_NOWA_volume_fp = -80
Exit Function
End Select
Get_NOWA_volume_fp = 0
Else
dblResult = 0
Get_NOWA_volume_fp = lngReturn
End If
End If
End If
End Function
'########################## FP_Temperature #######################################################################################################
'Die am Rücklauf gemessene Temperatur in °C
Public Function Get_FP_Temperature(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FP_Temperature = lngReturn
Else
lngReturn = GetValueFromSlaveRam(intPortNr, enuMem_FP_Temperature, strResult, lngIdentNoForVerification)
'''MsgBox "Geändert!!!"
'''lngReturn = GetValueFromSlaveRam(intPortNr, enuMem_FP_Enthalpie_Pu, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_FP_Temperature = 0
Else
dblResult = 0
Get_FP_Temperature = lngReturn
End If
End If
End Function
'Die Funktion ist nur erfolgreich wenn entweder zuvor SetTemperatureTransferLock
'den Tranfer blockiert hat (Temperature_to_slave_transfere mit dem Wert 5A0F)
'oder kein Sensor angeschlossen ist
Public Function Set_FP_Temperature(ByVal intPortNr As Integer, ByVal dblDaten As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString As String
strFloatString = DEZ_To_FloatMSP430(dblDaten)
strDaten = HEXdrehen(DLL2Hex(strFloatString))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_FP_Temperature = lngReturn
Else
lngReturn = SetValueOnSlaveRam(intPortNr, enuMem_FP_Temperature, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
Set_FP_Temperature = lngReturn
Else
'HEX 20 zusätzlich an Adresse HEX202 schreiben (blind ohne zu Testen programmiert ;-)
strDaten = Chr$(&H20)
Set_FP_Temperature = SetValueOnSlaveRam(intPortNr, enuMem_host_command, strDaten, lngIdentNoForVerification)
End If
ComPort_Close
End If
End Function
'#################### TemperatureTransferLock: Status abfragen / Öffnen+Schliessen ################################################
Public Function GetTemperatureTransferLock(ByVal intPortNr As Integer, ByRef blnResult As Boolean, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetTemperatureTransferLock = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Temp_to_slave_trans, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
'blnResult = (Asc(Left$(strResult, 1)) = &H5A) And (Asc(Mid$(strResult, 2, 1)) = &HF)
blnResult = (Asc(Left$(strResult, 1)) = &HF) And (Asc(Mid$(strResult, 2, 1)) = &H5A)
GetTemperatureTransferLock = 0
Else
blnResult = False
GetTemperatureTransferLock = lngReturn
End If
End If
End Function
Public Function SetTemperatureTransferLock(ByVal intPortNr As Integer, blnLocked As Boolean, Optional lngIdentNoForVerification As Long = -1) As Long
Dim strDaten As String
Dim lngReturn As Long
If blnLocked Then
strDaten = Chr$(&HF) & Chr$(&H5A)
Else
strDaten = Chr$(0) & Chr$(0)
End If
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
SetTemperatureTransferLock = lngReturn
Else
SetTemperatureTransferLock = SetValueOnMasterRam(intPortNr, enuMem_Temp_to_slave_trans, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
'########################## FP_Flow_Simu [m³/Sekunde] #########################################################################################################
Public Function Get_FP_Flow_Simu(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FP_Flow_Simu = lngReturn
Else
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_Flow_Simu, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_FP_Flow_Simu = 0
Else
dblResult = 0
Get_FP_Flow_Simu = lngReturn
End If
End If
End Function
'########################## FP_Flow_Simu [m³/Sekunde] #########################################################################################################
Public Function Set_FP_Flow_Simu(ByVal intPortNr As Integer, ByVal dblDaten As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString As String
strFloatString = DEZ_To_FloatMSP430(dblDaten)
strDaten = HEXdrehen(DLL2Hex(strFloatString))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_FP_Flow_Simu = lngReturn
Else
Set_FP_Flow_Simu = SetValueOnSlaveFlash(intPortNr, enuMem_FP_Flow_Simu, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
'########################## FP_ImpulsWertigkeit [m³/Impuls] #########################################################################################################
Public Function Get_FP_ImpulsWertigkeit(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FP_ImpulsWertigkeit = lngReturn
Else
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_ImpulsWertigkeit, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_FP_ImpulsWertigkeit = 0
Else
dblResult = 0
Get_FP_ImpulsWertigkeit = lngReturn
End If
End If
End Function
'########################## FP_ImpulsWertigkeit [m³/Impuls] #########################################################################################################
Public Function Set_FP_ImpulsWertigkeit(ByVal intPortNr As Integer, ByVal dblDaten As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString As String
strFloatString = DEZ_To_FloatMSP430(dblDaten)
strDaten = HEXdrehen(DLL2Hex(strFloatString))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_FP_ImpulsWertigkeit = lngReturn
Else
Set_FP_ImpulsWertigkeit = SetValueOnSlaveFlash(intPortNr, enuMem_FP_ImpulsWertigkeit, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
'########################## FP_ImpulsWertigkeit_Pruef [m³/Impuls] #########################################################################################################
Public Function Get_FP_ImpulsWertigkeit_Pruef(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FP_ImpulsWertigkeit_Pruef = lngReturn
Else
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_ImpulsWertigkeit_Pruef, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_FP_ImpulsWertigkeit_Pruef = 0
Else
dblResult = 0
Get_FP_ImpulsWertigkeit_Pruef = lngReturn
End If
End If
End Function
'########################## FP_ImpulsWertigkeit_Pruef [m³/Impuls] #########################################################################################################
Public Function Set_FP_ImpulsWertigkeit_Pruef(ByVal intPortNr As Integer, ByVal dblDaten As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString As String
strFloatString = DEZ_To_FloatMSP430(dblDaten)
strDaten = HEXdrehen(DLL2Hex(strFloatString))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_FP_ImpulsWertigkeit_Pruef = lngReturn
Else
Set_FP_ImpulsWertigkeit_Pruef = SetValueOnSlaveFlash(intPortNr, enuMem_FP_ImpulsWertigkeit_Pruef, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
'########################## PulseMode [m³/Impuls] #########################################################################################################
Public Function Get_PulseMode(ByVal intPortNr As Integer, ByRef bytResult As Byte, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_PulseMode = lngReturn
Else
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_PulseMode_read, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
bytResult = Asc(Mid(strResult, 2, 1))
Get_PulseMode = 0
Else
bytResult = 0
Get_PulseMode = lngReturn
End If
End If
End Function
'########################## PulseMode #########################################################################################################
Public Function Set_PulseMode(ByVal intPortNr As Integer, ByVal bytDaten As Byte, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
strDaten = Chr$(bytDaten)
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_PulseMode = lngReturn
Else
Set_PulseMode = SetValueOnSlaveFlash(intPortNr, enuMem_PulseMode_write, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
'#################### Scaling Abfragen ################################################
Private Function GetScaling(ByVal intPortNr As Integer, ByRef bytResult As Byte, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
'COM-Port muss geöffnet sein !
'GetScaling ist sowieso nur eine Modul-Interne Function (Private)
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Scaling, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
bytResult = Asc(Left$(strResult, 1))
GetScaling = 0
Else
bytResult = False
GetScaling = lngReturn
End If
End Function
'#################### SCHLOSS: Status abfragen / Öffnen+Schliessen ################################################
Public Function GetSchloss(ByVal intPortNr As Integer, ByRef blnResult As Boolean, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim lngResult As Long
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetSchloss = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Schloss, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
blnResult = (Asc(Left$(strResult, 1)) = &HA5) 'Bei geöffnetem Schloss steht der Wert auf &HE5
GetSchloss = 0
Else
blnResult = False
GetSchloss = lngReturn
End If
End If
End Function
Public Function OpenSchloss(ByVal intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
OpenSchloss = SetSchloss(intPortNr, True, lngIdentNoForVerification)
End Function
'DARF NUR GANZ ZUM SCHLUSS VERWENDET WERDEN; DA DANACH DAS SCHLOSS NICHT WIEDER GEÖFFNET WERDEN KANN !!!!
Public Function CloseSchloss(ByVal intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
CloseSchloss = SetSchloss(intPortNr, False, lngIdentNoForVerification)
End Function
Private Function SetSchloss(ByVal intPortNr As Integer, blnOpen As Boolean, Optional lngIdentNoForVerification As Long = -1) As Long
Dim strDaten As String
Dim lngReturn As Long
If blnOpen Then
strDaten = Chr$(SCHLOSSAUF)
Else
strDaten = Chr$(SCHLOSS_ZU)
End If
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
SetSchloss = lngReturn
Else
SetSchloss = SetValueOnMasterRam(intPortNr, enuMem_OpenClose, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
'#################### Timeout des Opto-Kopfes lesen und setzen ##############################################################################
'Ermittelt die Anzahl der Minuten, die noch vergehen, bis sich der Optokopf ausschaltet
Public Function Get_Opto_off_timer(ByVal intPortNr As Integer, ByRef intResult As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim lngResult As Long
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_Opto_off_timer = lngReturn
Else
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Opto_off_timer, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
lngResult = CLng(Asc(Left$(strResult, 1))) + CLng(Asc(Mid$(strResult, 2, 1))) * 256
If lngResult > 32767 Then
intResult = CLng(Asc(Left$(strResult, 1))) 'alter Zähler, der nur mit einem Byte arbeitet
Else
intResult = lngResult
End If
Get_Opto_off_timer = 0
Else
intResult = 0
Get_Opto_off_timer = lngReturn
End If
End If
End Function
'#################### Optokoppler-TimeOut setzen #########################################################################################################################################
'Wie lange noch soll der Opto-Kopf eingeschaltet bleiben (max. 255 Minuten)
Public Function Set_Opto_off_timer(ByVal intPortNr As Integer, ByVal intDaten As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
Dim strDaten As String
Dim lngReturn As Long
strDaten = Chr$(intDaten Mod 256) & Chr$(intDaten \ 256)
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_Opto_off_timer = lngReturn
Else
Set_Opto_off_timer = SetValueOnMasterRam(intPortNr, enuMem_Opto_off_timer, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
Public Function Set_Opto_off_timer_Max(ByVal intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Set_Opto_off_timer_Max = -99200
'Schloss öffnen
lngReturn = SetSchloss(intPortNr, True)
If lngReturn <> 0 Then
Set_Opto_off_timer_Max = lngReturn
Exit Function
End If
'Optokoppler-TimeOut auf 1440 Minuten setzen
lngReturn = Set_Opto_off_timer(intPortNr, 1440, lngIdentNoForVerification)
If lngReturn <> 0 Then
Set_Opto_off_timer_Max = lngReturn
Exit Function
End If
'Auf keine Fall Schloss schließen
Set_Opto_off_timer_Max = 0
End Function
'#################### special_mode ##################################################
Public Function Get_special_mode(ByVal intPortNr As Integer, ByRef blnResult As Boolean, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_special_mode = lngReturn
Else
lngReturn = GetValueFromSlaveRam(intPortNr, enuMem_special_mode, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
blnResult = (Asc(Left$(strResult, 1)) = 1)
Get_special_mode = 0
Else
blnResult = 0
Get_special_mode = lngReturn
End If
End If
End Function
Public Function Set_special_mode(ByVal intPortNr As Integer, blnON As Boolean, Optional lngIdentNoForVerification As Long = -1) As Long
Dim strDaten As String
Dim lngReturn As Long
If blnON Then
strDaten = Chr$(1)
Else
strDaten = Chr$(0)
End If
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_special_mode = lngReturn
Else
Set_special_mode = SetValueOnSlaveRam(intPortNr, enuMem_special_mode, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
'#################### GeberKonstanten ####################################################################################################################################################
Public Function GetGeberKonstanten(ByVal intPortNr As Integer, ByRef FP_K_Geber1 As Double, ByRef FP_K_Geber2 As Double, ByRef FP_ST_Geber As Double, ByRef FP_O_Geber As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim strFloatString1 As String
Dim strFloatString2 As String
On Error GoTo GetGeberKonstanten_Error
GetGeberKonstanten = -99
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetGeberKonstanten = lngReturn
Else
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_K_Geber1, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString1 = Left$(strResult, 4)
strFloatString1 = String2Hex(HEXdrehen(strFloatString1))
FP_K_Geber1 = RoundMantisse(FloatMSP430_To_DEZ(strFloatString1), MANTISSENGENAUIGKEIT)
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_K_Geber2, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = Left$(strResult, 4)
strFloatString2 = String2Hex(HEXdrehen(strFloatString2))
FP_K_Geber2 = RoundMantisse(FloatMSP430_To_DEZ(strFloatString2), MANTISSENGENAUIGKEIT)
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_ST_Geber, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = Left$(strResult, 4)
strFloatString2 = String2Hex(HEXdrehen(strFloatString2))
FP_ST_Geber = RoundMantisse(FloatMSP430_To_DEZ(strFloatString2) * 1000000000, MANTISSENGENAUIGKEIT)
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_O_Geber, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = Left$(strResult, 4)
strFloatString2 = String2Hex(HEXdrehen(strFloatString2))
FP_O_Geber = RoundMantisse(FloatMSP430_To_DEZ(strFloatString2) * 1000000000, MANTISSENGENAUIGKEIT)
GetGeberKonstanten = 0
Else
GetGeberKonstanten = lngReturn
End If
Else
GetGeberKonstanten = lngReturn
End If
Else
GetGeberKonstanten = lngReturn
End If
Else
GetGeberKonstanten = lngReturn
End If
ComPort_Close
End If
Exit Function
GetGeberKonstanten_Error:
GetGeberKonstanten = -99
End Function
Public Function SetGeberKonstanten(ByVal intPortNr As Integer, ByVal FP_K_Geber1 As Double, ByVal FP_K_Geber2 As Double, ByVal FP_ST_Geber As Double, ByVal FP_O_Geber As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString1 As String
Dim strFloatString2 As String
On Error GoTo SetGeberKonstanten_Error
SetGeberKonstanten = -99
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
SetGeberKonstanten = lngReturn
Else
strFloatString1 = DEZ_To_FloatMSP430(FP_K_Geber1)
strDaten = HEXdrehen(DLL2Hex(strFloatString1))
lngReturn = SetValueOnSlaveFlash(intPortNr, enuMem_FP_K_Geber1, strDaten, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = DEZ_To_FloatMSP430(FP_K_Geber2)
strDaten = HEXdrehen(DLL2Hex(strFloatString2))
lngReturn = SetValueOnSlaveFlash(intPortNr, enuMem_FP_K_Geber2, strDaten, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = DEZ_To_FloatMSP430(FP_ST_Geber / 1000000000)
strDaten = HEXdrehen(DLL2Hex(strFloatString2))
lngReturn = SetValueOnSlaveFlash(intPortNr, enuMem_FP_ST_Geber, strDaten, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = DEZ_To_FloatMSP430(FP_O_Geber / 1000000000)
strDaten = HEXdrehen(DLL2Hex(strFloatString2))
lngReturn = SetValueOnSlaveFlash(intPortNr, enuMem_FP_O_Geber, strDaten, lngIdentNoForVerification)
If lngReturn = 0 Then
SetGeberKonstanten = 0
Else
SetGeberKonstanten = lngReturn
End If
Else
SetGeberKonstanten = lngReturn
End If
Else
SetGeberKonstanten = lngReturn
End If
Else
SetGeberKonstanten = lngReturn
End If
ComPort_Close
End If
Exit Function
SetGeberKonstanten_Error:
SetGeberKonstanten = -99
End Function
'#################### OffsetKonstanten ################################################
Public Function GetOffsetKonstanten(ByVal intPortNr As Integer, ByRef FP_QOffset1 As Double, ByRef FP_QOffset2 As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim strFloatString1 As String
Dim strFloatString2 As String
On Error GoTo GetOffsetKonstanten_Error
GetOffsetKonstanten = -99
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetOffsetKonstanten = lngReturn
Else
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_QOffset1, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString1 = Left$(strResult, 4)
strFloatString1 = String2Hex(HEXdrehen(strFloatString1))
FP_QOffset1 = RoundMantisse(FloatMSP430_To_DEZ(strFloatString1) * 3600, MANTISSENGENAUIGKEIT)
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_QOffset2, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = Left$(strResult, 4)
strFloatString2 = String2Hex(HEXdrehen(strFloatString2))
FP_QOffset2 = RoundMantisse(FloatMSP430_To_DEZ(strFloatString2) * 3600, MANTISSENGENAUIGKEIT)
GetOffsetKonstanten = 0
Else
GetOffsetKonstanten = lngReturn
End If
Else
GetOffsetKonstanten = lngReturn
End If
ComPort_Close
End If
Exit Function
GetOffsetKonstanten_Error:
GetOffsetKonstanten = -99
End Function
Public Function SetOffsetKonstanten(ByVal intPortNr As Integer, ByVal FP_QOffset1 As Double, ByVal FP_QOffset2 As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString1 As String
Dim strFloatString2 As String
On Error GoTo SetOffsetKonstanten_Error
SetOffsetKonstanten = -99
strFloatString1 = DEZ_To_FloatMSP430(FP_QOffset1 / 3600)
strDaten = HEXdrehen(DLL2Hex(strFloatString1))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
SetOffsetKonstanten = lngReturn
Else
lngReturn = SetValueOnSlaveFlash(intPortNr, enuMem_FP_QOffset1, strDaten, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = DEZ_To_FloatMSP430(FP_QOffset2 / 3600)
strDaten = HEXdrehen(DLL2Hex(strFloatString2))
SetOffsetKonstanten = SetValueOnSlaveFlash(intPortNr, enuMem_FP_QOffset2, strDaten, lngIdentNoForVerification)
Else
SetOffsetKonstanten = lngReturn
End If
ComPort_Close
End If
Exit Function
SetOffsetKonstanten_Error:
SetOffsetKonstanten = -99
End Function
'################################### Duchfluß-Ober- u. Untergrenze #############################################################################
Public Function Get_FP_Flow_MaxMin(ByVal intPortNr As Integer, ByRef FP_Flow_Min As Double, ByRef FP_Flow_Max As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim strFloatString1 As String
Dim strFloatString2 As String
On Error GoTo Get_FP_Flow_MaxMin_Error
Get_FP_Flow_MaxMin = -99
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FP_Flow_MaxMin = lngReturn
Else
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_Flow_Min, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString1 = Left$(strResult, 4)
strFloatString1 = String2Hex(HEXdrehen(strFloatString1))
FP_Flow_Min = RoundMantisse(FloatMSP430_To_DEZ(strFloatString1) * 3600, MANTISSENGENAUIGKEIT)
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_Flow_Max, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = Left$(strResult, 4)
strFloatString2 = String2Hex(HEXdrehen(strFloatString2))
FP_Flow_Max = RoundMantisse(FloatMSP430_To_DEZ(strFloatString2) * 3600, MANTISSENGENAUIGKEIT)
Get_FP_Flow_MaxMin = 0
Else
Get_FP_Flow_MaxMin = lngReturn
End If
Else
Get_FP_Flow_MaxMin = lngReturn
End If
ComPort_Close
End If
Exit Function
Get_FP_Flow_MaxMin_Error:
Get_FP_Flow_MaxMin = -99
End Function
Public Function Set_FP_Flow_MaxMin(ByVal intPortNr As Integer, ByVal FP_Flow_Min As Double, ByVal FP_Flow_Max As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString1 As String
Dim strFloatString2 As String
On Error GoTo Set_FP_Flow_MaxMin_Error
Set_FP_Flow_MaxMin = -99
strFloatString1 = DEZ_To_FloatMSP430(FP_Flow_Min / 3600)
strDaten = HEXdrehen(DLL2Hex(strFloatString1))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_FP_Flow_MaxMin = lngReturn
Else
lngReturn = SetValueOnSlaveFlash(intPortNr, enuMem_FP_Flow_Min, strDaten, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString2 = DEZ_To_FloatMSP430(FP_Flow_Max / 3600)
strDaten = HEXdrehen(DLL2Hex(strFloatString2))
Set_FP_Flow_MaxMin = SetValueOnSlaveFlash(intPortNr, enuMem_FP_Flow_Max, strDaten, lngIdentNoForVerification)
Else
Set_FP_Flow_MaxMin = lngReturn
End If
ComPort_Close
End If
Exit Function
Set_FP_Flow_MaxMin_Error:
Set_FP_Flow_MaxMin = -99
End Function
'################################### Bereichs-Grenzen lesen und setzen ###################################################################################################
Private Function Get_FP_Bereich(ByVal intPortNr As Integer, ByRef FP_Bereich As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim strFloatString As String
On Error GoTo Get_FP_Bereich_Error
Get_FP_Bereich = -99
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FP_Bereich = lngReturn
Else
strResult = ""
lngReturn = GetValueFromSlaveFlash(intPortNr, enuMem_FP_Bereich, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
strFloatString = Left$(strResult, 4)
strFloatString = String2Hex(HEXdrehen(strFloatString))
FP_Bereich = RoundMantisse(FloatMSP430_To_DEZ(strFloatString) * 1000000000, MANTISSENGENAUIGKEIT)
Get_FP_Bereich = 0
Else
Get_FP_Bereich = lngReturn
End If
ComPort_Close
End If
Exit Function
Get_FP_Bereich_Error:
Get_FP_Bereich = -99
End Function
Private Function Set_FP_Bereich(ByVal intPortNr As Integer, ByVal dblDaten As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString As String
strFloatString = DEZ_To_FloatMSP430(dblDaten / 1000000000)
strDaten = HEXdrehen(DLL2Hex(strFloatString))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_FP_Bereich = lngReturn
Else
Set_FP_Bereich = SetValueOnSlaveFlash(intPortNr, enuMem_FP_Bereich, strDaten, lngIdentNoForVerification)
End If
End Function
'######################## Fehlerabfrage ###############################################################################
Public Function GetErrorStatus(ByVal intPortNr As Integer, ByRef US_Error As USZAEHLERERRORTYP, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim lngError As Long
Dim bytWZ As Byte
Dim bytYX As Byte
Dim bytFatalError As Byte
On Error GoTo GetErrorStatus_Error
GetErrorStatus = -99
Dim dummyError As USZAEHLERERRORTYP
US_Error = dummyError 'Alle Bits auf false
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
GetErrorStatus = lngReturn
Else
strResult = ""
lngReturn = GetValueFromMasterRam(intPortNr, enuMem_Error, strResult, lngIdentNoForVerification)
If lngReturn = 0 Then
lngError = CLng(Asc(Left$(strResult, 1))) + CLng(Asc(Mid$(strResult, 2, 1))) * 256
bytWZ = Asc(Mid$(strResult, 1, 1))
bytYX = Asc(Mid$(strResult, 2, 1))
bytFatalError = Asc(Mid$(strResult, 3, 1))
With US_Error
.strDisplayString = String2Hex(Mid$(strResult, 2, 1) & (Mid$(strResult, 1, 1)))
'W
.bln_Slave_timeout_error = (bytWZ And 1) > 0
.bln_Slave_low_level_error = (bytWZ And 2) > 0
.bln_Slave_ASIC_error = (bytWZ And 4) > 0
.bln_Slave_fatal_error = (bytWZ And 8) > 0
'Z
.bln_ADW_error = (bytWZ And 16) > 0
.bln_EEP_error = (bytWZ And 32) > 0
.bln_RAM_latched_error = (bytWZ And 64) > 0
.bln_Fatal_latched_error = (bytWZ And 128) > 0
'Y
.bln_EEP_write_error = (bytYX And 1) > 0
.bln_EEP_read_error = (bytYX And 2) > 0
.bln_RAM_CS_error = (bytYX And 4) > 0
.bln_Fatal_error = (bytYX And 8) > 0
'X
.bln_S_change_error = (bytYX And 16) > 0
.bln_S_short_error = (bytYX And 32) > 0
.bln_S_open_R_error = (bytYX And 64) > 0
.bln_S_open_V_error = (bytYX And 128) > 0
Debug.Print "-----------------------------------------------------------------------"
Debug.Print .strDisplayString
Debug.Print "-----------------------------------------------------------------------"
Debug.Print "'W"
Debug.Print .bln_Slave_timeout_error, "Slave_timeout_error"
Debug.Print .bln_Slave_low_level_error, "Slave_low_level_error"
Debug.Print .bln_Slave_ASIC_error, "Slave_ASIC_error"
Debug.Print .bln_Slave_fatal_error, "Slave_fatal_error"
Debug.Print "'Z (for ever latched errors)"
Debug.Print .bln_ADW_error, "ADW_error"
Debug.Print .bln_EEP_error, "EEP_error"
Debug.Print .bln_RAM_latched_error, "RAM_latched_error"
Debug.Print .bln_Fatal_latched_error, "Fatal_latched_error"
Debug.Print "'Y (ram/eeprom)"
Debug.Print .bln_EEP_write_error, "EEP_write_error"
Debug.Print .bln_EEP_read_error, "EEP_read_error"
Debug.Print .bln_RAM_CS_error, "RAM_CS_error"
Debug.Print .bln_Fatal_error, "Fatal_error"
Debug.Print "'X (sensor/ADW)"
Debug.Print .bln_S_change_error, "S_change_error"
Debug.Print .bln_S_short_error, "S_short_error"
Debug.Print .bln_S_open_R_error, "S_open_R_error"
Debug.Print .bln_S_open_V_error, "S_open_V_error"
Debug.Print "-----------------------------------------------------------------------"
End With
GetErrorStatus = 0
Else
GetErrorStatus = lngReturn
End If
ComPort_Close
End If
Exit Function
GetErrorStatus_Error:
GetErrorStatus = -99
End Function
'######################## NOWA Start/Stop #############################################################################
'
Public Function NOWA_START(ByVal intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
NOWA_START = NOWA_StartStop(intPortNr, True, lngIdentNoForVerification)
End Function
Public Function NOWA_STOP(ByVal intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
NOWA_STOP = NOWA_StartStop(intPortNr, False, lngIdentNoForVerification)
End Function
'Nur intern von den beiden vorhergehenden Funktionen verwendet
Private Function NOWA_StartStop(ByVal intPortNr As Integer, ByVal blnStart As Boolean, Optional lngIdentNoForVerification As Long = -1) As Long
Dim strSDaten As String
Dim strEDaten As String
Dim lngReturn As Long
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
NOWA_StartStop = lngReturn
Else
If blnStart Then
strSDaten = Chr$(&HF) & DLL2Hex("3F01")
Else
strSDaten = Chr$(&HF) & DLL2Hex("3F80")
End If
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
If lngReturn <> 0 Then
NOWA_StartStop = lngReturn
Else
'Senden hat geklappt -> Jetzt empfangene Daten auslesen
Dim strIdentNo As String
Dim strReserve As String
strReserve = ""
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = RequestData(strEDaten, strReserve)
If lngReturn <> 0 Then
NOWA_StartStop = -4
Else
NOWA_StartStop = 0
strEDaten = DLL2Hex(strEDaten)
If lngIdentNoForVerification <> -1 Then
If lngIdentNoForVerification < 0 Or lngIdentNoForVerification > 99999999 Then
NOWA_StartStop = -10
Exit Function
End If
strIdentNo = GetDecodedIdentOrFabNo(CByte(Asc(Mid$(strEDaten, 1, 1))), _
CByte(Asc(Mid$(strEDaten, 2, 1))), _
CByte(Asc(Mid$(strEDaten, 3, 1))), _
CByte(Asc(Mid$(strEDaten, 4, 1))))
If strIdentNo <> Format$(lngIdentNoForVerification, "00000000") Then
NOWA_StartStop = -20
Exit Function
End If
End If
End If
End If
End If
End Function
Private Function GetSpeicherAbbild(ByVal intPortNr As Integer, ByVal lngMemTyp As MEMORYTYPE_ENUM, ByVal lngStart As Long, ByVal lngLaenge As Long, ByRef strResult As String, ByVal blnOpenComPort As Boolean, ByVal blnCloseComPort As Boolean, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim lngAdress As Long
Dim lngRestCount As Long
Dim bytCount As Byte
Dim bytMaxCount As Byte
Dim strReturn As String
Dim strSingleResult As String
On Error GoTo GetSpeicherAbbild_Error
If (lngMemTyp < 0) Or (lngMemTyp > 3) Then
GetSpeicherAbbild = -10
Exit Function
End If
If (lngStart < 0) Or (lngStart >= &H100000) Then
GetSpeicherAbbild = -10
Exit Function
End If
If (lngLaenge <= 0) Or (lngLaenge > 255) Then
GetSpeicherAbbild = -10
Exit Function
End If
GetSpeicherAbbild = -99
If blnOpenComPort Then
lngReturn = ComPort_Open(intPortNr)
Else
lngReturn = 0
End If
If lngReturn <> 0 Then
GetSpeicherAbbild = lngReturn
Else
lngAdress = lngStart
lngRestCount = lngLaenge
strReturn = ""
If lngMemTyp = enuMaster__RAM Then
bytMaxCount = 4
ElseIf lngMemTyp = enuMasterEEPROM Then
bytMaxCount = 4
ElseIf lngMemTyp = enuSlave___RAM Then
bytMaxCount = 4
' blnReadFromBuffer = True Der Buffer begrenzt die Lesegröße !!!
ElseIf lngMemTyp = enuSlave_FLASH Then
bytMaxCount = 4
' blnReadFromBuffer = True Der Buffer begrenzt die Lesegröße !!!!
End If
Do While lngAdress < (lngStart + lngLaenge)
If lngRestCount > bytMaxCount Then
bytCount = bytMaxCount
Else
bytCount = lngRestCount
End If
strSingleResult = ""
lngReturn = MemoryRead(intPortNr, lngAdress, bytCount, lngMemTyp, strSingleResult, lngIdentNoForVerification)
If lngReturn <> 0 Then
Debug.Print "Wiederholung 1 !"
delaytime 50
lngReturn = MemoryRead(intPortNr, lngAdress, bytCount, lngMemTyp, strSingleResult, lngIdentNoForVerification)
If lngReturn <> 0 Then
Debug.Print "Wiederholung 2 !"
delaytime 50
lngReturn = MemoryRead(intPortNr, lngAdress, bytCount, lngMemTyp, strSingleResult, lngIdentNoForVerification)
End If
End If
If Len(strSingleResult) <> bytCount Then
Debug.Print "Fehler: Len(strSingleResult) <> bytCount !!! lngReturn = " & lngReturn
ComPort_Close
GetSpeicherAbbild = lngReturn
Exit Function
End If
strReturn = strReturn & strSingleResult
lngAdress = lngAdress + bytCount
lngRestCount = lngRestCount - bytCount
Loop
strResult = String2Hex(strReturn)
If blnCloseComPort Then
ComPort_Close
End If
End If
GetSpeicherAbbild = lngReturn
Exit Function
GetSpeicherAbbild_Error:
GetSpeicherAbbild = -70
End Function
'########################## FLP DiffTof #######################################################################################################
' Autor: Reinhard Henning, Lisocon, 25.03.2003
' die gerade gemessene Ultraschalllaufzeit in s ?
Public Function Get_FLP_DIffTof(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FLP_DIffTof = lngReturn
Else
lngReturn = GetValueFromSlaveRam(intPortNr, enuMem_Flp_DiffTof, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_FLP_DIffTof = 0
Else
dblResult = 0
Get_FLP_DIffTof = lngReturn
End If
End If
End Function
'########################## Zeroflow Temperatur #######################################################################################################
'gespeicherte Zeroflow Temperatur in °C
' Autor: Reinhard Henning, Lisocon, 26.03.2003
Public Function Get_FP_ZeroflowTemperature(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FP_ZeroflowTemperature = lngReturn
Else
lngReturn = GetValueFromMasterEEPROM(intPortNr, enuMem_FP_ZeroflowTemperature, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_FP_ZeroflowTemperature = 0
Else
dblResult = 0
Get_FP_ZeroflowTemperature = lngReturn
End If
End If
End Function
Public Function Set_FP_ZeroflowTemperature(ByVal intPortNr As Integer, ByVal dblDaten As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString As String
strFloatString = DEZ_To_FloatMSP430(dblDaten)
strDaten = HEXdrehen(DLL2Hex(strFloatString))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_FP_ZeroflowTemperature = lngReturn
Else
lngReturn = SetValueOnMasterEEPROM(intPortNr, enuMem_FP_ZeroflowTemperature, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
Set_FP_ZeroflowTemperature = lngReturn
End If
ComPort_Close
End If
End Function
Public Function Set_FP_ZeroflowDiffTof(ByVal intPortNr As Integer, ByVal dblDaten As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strDaten As String
Dim strFloatString As String
strFloatString = DEZ_To_FloatMSP430(dblDaten)
strDaten = HEXdrehen(DLL2Hex(strFloatString))
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_FP_ZeroflowDiffTof = lngReturn
Else
lngReturn = SetValueOnMasterEEPROM(intPortNr, enuMem_FP_ZeroflowDiffTof, strDaten, lngIdentNoForVerification)
If lngReturn <> 0 Then
Set_FP_ZeroflowDiffTof = lngReturn
End If
ComPort_Close
End If
End Function
Public Function Get_FP_Zeroflow_DiffTof(ByVal intPortNr As Integer, ByRef dblResult As Double, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_FP_Zeroflow_DiffTof = lngReturn
Else
lngReturn = GetValueFromMasterEEPROM(intPortNr, enuMem_FP_ZeroflowDiffTof, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
strResult = Left$(strResult, 4)
dblResult = RoundMantisse(FloatMSP430_To_DEZ(String2Hex(HEXdrehen(strResult))), MANTISSENGENAUIGKEIT)
Get_FP_Zeroflow_DiffTof = 0
Else
dblResult = 0
Get_FP_Zeroflow_DiffTof = lngReturn
End If
End If
End Function
Public Function Set_Info_Pruefung(ByVal intPortNr As Integer, ByVal intDaten As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
Dim strDaten As String
Dim lngReturn As Long
strDaten = Chr$(intDaten Mod 256) & Chr$(intDaten \ 256)
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Set_Info_Pruefung = lngReturn
Else
Set_Info_Pruefung = SetValueOnMasterEEPROM(intPortNr, enuMem_Info_Pruefung, strDaten, lngIdentNoForVerification)
ComPort_Close
End If
End Function
Public Function Get_Info_Pruefung(ByVal intPortNr As Integer, ByRef intResult As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strResult As String
Dim lngResult As Long
lngReturn = ComPort_Open(intPortNr)
If lngReturn <> 0 Then
Get_Info_Pruefung = lngReturn
Else
lngReturn = GetValueFromMasterEEPROM(intPortNr, enuMem_Info_Pruefung, strResult, lngIdentNoForVerification)
ComPort_Close
If lngReturn = 0 Then
lngResult = CLng(Asc(Left$(strResult, 1))) + CLng(Asc(Mid$(strResult, 2, 1))) * 256
If lngResult > 32767 Then
intResult = CLng(Asc(Left$(strResult, 1))) 'alter Zähler, der nur mit einem Byte arbeitet
Else
intResult = lngResult
End If
Get_Info_Pruefung = 0
Else
intResult = 0
Get_Info_Pruefung = lngReturn
End If
End If
End Function
'-------------------------------------------------------------------------
'Wird von MemoryRead und MemoryWrite verwendet sowie einigen Einzelfunktionen, die nicht Adressen beschreiben oder lesen
' - Übersetzt sozusagen einen VB-String in einen C-String
' - Nur von hier aus wird die DLL-Funktion "SendData" vervendet
Private Function SendDataWrapper(ByVal intPortNr As Integer, ByVal strSDaten As String, ByRef strEDaten As String) As Long
Dim udtSlavePara As SlavePara_Type
Dim lngLenSDaten As Long
Dim lngReturn As Long
Dim strReserve As String
Const CI_Feld As Long = &H51
SendDataWrapper = -99
If strSDaten = "" Then
strSDaten = String(1025, " ")
strSDaten = DLL2Hex(strSDaten) & Chr$(0)
Else
strSDaten = String2Hex(strSDaten) & Chr$(0)
End If
lngLenSDaten = Len(strSDaten)
strReserve = ""
udtSlavePara.A_Feld = CByte(SLAVEADDRESS)
udtSlavePara.C_Feld = CByte(&H5B) '<- REQ_UD2
udtSlavePara.CI_Feld = CByte(CI_Feld)
lngLenSDaten = Len(strSDaten)
SendDataWrapper = SendData(CI_Feld, strSDaten, lngLenSDaten, strEDaten, udtSlavePara, strReserve)
End Function
'##########################################################################################################################################################################################################################################################################
'Wird nur von den "GetValueFrom"-Funktionen aus verwendet !
Private Function MemoryRead(ByVal intPortNr As Integer, ByVal lngAdress As Long, ByVal bytCount As Byte, ByVal lngMemTyp As MEMORYTYPE_ENUM, ByRef strResult As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strSDaten As String
Dim strEDaten As String
Dim strReserve As String
Dim strReadCommand As String
Dim blnReadFromBuffer As Boolean
Dim strVergleich As String
'Mit ungeraden Adressen: Ungetestet !!! (Alle Werte, die bisher abzufragen sind, haben gerade Adressen)
Dim lngWordAdress As Long 'Es kann immer nur "Word"-weise ausgelesen werden -> Nur gerade Adressen sind zulässig
Dim bytReadCount As Byte
If isEven(lngAdress) Then
lngWordAdress = lngAdress
If isEven(bytCount) Then
bytReadCount = bytCount
Else
bytReadCount = bytCount + 1
End If
Else
lngWordAdress = lngAdress - 1
If isEven(bytCount) Then
bytReadCount = bytCount + 2 'Wenn Startadresse ungerade und Anzahl der Bytes gerade ist, dann müssen sogar 2 Bytes mehr ausgelesen werden
Else
bytReadCount = bytCount + 1
End If
End If
strResult = ""
MemoryRead = -99
If lngMemTyp = enuMaster__RAM Then
strReadCommand = "2F00"
blnReadFromBuffer = False
ElseIf lngMemTyp = enuMasterEEPROM Then
strReadCommand = "2F10"
blnReadFromBuffer = False
ElseIf lngMemTyp = enuSlave___RAM Then
strReadCommand = "1F08"
blnReadFromBuffer = True
ElseIf lngMemTyp = enuSlave_FLASH Then
strReadCommand = "1F0A"
blnReadFromBuffer = True
End If
'strSDaten = Chr$(&HF) & Chr$(&H2F) & Chr$(lngMemTyp)
strSDaten = Chr$(&HF) & DLL2Hex(strReadCommand)
strSDaten = strSDaten & Chr$(lngWordAdress And &HFF) & Chr$(((lngWordAdress And &HF00) / 256))
If blnReadFromBuffer Then
If bytCount > 4 Then
MemoryRead = -11
Exit Function
End If
strSDaten = strSDaten & Chr$(4) 'Es werden immer nur 4 Bytes kopiert
Else
strSDaten = strSDaten & Chr$(bytReadCount)
End If
strVergleich = strSDaten
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
If lngReturn <> 0 Then
If lngReturn = -2 Or lngReturn = -1 Then
MemoryRead = lngReturn
Else
MemoryRead = -3
End If
Else
If blnReadFromBuffer Then
'Beim Slave können Daten nur indirekt geslesen werden
'Nach dem vorherigen Senden stehen die Daten im Buffer des Master-RAM
'Dazu werden jetzt die Daten auf dem Master-RAM angefordert (2. mal Senden)
' delaytime 5 'Könnte sein, dass die 2. Anforderung ("LESEN") sonst zu früh kommt - Wert ist nur ein Versuch
strSDaten = Chr$(&HF) & DLL2Hex("2F00A603") & Chr$(bytCount)
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
If lngReturn <> 0 Then
MemoryRead = -5
Exit Function
End If
End If
'Senden hat geklappt -> Jetzt empfangene Daten auslesen
Dim strIdentNo As String
strReserve = ""
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = RequestData(strEDaten, strReserve)
If lngReturn <> 0 Then
MemoryRead = -4
Else
MemoryRead = 0
strEDaten = DLL2Hex(strEDaten)
If lngIdentNoForVerification <> -1 Then
If lngIdentNoForVerification < 0 Or lngIdentNoForVerification > 99999999 Then
MemoryRead = -10
Exit Function
End If
strIdentNo = GetDecodedIdentOrFabNo(CByte(Asc(Mid$(strEDaten, 1, 1))), _
CByte(Asc(Mid$(strEDaten, 2, 1))), _
CByte(Asc(Mid$(strEDaten, 3, 1))), _
CByte(Asc(Mid$(strEDaten, 4, 1))))
If strIdentNo <> Format$(lngIdentNoForVerification, "00000000") Then
MemoryRead = -20
Exit Function
End If
End If
'Die ersten 12 Bytes sind vom Data Header und werden jetzt nicht mehr gebraucht
strEDaten = Mid$(strEDaten, 1 + 12)
Dim l As Long
Debug.Print "MemoryRead bei Adresse &H" & Hex$(lngAdress) & " - " & bytCount & " Bytes" & " - MemTyp: " & lngMemTyp
For l = 1 To Len(strEDaten)
Debug.Print Format(Hex$(Asc(Mid(strEDaten, l, 1))), "@@@");
Next
Debug.Print ""
'Daten stehen an der 7. Stelle ! Die ersten 6 Bytes sind die gesendeten Daten, die wie ein Echo zurückkommen
If Not blnReadFromBuffer Then
If Mid$(strVergleich, 3, 4) <> Mid$(strEDaten, 3, 4) Then
For l = 1 To Len(strVergleich)
Debug.Print Format(Hex$(Asc(Mid(strVergleich, l, 1))), "@@@");
Next
Debug.Print "DIFFERENZ !!!"
End If
End If
strEDaten = Mid$(strEDaten, 1 + 6)
strEDaten = Left$(strEDaten, bytReadCount)
If bytReadCount > bytCount Then 'Es wurden mehr Bytes gelesen, als nötig
If bytReadCount = (bytCount + 1) Then '1 Byte mehr
If lngAdress = lngWordAdress Then
strEDaten = Left$(strEDaten, bytCount) 'Ein Byte am Ende zu viel
Else
strEDaten = Mid$(strEDaten, 2, bytCount) 'Ein Byte am Anfang zu viel
End If
Else '2 Bytes mehr (1 am Anfang und 1 am Ende zu viel)
strEDaten = Mid$(strEDaten, 2, bytCount)
End If
End If
strResult = strEDaten
End If
End If
End Function
'Wird nur von den "SetValueOn"-Funktionen aus verwendet !
Private Function MemoryWrite(ByVal intPortNr As Integer, ByVal lngAdress As Long, ByVal bytCount As Byte, ByVal lngMemTyp As MEMORYTYPE_ENUM, ByRef strDaten As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim lngReturn As Long
Dim strSDaten As String
Dim strEDaten As String
Dim strReserve As String
Dim strWriteCommand As String
MemoryWrite = -99
If lngMemTyp = enuMaster__RAM Then
strWriteCommand = "1F00"
ElseIf lngMemTyp = enuMasterEEPROM Then
strWriteCommand = "1F10"
ElseIf lngMemTyp = enuSlave___RAM Then
strWriteCommand = "1F09"
ElseIf lngMemTyp = enuSlave_FLASH Then
strWriteCommand = "1F0B"
End If
strSDaten = Chr$(&HF) & DLL2Hex(strWriteCommand)
strSDaten = strSDaten & Chr$(lngAdress And &HFF) & Chr$(((lngAdress And &HF00) / 256))
strSDaten = strSDaten & Chr$(bytCount)
strSDaten = strSDaten & Left$(strDaten, bytCount) 'Überlänge wegschneiden
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = SendDataWrapper(intPortNr, strSDaten, strEDaten)
If lngReturn <> 0 Then
If lngReturn = -2 Or lngReturn = -1 Then
MemoryWrite = lngReturn
Else
MemoryWrite = -3
End If
Else
'Senden hat geklappt -> Jetzt empfangene Daten auslesen
Dim strIdentNo As String
strReserve = ""
strEDaten = String(1024, " ") & Chr$(0)
lngReturn = RequestData(strEDaten, strReserve)
If lngReturn <> 0 Then
MemoryWrite = -4
Else
MemoryWrite = 0
strEDaten = DLL2Hex(strEDaten)
If lngIdentNoForVerification <> -1 Then
If lngIdentNoForVerification < 0 Or lngIdentNoForVerification > 99999999 Then
MemoryWrite = -10
Exit Function
End If
strIdentNo = GetDecodedIdentOrFabNo(CByte(Asc(Mid$(strEDaten, 1, 1))), _
CByte(Asc(Mid$(strEDaten, 2, 1))), _
CByte(Asc(Mid$(strEDaten, 3, 1))), _
CByte(Asc(Mid$(strEDaten, 4, 1))))
If strIdentNo <> Format$(lngIdentNoForVerification, "00000000") Then
MemoryWrite = -20
Exit Function
End If
End If
'Die ersten 12 Bytes sind vom Data Header und werden jetzt nicht mehr gebraucht
strEDaten = Mid$(strEDaten, 1 + 12)
Dim l As Long
Debug.Print "MemoryWrite bei Adresse &H" & Hex$(lngAdress) & " - " & bytCount & " Bytes" & " - MemTyp: " & lngMemTyp
For l = 1 To Len(strEDaten)
Debug.Print Format(Hex$(Asc(Mid(strEDaten, l, 1))), "@@@");
Next
Debug.Print ""
End If
End If
End Function
'############################ Speicheradressen lesen ####################################################################################################################################################################################################################################################
Private Function GetValueFromMasterRam(ByVal intPortNr As Integer, ByVal MemAdressAndSize As MEMORYMASTERRAMADRESSANDSIZE_ENUM, ByRef strResult As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim bytCount As Byte
Dim lngAdress As Long
lngAdress = MemAdressAndSize Mod &H1000000
bytCount = MemAdressAndSize \ &H1000000
GetValueFromMasterRam = MemoryRead(intPortNr, lngAdress, bytCount, enuMaster__RAM, strResult, lngIdentNoForVerification)
End Function
Private Function GetValueFromSlaveFlash(ByVal intPortNr As Integer, ByVal MemAdressAndSize As MEMORYSLAVEFLASHADRESSANDSIZE_ENUM, ByRef strResult As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim bytCount As Byte
Dim lngAdress As Long
lngAdress = MemAdressAndSize Mod &H1000000
bytCount = MemAdressAndSize \ &H1000000
GetValueFromSlaveFlash = MemoryRead(intPortNr, lngAdress, bytCount, enuSlave_FLASH, strResult, lngIdentNoForVerification)
End Function
Private Function GetValueFromSlaveRam(ByVal intPortNr As Integer, ByVal MemAdressAndSize As MEMORYSLAVERAMADRESSANDSIZE_ENUM, ByRef strResult As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim bytCount As Byte
Dim lngAdress As Long
lngAdress = MemAdressAndSize Mod &H1000000
bytCount = MemAdressAndSize \ &H1000000
GetValueFromSlaveRam = MemoryRead(intPortNr, lngAdress, bytCount, enuSlave___RAM, strResult, lngIdentNoForVerification)
End Function
Private Function GetValueFromMasterEEPROM(ByVal intPortNr As Integer, ByVal MemAdressAndSize As MEMORYMASTERRAMADRESSANDSIZE_ENUM, ByRef strResult As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim bytCount As Byte
Dim lngAdress As Long
lngAdress = MemAdressAndSize Mod &H1000000
bytCount = MemAdressAndSize \ &H1000000
GetValueFromMasterEEPROM = MemoryRead(intPortNr, lngAdress, bytCount, enuMasterEEPROM, strResult, lngIdentNoForVerification)
End Function
'############################ Speicheradressen beschreiben ##############################################################################################################################################################################################################################################
Private Function SetValueOnMasterRam(ByVal intPortNr As Integer, ByVal MemAdressAndSize As MEMORYMASTERRAMADRESSANDSIZE_ENUM, ByVal strDaten As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim bytCount As Byte
Dim lngAdress As Long
lngAdress = MemAdressAndSize Mod &H1000000
bytCount = MemAdressAndSize \ &H1000000
SetValueOnMasterRam = MemoryWrite(intPortNr, lngAdress, bytCount, enuMaster__RAM, strDaten, lngIdentNoForVerification)
End Function
Private Function SetValueOnSlaveRam(ByVal intPortNr As Integer, ByVal MemAdressAndSize As MEMORYSLAVERAMADRESSANDSIZE_ENUM, ByVal strDaten As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim bytCount As Byte
Dim lngAdress As Long
lngAdress = MemAdressAndSize Mod &H1000000
bytCount = MemAdressAndSize \ &H1000000
SetValueOnSlaveRam = MemoryWrite(intPortNr, lngAdress, bytCount, enuSlave___RAM, strDaten, lngIdentNoForVerification)
End Function
Private Function SetValueOnSlaveFlash(ByVal intPortNr As Integer, ByVal MemAdressAndSize As MEMORYSLAVEFLASHADRESSANDSIZE_ENUM, ByVal strDaten As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim bytCount As Byte
Dim lngAdress As Long
lngAdress = MemAdressAndSize Mod &H1000000
bytCount = MemAdressAndSize \ &H1000000
SetValueOnSlaveFlash = MemoryWrite(intPortNr, lngAdress, bytCount, enuSlave_FLASH, strDaten, lngIdentNoForVerification)
End Function
Private Function SetValueOnMasterEEPROM(ByVal intPortNr As Integer, ByVal MemAdressAndSize As MEMORYSLAVEFLASHADRESSANDSIZE_ENUM, ByVal strDaten As String, Optional lngIdentNoForVerification As Long = -1) As Long
Dim bytCount As Byte
Dim lngAdress As Long
lngAdress = MemAdressAndSize Mod &H1000000
bytCount = MemAdressAndSize \ &H1000000
SetValueOnMasterEEPROM = MemoryWrite(intPortNr, lngAdress, bytCount, enuMasterEEPROM, strDaten, lngIdentNoForVerification)
End Function
'################# PORT öffnen / schliessen sowie Schicht2 initialisieren#########################################################################################################################################################################################################################################################
'Comport in einem Rutsch inkl. Schicht initialisieren
Private Function ComPort_Open(ByVal intPortNr As Integer, Optional bytAnzahlWiderholungen As Byte = 2) As Long
Dim blnOpenPort As Boolean
If (mintOpenPortNr = 0) Then
'Kein Port ist geöffnet
blnOpenPort = True
Else
'Falscher Port ist geöffnet
If (mintOpenPortNr <> intPortNr) Then
ComPort_Close
blnOpenPort = True
Else
'Port mit der richtigen Nummer ist bereits geöffnet
blnOpenPort = False
End If
End If
ComPort_Open = 0
If blnOpenPort Then
If Not InitializePort(intPortNr) Then
ComPort_Open = -1
Else
mintOpenPortNr = intPortNr
If Not InitializeSchicht2(bytAnzahlWiderholungen) Then
ComPort_Open = -2
End If
End If
End If
End Function
'Comport (egal ob es klappt) schließen
Public Sub ComPort_Close()
If mintOpenPortNr = 0 Then Exit Sub
On Error Resume Next
Dim lngReturn As Long
Dim strReserve As String
lngReturn = CloseCom(strReserve)
mintOpenPortNr = 0
End Sub
'Übergabe an die DLL: Port-Initialisierung
Private Function InitializePort(ByVal intPortNr As Integer) As Boolean
Dim ComPara As COMPORT_TYPE
Dim lngReturn As Long
Dim strReserve As String
Dim Msg As String
ComPara.BAUDRATE = BAUDRATE
ComPara.ByteSize = 8
ComPara.Parity = 2 'Even
ComPara.StopBits = 0 ' 0= 1 Stopbit !
ComPara.COMport = intPortNr
lngReturn = InitCom(ComPara, strReserve)
If lngReturn = 0 Then
InitializePort = True
Else
Msg = "Fehler beim Öffnen von COM" & intPortNr & Chr$(13)
Select Case lngReturn
Case 1
Msg = Msg & "IECCOM.DLL-Error: ( OpenComm )"
Case 2
Msg = Msg & "IECCOM.DLL-Error: ( BuildCommDCB )"
Case 4
Msg = Msg & "IECCOM.DLL-Error: ( SetCommState )"
Case 8
Msg = Msg & "IECCOM.DLL-Error: ( COM bereits durch DLL initialisiert )"
Case Else
Msg = Msg & "IECCOM.DLL-Error: ( Fehler bisher nicht dokumentiert )"
End Select
'''MsgBox msg, 48, "Port Initialisierungsfehler"
InitializePort = False
End If
End Function
'Übergabe an die DLL: Schicht2-Initialisierung
Private Function InitializeSchicht2(ByVal bytAnzahlWiderholungen As Byte) As Boolean
Dim SCHICHT2_PARA As Schicht2_Para_Type
Dim lngReturn As Long
Dim strReserve As String
Dim Msg As String
SCHICHT2_PARA.AFeld = SLAVEADDRESS
SCHICHT2_PARA.Mode = SCHICHT2MODE ' 2 '+ BusDelay + ShowDebug + FCB_Flag
SCHICHT2_PARA.Timeout = 330 / BAUDRATE * 1000 + 50
'Gültige Werte für DLL: 0 - 9 (Defaultwert ist 2)
If bytAnzahlWiderholungen < 0 Then
bytAnzahlWiderholungen = 0
ElseIf bytAnzahlWiderholungen > 9 Then
bytAnzahlWiderholungen = 9
End If
strReserve = bytAnzahlWiderholungen
lngReturn = InitSchicht2(SCHICHT2_PARA, strReserve)
If lngReturn = 0 Then
InitializeSchicht2 = True
Else
Msg = "Fehler beim Initialisiern von Schicht 2"
'''MsgBox msg, 48, "Schicht2 - Initialisierungsfehler"
InitializeSchicht2 = False
End If
End Function
'############# ALLGEMEINE FUNKTION zur HEX/DEZ/String-Verarbeitung ####################
Private Function DLL2Hex(ByVal DLLString As String) As String
Dim lngNullPos As Long
Dim X As Long
Dim strHex As String
'Text endet bei ASCII 0 (C-Konvention bei Strings)
'VB würde sonst zu weit gehen
lngNullPos = InStr(1, DLLString, Chr$(0))
If lngNullPos > 0 Then DLLString = Left$(DLLString, lngNullPos - 1)
strHex = ""
For X = 1 To Len(DLLString) Step 2
strHex = strHex & Chr$(Hex2Dez(Mid$(DLLString, X, 2)))
Next
DLL2Hex = strHex
End Function
Private Function String2Hex(ByVal strString As String) As String
Dim l As Long
Dim strReturn As String
strReturn = ""
For l = 1 To Len(strString)
strReturn = strReturn & Right$("00" & Hex$(Asc(Mid$(strString, l, 1))), 2)
Next
String2Hex = strReturn
End Function
Private Function Hex2Dez(ByVal strHex As String) As Long
Hex2Dez = 0
strHex = Trim$(strHex)
If strHex = "" Then Exit Function
Hex2Dez = CLng("&H" & strHex)
End Function
Private Function GetDecodedIdentOrFabNo(ByVal byte1 As Byte, ByVal byte2 As Byte, ByVal byte3 As Byte, ByVal byte4 As Byte) As String
'Die IdentificationNr wird als 8-stelliger String mit führenden Nullen zurückgegeben
Dim strTemp As String
strTemp = ""
strTemp = strTemp & (byte4 \ 16) & (byte4 Mod 16)
strTemp = strTemp & (byte3 \ 16) & (byte3 Mod 16)
strTemp = strTemp & (byte2 \ 16) & (byte2 Mod 16)
strTemp = strTemp & (byte1 \ 16) & (byte1 Mod 16)
GetDecodedIdentOrFabNo = strTemp
End Function
Private Function GetManID(ByVal byte5 As Byte, byte6 As Byte) As String
Dim strTemp As String
strTemp = Chr$(byte5 Mod 32 + 64)
strTemp = Chr$((byte6 Mod 4) * 8 + (byte5 \ 32) + 64) & strTemp
strTemp = Chr$(byte6 \ 4 + 64) & strTemp
GetManID = strTemp
End Function
Private Function GetLongValueFrom4ByteString(ByVal str4Bytes As String) As Long
Dim bytByte As Byte
Dim strHex As String
Dim i As Integer
Dim strTemp As String
For i = 4 To 1 Step -1
bytByte = Asc(Mid$(str4Bytes, i, 1))
strHex = Hex$(bytByte)
If Len(strHex) = 1 Then
strTemp = strTemp & "0" & strHex
Else
strTemp = strTemp & strHex
End If
Next
GetLongValueFrom4ByteString = Val(strTemp)
End Function
'Ermittelt, ob der Wert gerade ist
Private Function isEven(ByVal lngValue As Long) As Boolean
isEven = ((lngValue Mod 2) = 0)
End Function
Private Function HEXdrehen(ByVal strString As String) As String
'Hi- und Lo-Byte werden Word-weise vertauscht
If (Len(strString) Mod 2) <> 0 Then Exit Function
Dim i As Integer
Dim strTemp As String
strTemp = ""
For i = 1 To Len(strString) - 1 Step 2
strTemp = strTemp & Mid$(strString, i + 1, 1) + Mid$(strString, i, 1)
Next
HEXdrehen = strTemp
End Function
Private Function MyRound(ByVal dblValue As Double, ByVal bytAnzahlStellen As Byte) As Double
'Seltsamerweise werden bei Round Werte auch dann abgerundet:
' Beispiele Round(3/2), clng(1.5) -> Beide Ergebnisse 2 -> OK
' Beispiele Round(5/2), clng(2.5) -> Beide Ergebnisse 2 -> Falsch
dblValue = dblValue * (10 ^ bytAnzahlStellen)
If dblValue >= 0 Then
dblValue = Fix(dblValue + 0.5)
Else
dblValue = Fix(dblValue - 0.5)
End If
dblValue = dblValue / (10 ^ bytAnzahlStellen)
MyRound = dblValue
End Function
Private Function RoundMantisse(ByVal dblValue As Double, ByVal bytAnzahlStellen As Byte) As Double
Dim lngExponent As Long
If dblValue = 0 Then
RoundMantisse = 0
Exit Function
End If
lngExponent = Int(Log(Abs(dblValue)) / Log(10))
dblValue = dblValue * (10 ^ -lngExponent)
dblValue = dblValue * (10 ^ bytAnzahlStellen)
If dblValue >= 0 Then
dblValue = Fix(dblValue + 0.5)
Else
dblValue = Fix(dblValue - 0.5)
End If
dblValue = dblValue / (10 ^ bytAnzahlStellen)
dblValue = dblValue / (10 ^ -lngExponent)
RoundMantisse = dblValue
End Function
Reference in New Issue View Git Blame Copy Permalink