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