797 lines
24 KiB
Plaintext
797 lines
24 KiB
Plaintext
VERSION 5.00
|
|
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.ocx"
|
|
Begin VB.Form frmSIRT
|
|
Caption = "SIRT Kommunikation"
|
|
ClientHeight = 4785
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 9405
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 4785
|
|
ScaleWidth = 9405
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin VB.CommandButton cmdCancel
|
|
Caption = "Abbruch"
|
|
Height = 315
|
|
Left = 3240
|
|
TabIndex = 2
|
|
Top = 240
|
|
Width = 1035
|
|
End
|
|
Begin VB.TextBox txtAdressen
|
|
Height = 3705
|
|
Left = 7560
|
|
MultiLine = -1 'True
|
|
TabIndex = 1
|
|
Top = 660
|
|
Width = 1785
|
|
End
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Align = 2 'Unten ausrichten
|
|
Height = 375
|
|
Left = 0
|
|
TabIndex = 0
|
|
Top = 4410
|
|
Width = 9405
|
|
_ExtentX = 16589
|
|
_ExtentY = 661
|
|
Style = 1
|
|
_Version = 393216
|
|
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
|
|
NumPanels = 1
|
|
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
|
|
EndProperty
|
|
EndProperty
|
|
End
|
|
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
|
|
Height = 3765
|
|
Left = 0
|
|
TabIndex = 3
|
|
Top = 660
|
|
Width = 7545
|
|
_ExtentX = 13309
|
|
_ExtentY = 6641
|
|
_Version = 393216
|
|
End
|
|
Begin VB.Label lblAutosize
|
|
BorderStyle = 1 'Fest Einfach
|
|
Caption = "lblAutosize"
|
|
Height = 315
|
|
Left = 7920
|
|
TabIndex = 12
|
|
Top = 180
|
|
Visible = 0 'False
|
|
Width = 1095
|
|
End
|
|
Begin VB.Label Label3
|
|
Caption = "SIRT Version"
|
|
Height = 285
|
|
Left = 30
|
|
TabIndex = 11
|
|
Top = 390
|
|
Width = 1485
|
|
End
|
|
Begin VB.Label lblSIRTVersion
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 315
|
|
Left = 1560
|
|
TabIndex = 10
|
|
Top = 360
|
|
Width = 765
|
|
End
|
|
Begin VB.Label lblDllversion
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 315
|
|
Left = 1560
|
|
TabIndex = 9
|
|
Top = 0
|
|
Width = 765
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "SIRT DLL Version"
|
|
Height = 285
|
|
Left = 0
|
|
TabIndex = 8
|
|
Top = 30
|
|
Width = 1485
|
|
End
|
|
Begin VB.Label lblTime
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 5130
|
|
TabIndex = 7
|
|
Top = 360
|
|
Width = 675
|
|
End
|
|
Begin VB.Label Label2
|
|
Caption = "Timeout"
|
|
Height = 285
|
|
Left = 4320
|
|
TabIndex = 6
|
|
Top = 360
|
|
Width = 735
|
|
End
|
|
Begin VB.Label Label4
|
|
Caption = "Wdh"
|
|
Height = 285
|
|
Left = 4350
|
|
TabIndex = 5
|
|
Top = 60
|
|
Width = 735
|
|
End
|
|
Begin VB.Label lblWdh
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 5130
|
|
TabIndex = 4
|
|
Top = 60
|
|
Width = 675
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmSIRT"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Private mSIRT As SIRTCOM.Wrapper
|
|
|
|
Public mdictPAMs As Dictionary
|
|
Public mMaxWdh As Integer
|
|
Public WdhCounter As Integer
|
|
Private m_blnCancel As Boolean
|
|
Public m_COMPort As Integer
|
|
|
|
Public Enum fgSpalte
|
|
spalte_Adresse = 0
|
|
spalte_Daten = 1
|
|
SPALTE_Status = 2
|
|
spalte_PAMStat = 3
|
|
spalte_bup = 4
|
|
spalte_Debug = 5
|
|
spalte_RSSI = 6
|
|
spalte_Wdh = 7
|
|
spalte_Time = 8
|
|
End Enum
|
|
|
|
Const SirtDllAck = 0
|
|
Const SirtErrorUsbBluetoothFailure = 1
|
|
Const SirtErrorDevnameAcccodeNomatch = 2
|
|
Const SirtErrorBupOrSemiStackempty = 3
|
|
Const SirtErrorBupOrSemiStackoverflow = 4 '// no way to report that to application
|
|
Const SirtErrorNomoreSemiInstack = 5
|
|
Const SirtErrorPamStackFull = 6
|
|
Const SirtErrorPamStackEmpty = 7 ' // no way/need to report that to application
|
|
Const SirtErrorCrcFailure = 8
|
|
Const SirtErrorTimeout = 9
|
|
Const SirtErrorNotOpen = 10
|
|
Const SirtErrorAlreadyOpen = 11
|
|
Const SirtErrorWriteFailed = 12
|
|
Const SirtErrorReadError = 13
|
|
Const SirtErrorOutofmemory = 14
|
|
Const SirtErrorResponseBuffer = 15
|
|
|
|
|
|
|
|
'' Wartet auf alle SEMIS und wiederholt den PAM Befehl bei einem Timeout oder PAMstatus<>0
|
|
'' Nach 3 Wiederholungen wird nachgefragt
|
|
'' gibt den Erfolg als true oder false zurück, falls "nicht wiederholen" ausgewählt wird
|
|
'Public Function WarteAufAlleSEMIs() As Boolean
|
|
' Dim WdhCounter As Integer
|
|
' Dim ret As Long
|
|
' Dim varAdresse As Variant
|
|
' Dim varKey As Variant
|
|
' Dim objPAM As clsPAM
|
|
'
|
|
' WdhCounter = 0
|
|
'wdh:
|
|
' Me.lblWdh.Caption = WdhCounter
|
|
' If WarteAufSEMIs() = False Then
|
|
' ' nicht alle sind mit korrekter (!) SEMI empfangen worden
|
|
' If m_blnCancel Then
|
|
' 'Abbruch taste wurde gedrückt ohne dass alle SEMIs empfangen wurden
|
|
' WarteAufAlleSEMIs = False
|
|
' Exit Function
|
|
' End If
|
|
'
|
|
' If WdhCounter < 3 Then
|
|
' WdhCounter = WdhCounter + 1
|
|
' lblWdh.Caption = WdhCounter
|
|
' ret = vbYes
|
|
' ' Wiederholen
|
|
' Else
|
|
' ' erst beim vierten Mal fragen
|
|
' ret = MsgBox("Nicht alle PAMS wurden mit einer korrekten SEMI beantwortet! Möchten Sie die fehlgeschlagenen PAMs wiederholen?", vbYesNo Or vbDefaultButton2)
|
|
' End If
|
|
'
|
|
' If ret = vbYes Then
|
|
' ' wiederhole PAM senden
|
|
' For Each varKey In mdictPAMs.Keys
|
|
' Set objPAM = mdictPAMs.Item(varKey)
|
|
' If objPAM.mStatus <> SEMI_received_OK Then ' auch bei SEMI mit fehlerhaften PAMStatus wiederholen! Denke trotzdem das ist nicht nötig
|
|
' 'If objPam.mStatus <> SEMI_received_OK And objPam.mStatus <> SEMI_received_Error Then ' nur bei
|
|
' ' fehlgeschlagene PAM noch mal senden
|
|
' objPAM.ReSend
|
|
' End If
|
|
' Next
|
|
' ' und wieder warten
|
|
' GoTo wdh
|
|
' Else
|
|
' WarteAufAlleSEMIs = False
|
|
' End If
|
|
' Else
|
|
' WarteAufAlleSEMIs = True
|
|
' End If
|
|
'End Function
|
|
'
|
|
'Public Function Sende_PAMs_an_Adressen_und_warteAufSemis(strAdressen As String, strBeschreibung As String, strHexDaten As String, P81_1 As Byte) As Boolean
|
|
' Dim varAdresse As Variant
|
|
' Dim varKey As Variant
|
|
' Dim objPAM As clsPAM
|
|
' Dim ret As Long
|
|
' Dim P12 As Byte
|
|
'
|
|
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' ' alle Register leeren
|
|
' Call PAM_RegisterLeeren
|
|
'
|
|
' Me.Caption = strBeschreibung
|
|
'
|
|
' For Each varAdresse In Split(strAdressen, " ")
|
|
' SIRT_SendePam CCur(varAdresse), strHexDaten, P81_1, CStr(varAdresse), P12
|
|
' Next
|
|
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
' Sende_PAMs_an_Adressen_und_warteAufSemis = WarteAufAlleSEMIs()
|
|
'
|
|
'End Function
|
|
'
|
|
|
|
|
|
|
|
' Return=True: Initialisierung des SIRTS war erfolgreich
|
|
Public Function Initialize_SIRT() As Boolean
|
|
Dim WdhCounter As Integer
|
|
Dim strTemp As String
|
|
Dim ret As Long
|
|
Set mdictPAMs = New Dictionary
|
|
Set mSIRT = New SIRTCOM.Wrapper
|
|
|
|
Do
|
|
ret = SIRT_Open()
|
|
ret = ret And 2 ^ 15 - 1
|
|
Select Case ret
|
|
Case SirtDllAck
|
|
Initialize_SIRT = True
|
|
Debug.Print "OK"
|
|
Case SirtErrorAlreadyOpen
|
|
Debug.Print "open fehler SirtErrorAlreadyOpen"
|
|
Call SIRT_Close
|
|
Case SirtErrorDevnameAcccodeNomatch
|
|
Debug.Print "open fehler SirtErrorDevnameAcccodeNomatch"
|
|
ret = MsgBox("Fehler " & ret & " beim Öffnen des SIRTs '" & mSIRT.GetLastErrorMessage & "'. Bitte schliessen Sie den SIRT per USB an!", vbOKCancel Or vbDefaultButton1)
|
|
If ret = vbCancel Then
|
|
End
|
|
End If
|
|
Case Else
|
|
Debug.Print "Fehler " & mSIRT.GetLastErrocode & " = " & mSIRT.GetLastErrorMessage
|
|
End Select
|
|
Loop While ret <> SirtDllAck And WdhCounter < 3
|
|
If ret <> SirtDllAck Then
|
|
Initialize_SIRT = False
|
|
Exit Function
|
|
End If
|
|
|
|
ret = SIRT_GetDLLVersion(strTemp)
|
|
If ret = 0 Then
|
|
lblDllversion.Caption = strTemp
|
|
Else
|
|
MsgBox "Fehler " & ret & " beim Initialiseren der DLL: " & strTemp & vbCrLf & "Lösung: Die fehlende DLL sollte in das C:\Windows\ Verzeichniss kopiert werden."
|
|
Initialize_SIRT = False
|
|
Exit Function
|
|
End If
|
|
|
|
lblSIRTVersion.Caption = mSIRT.GetSirtVersion()
|
|
|
|
ret = SIRT_Activate()
|
|
Select Case ret
|
|
Case SirtDllAck
|
|
Initialize_SIRT = True
|
|
Case Else
|
|
MsgBox "Fehler " & ret & " durch SIRT_Activate: " & mSIRT.GetLastErrorMessage
|
|
Initialize_SIRT = False
|
|
End Select
|
|
|
|
End Function
|
|
|
|
Public Function SIRT_SendePam(Adresse As Currency, strData As String, P81_1 As Byte, strZieladresse As String, ByRef P12 As Byte)
|
|
Dim ret As Long
|
|
Dim objPAM As clsPAM
|
|
|
|
If mdictPAMs.Exists(CStr(Adresse)) Then
|
|
' PAM mit dieser Adresse esitiert in mdictPAM
|
|
Set objPAM = mdictPAMs.Item(CStr(Adresse))
|
|
MSFlexGrid1.row = objPAM.mZeile
|
|
Else
|
|
Set objPAM = New clsPAM
|
|
objPAM.mstrAdresse = Adresse
|
|
mdictPAMs.Add CStr(Adresse), objPAM
|
|
MSFlexGrid1.AddItem CStr(Adresse)
|
|
MSFlexGrid1.row = MSFlexGrid1.Rows - 1
|
|
objPAM.mZeile = MSFlexGrid1.row
|
|
End If
|
|
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, spalte_Daten) = strData
|
|
|
|
ret = objPAM.send(mSIRT, CStr(Adresse), strData, P81_1, P12)
|
|
objPAM.mstrZieladresse = strZieladresse
|
|
|
|
If ret <> SirtDllAck Then
|
|
MsgBox "Fehler in SIRT_SendePam bei Pam.Send: Returnwert=" & ret & " = " & mSIRT.GetLastErrorMessage
|
|
End If
|
|
|
|
MSFlexGrid1.TextMatrix(objPAM.mZeile, SPALTE_Status) = objPAM.GetStatusText
|
|
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
|
End Function
|
|
|
|
|
|
Public Function SIRT_Open() As Long
|
|
Dim ret As Long
|
|
Dim P12 As Byte
|
|
Dim comport As Byte
|
|
Dim ctrl00 As Byte
|
|
|
|
comport = m_COMPort
|
|
|
|
ctrl00 = 0
|
|
ctrl00 = ctrl00 Or 0 * 2 ^ 0 'dataBtOut 0=USB
|
|
ctrl00 = ctrl00 Or 0 * 2 ^ 1 'bothChsOut
|
|
ctrl00 = ctrl00 Or 0 * 2 ^ 6 'sirtPwrSave
|
|
ctrl00 = ctrl00 Or 0 * 2 ^ 7 'sirtOff
|
|
|
|
SIRT_Open = mSIRT.SIRT_Open(comport, ctrl00, 1000, P12)
|
|
End Function
|
|
|
|
|
|
Public Function SIRT_GetDLLVersion(ByRef Version As String) As Long
|
|
On Error GoTo Errorhandler
|
|
Version = mSIRT.GetDLLVersion()
|
|
Exit Function
|
|
Errorhandler:
|
|
SIRT_GetDLLVersion = Err.Number
|
|
Version = Err.Description
|
|
End Function
|
|
|
|
|
|
Public Function SIRT_Close() As Long
|
|
Dim ret As Integer
|
|
Dim P12 As Byte
|
|
|
|
SIRT_Close = mSIRT.ClosePort(P12)
|
|
|
|
Debug.Print "SIRT_Close: ret= " & ret
|
|
Debug.Print "P12 = " & P12
|
|
|
|
End Function
|
|
|
|
Private Function SIRT_Activate() As Long
|
|
Dim ret As Integer
|
|
Dim WdhCounter As Integer
|
|
|
|
Dim P12_01 As Byte
|
|
Dim P12_02 As Byte
|
|
|
|
Dim Module1 As Byte
|
|
Dim module2 As Byte
|
|
|
|
Module1 = 1 ' use SensusRF radio settings, internal Antenna
|
|
module2 = 1 ' use SensusRF radio settings, internal Antenna
|
|
|
|
wdh:
|
|
ret = mSIRT.ActivateSirt(1, 1, 60, P12_01, P12_02) ' 60 Minuten SIRT auf Empfang
|
|
|
|
If ret <> SirtDllAck Then
|
|
If WdhCounter < 3 Then
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo wdh
|
|
End If
|
|
MsgBox "Fehler " & mSIRT.GetLastErrocode & " bei ActivateSirt: " & mSIRT.GetLastErrorMessage
|
|
SIRT_Activate = False
|
|
Else
|
|
Debug.Print "ActivateSirt SirtReponse2Bytes: P12_01=" & Hex(P12_01) & " P12_02=" & Hex(P12_02)
|
|
SIRT_Activate = ret
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
' Wartet eine bestimmte Zeit auf die SEMIs, gibt bei einem Timeout false zurück
|
|
Public Function WarteAufSEMIs() As Boolean
|
|
Dim objPAM As clsPAM
|
|
Dim varKey As Variant
|
|
Dim blnFertig As Boolean
|
|
Dim Zeile As Integer
|
|
Dim lngStartzeit_ms As Long
|
|
Dim lngVerbleibende_ms As Long
|
|
Const TIMEOUT_MS = 60000
|
|
|
|
ResetCancel
|
|
|
|
lngStartzeit_ms = GetTickCount()
|
|
|
|
Do
|
|
|
|
lngVerbleibende_ms = TIMEOUT_MS - (GetTickCount() - lngStartzeit_ms)
|
|
lblTime.Caption = Round(lngVerbleibende_ms / 1000)
|
|
|
|
Call readAllPams 'AM Register verarbeiten
|
|
Call getRecs ' alle BUPs/SEMIs/DEBUGs verarbeiten
|
|
|
|
SleepWithEvents 500, True
|
|
blnFertig = True
|
|
|
|
Zeile = 0
|
|
For Each varKey In mdictPAMs.Keys
|
|
Zeile = Zeile + 1
|
|
Set objPAM = mdictPAMs.Item(varKey)
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Adresse) = objPAM.mstrAdresse
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Daten) = objPAM.mstrBefehl
|
|
MSFlexGrid1.TextMatrix(Zeile, SPALTE_Status) = objPAM.GetStatusText
|
|
|
|
If objPAM.mcntSEMI_empfangen > 0 Then
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_PAMStat) = objPAM.m_SEMI.PAM_status
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Time) = objPAM.mlngSEMI_time
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Wdh) = objPAM.mlngWdh
|
|
End If
|
|
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_bup) = objPAM.mcntBUP_empfangen
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Debug) = objPAM.mcntDEBUG_empfangen
|
|
|
|
If Not objPAM.m_BUP Is Nothing Then
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_RSSI) = objPAM.m_BUP.RSSI
|
|
End If
|
|
|
|
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
|
|
|
Select Case objPAM.mStatus
|
|
Case PAM_inReg, PAM_Send, PAM_wait
|
|
blnFertig = False
|
|
End Select
|
|
Next
|
|
Loop While blnFertig = False And lngVerbleibende_ms >= 0 And m_blnCancel = False
|
|
|
|
'Call readAllPams 'AM Register verarbeiten
|
|
|
|
' wenn alle SEMIs empfangen worden sind => true
|
|
WarteAufSEMIs = blnFertig
|
|
|
|
' Prüfen, ob eine SEMI fehlt oder fehlerhaft ist
|
|
For Each varKey In mdictPAMs.Keys
|
|
Set objPAM = mdictPAMs.Item(varKey)
|
|
If Not objPAM.m_SEMI Is Nothing Then
|
|
If objPAM.m_SEMI.PAM_status <> 0 Then
|
|
' SEMI fehlgeschlagen mit PAMStatus <> 0
|
|
WarteAufSEMIs = False
|
|
Debug.Print "Fehler: PAM-Status = " & objPAM.m_SEMI.getPamStatusText
|
|
End If
|
|
' Semi empfangen
|
|
Else
|
|
' keine Semi empfangen
|
|
WarteAufSEMIs = False
|
|
End If
|
|
Next
|
|
|
|
End Function
|
|
|
|
Private Function readAllPams() As String
|
|
Dim ret As Integer
|
|
Dim ResponseBuffer() As Byte
|
|
Dim ResponseBuffer2() As Byte
|
|
|
|
Dim P12_01 As Byte
|
|
|
|
Dim objPAM As clsPAM
|
|
|
|
Dim Adresse As Currency
|
|
Dim strAdressen As String
|
|
Dim WdhCounter As Integer
|
|
Dim i As Integer
|
|
|
|
Const P81_1 = 16
|
|
|
|
WdhCounter = 0
|
|
wdh:
|
|
ret = mSIRT.ReadPamReg(P81_1, 0, "4294967295", P12_01, ResponseBuffer) ' Dummy Adresse FFFFFF
|
|
Debug.Print "ReadPam FFFFFF P81_1=" & P81_1 & "P12_01= " & P12_01
|
|
|
|
Select Case ret
|
|
Case SirtDllAck
|
|
'OK
|
|
Case SirtErrorTimeout
|
|
WdhCounter = WdhCounter + 1
|
|
If WdhCounter <= 3 Then
|
|
Debug.Print "Timeout: ReadPamReg wird wiederholt (" & WdhCounter & ")" & vbCrLf & "Bitte SIRT USB einstecken!"
|
|
GoTo wdh
|
|
Else
|
|
MsgBox "3 * Timeout in ReadPamReg: " & mSIRT.GetLastErrorMessage
|
|
SIRT_Close
|
|
SIRT_Open
|
|
' Hier stimmt etwas nicht. USB Stecker war gezogen?
|
|
Exit Function
|
|
End If
|
|
Case Else
|
|
MsgBox "Fehler in ReadPamReg: " & mSIRT.GetLastErrocode & vbCrLf & mSIRT.GetLastErrorMessage & vbCrLf & "Bitte SIRT USB einstecken!"
|
|
SIRT_Close
|
|
SIRT_Open
|
|
Exit Function
|
|
End Select
|
|
|
|
' Dim strBufferHex As String
|
|
' strBufferHex = ""
|
|
' For i = LBound(ResponseBuffer) To UBound(ResponseBuffer)
|
|
' strBufferHex = strBufferHex & Hex2(ResponseBuffer(i)) & " "
|
|
' Next
|
|
' Debug.Print strBufferHex
|
|
|
|
' PAM Status ändern
|
|
For i = 1 To 17 Step 4
|
|
Adresse = NumberFromByteArray(ResponseBuffer, i, i + 3)
|
|
If Adresse <> 4294967295# Then
|
|
' PAM ist im PAMRegister
|
|
If mdictPAMs.Exists(CStr(Adresse)) Then
|
|
Set objPAM = mdictPAMs.Item(CStr(Adresse))
|
|
' Statusänderung
|
|
objPAM.mStatus = PAM_inReg
|
|
readAllPams = readAllPams & Str(Adresse)
|
|
|
|
' die zugehörige PAM explizit lesen
|
|
ret = mSIRT.ReadPamReg(P81_1, 0, Adresse, P12_01, ResponseBuffer2)
|
|
Debug.Print "ReadPam " & Adresse & " P81_1=" & P81_1 & ", P12_01=" & P12_01
|
|
Else
|
|
Debug.Print "ReadAllPams: PAM mit dem Key " & Adresse & " 0x" & Currency2Hex(Adresse) & " ist zwar im PamReg, existiert aber nicht in der PAM Auflistung."
|
|
End If
|
|
End If
|
|
'If P12_01 <> 128 Then Stop
|
|
Next
|
|
|
|
End Function
|
|
|
|
|
|
Public Sub getRecs()
|
|
Dim byteRecParam As Byte
|
|
Dim ret As Integer
|
|
Dim ResponseBuffer() As Byte
|
|
Dim Adresse As Currency
|
|
Dim strHexout As String
|
|
Dim i As Integer
|
|
Dim P12_01 As Byte
|
|
|
|
''''''''''''''''''''''''''''''''
|
|
' REC_Parameter
|
|
''''''''''''''''''''''''''''''''
|
|
'byteRecParam = 0 ' = youngest received BUP or SEMI
|
|
'byteRecParam = 1 ' = oldest received BUP or SEMI
|
|
'byteRecParam = 2 ' = youngest received SEMI
|
|
'byteRecParam = 3 ' = oldest received SEMI
|
|
'byteRecParam = 4 ' = delete all SEMI from stack and return without a result (only DLL_ACK)
|
|
|
|
'Debug.Print "---getRecs----"
|
|
ret = SirtDllAck
|
|
byteRecParam = 1
|
|
|
|
Do While ret = SirtDllAck
|
|
|
|
wdh:
|
|
ret = mSIRT.GetRec(byteRecParam, ResponseBuffer, P12_01)
|
|
Adresse = NumberFromByteArray(ResponseBuffer, 3, 6)
|
|
|
|
|
|
If ResponseBuffer(0) = 0 Then
|
|
Exit Sub
|
|
End If
|
|
|
|
Select Case ret
|
|
Case SirtErrorNotOpen
|
|
' not open
|
|
Case SirtDllAck
|
|
' alles OK
|
|
Case SirtErrorBupOrSemiStackempty, SirtErrorNomoreSemiInstack
|
|
'Debug.Print mySIRT.MakeErrorMessage(ret)
|
|
' keine weiteren SEMI or BUPS
|
|
Case Else
|
|
End Select
|
|
|
|
DatenEmpfangen ResponseBuffer
|
|
|
|
Loop
|
|
End Sub
|
|
|
|
Private Sub DatenEmpfangen(receivedBytes() As Byte)
|
|
' setzt die Eigenschaften im richtigen PAM objekt
|
|
' wird bei jeder BUP DEBUG und SEMI aufgerufen
|
|
Dim Adresse As Currency
|
|
Dim objPAM As clsPAM
|
|
Dim varKey As Variant
|
|
Dim bRssi As Byte
|
|
|
|
' Adresse vom Datenpaket
|
|
|
|
Adresse = NumberFromByteArray(receivedBytes, 3, 6)
|
|
'Debug.Print Adresse
|
|
|
|
If InStr(1, txtAdressen.text, "|" & CStr(Adresse) & "|") = 0 Then
|
|
bRssi = NumberFromByteArray(receivedBytes, 2, 2)
|
|
txtAdressen.text = txtAdressen.text & "|" & CStr(Adresse) & "|" & " (" & bRssi & ")" & vbCrLf
|
|
End If
|
|
|
|
For Each varKey In mdictPAMs.Keys
|
|
' für alle PAMs
|
|
Set objPAM = mdictPAMs.Item(varKey)
|
|
If CStr(varKey) = CStr(Adresse) Or objPAM.mstrZieladresse = CStr(Adresse) Then
|
|
objPAM.DatenEmpfangen receivedBytes, WdhCounter
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Public Function PAM_RegisterLeeren() As Boolean
|
|
Dim objPAM As clsPAM
|
|
Dim ret As Long
|
|
Dim intResendCounter As Integer
|
|
Dim ResponseBuffer() As Byte
|
|
Dim P12_01 As Byte
|
|
|
|
' SEMIs löschen
|
|
''''////////ret = mSIRT.WritePam(4, ResponseBuffer, P12_01)
|
|
|
|
' lokalen PAM Speicher leeren
|
|
Set objPAM = Nothing
|
|
mdictPAMs.RemoveAll
|
|
|
|
MSFlexGrid1.Rows = 1
|
|
|
|
' PAM Register im SIRT leeren
|
|
Set objPAM = New clsPAM
|
|
|
|
wdhLeeren:
|
|
|
|
ret = objPAM.send(mSIRT, "000000", "00", 128, 0)
|
|
' Senden ggf 3 mal wiederholen
|
|
If ret <> SirtDllAck Then
|
|
Debug.Print "Pam-Register leeren fehlgeschlagen mit Returncode=" & ret & "=" & mSIRT.GetLastErrorMessage
|
|
If intResendCounter < 3 Then
|
|
intResendCounter = intResendCounter + 1
|
|
GoTo wdhLeeren
|
|
End If
|
|
|
|
ret = MsgBox("Fehler beim wiederholten Leeren der PAM-Queue: Returnwert=" & ret & "=" & mSIRT.GetLastErrorMessage & ". Möchten Sie das Senden wiederholen?", vbYesNo)
|
|
If ret = vbYes Then
|
|
GoTo wdhLeeren
|
|
Else
|
|
PAM_RegisterLeeren = False
|
|
Exit Function
|
|
End If
|
|
Else
|
|
PAM_RegisterLeeren = True
|
|
End If
|
|
End Function
|
|
|
|
|
|
Private Sub ResetCancel()
|
|
m_blnCancel = False
|
|
cmdCancel.Enabled = True
|
|
End Sub
|
|
|
|
Private Sub cmdCancel_Click()
|
|
m_blnCancel = True
|
|
cmdCancel.Enabled = False
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
Private Sub Form_Load()
|
|
On Error GoTo Errorhandler
|
|
Debug.Print "#######################"
|
|
MSFlexGrid1.FormatString = "Adresse|Data|Status|PAM Status|BUPs|DEBUGs|RSSI|Wdh|Time"
|
|
MSFlexGrid1.Rows = 1
|
|
|
|
Set mdictPAMs = New Dictionary
|
|
|
|
|
|
Exit Sub
|
|
Errorhandler:
|
|
MsgBox "Fehler " & Err.Number & " beim Instanzieren von SIRTCOM.Wrapper: " & Err.Description
|
|
End
|
|
End Sub
|
|
|
|
Private Sub Form_Resize()
|
|
MSFlexGrid1.Left = 0
|
|
MSFlexGrid1.Width = Me.ScaleWidth - txtAdressen.Width
|
|
MSFlexGrid1.Height = Me.ScaleHeight - MSFlexGrid1.Top - StatusBar1.Height
|
|
|
|
txtAdressen.Left = Me.ScaleWidth - txtAdressen.Width
|
|
txtAdressen.Top = MSFlexGrid1.Top
|
|
txtAdressen.Height = MSFlexGrid1.Height
|
|
txtAdressen.Width = Me.ScaleWidth - txtAdressen.Left
|
|
End Sub
|
|
|
|
Private Function SetzeNeueAdresse(strAlteAdressen As String, strNeueAdressen As String) As Boolean
|
|
|
|
End Function
|
|
|
|
|
|
Public Function WarteAufBUPsmitNeuerAdresse() As Boolean
|
|
Dim objPAM As clsPAM
|
|
Dim varKey As Variant
|
|
Dim blnFertig As Boolean
|
|
Dim Zeile As Integer
|
|
Dim lngStartzeit_ms As Long
|
|
Dim lngVerbleibende_ms As Long
|
|
|
|
Const TIMEOUT_MS = 60000
|
|
ResetCancel
|
|
|
|
lngStartzeit_ms = GetTickCount()
|
|
|
|
Do
|
|
lngVerbleibende_ms = TIMEOUT_MS - (GetTickCount() - lngStartzeit_ms)
|
|
lblTime.Caption = Round(lngVerbleibende_ms / 1000)
|
|
|
|
Call getRecs ' alle BUPs/SEMIs/DEBUGs verarbeiten
|
|
Call readAllPams ' PAM Register auswerten für Status "in PAM Register"
|
|
|
|
SleepWithEvents 500, True
|
|
blnFertig = True
|
|
|
|
Zeile = 0
|
|
For Each varKey In mdictPAMs.Keys
|
|
Zeile = Zeile + 1
|
|
Set objPAM = mdictPAMs.Item(varKey)
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Adresse) = objPAM.mstrAdresse
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Daten) = objPAM.mstrBefehl
|
|
MSFlexGrid1.TextMatrix(Zeile, SPALTE_Status) = objPAM.GetStatusText
|
|
|
|
If objPAM.mcntBUP_empfangen > 0 Then
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Time) = objPAM.mlngSEMI_time
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Wdh) = objPAM.mlngWdh
|
|
End If
|
|
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_bup) = objPAM.mcntBUP_empfangen
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_Debug) = objPAM.mcntDEBUG_empfangen
|
|
|
|
If Not objPAM.m_BUP Is Nothing Then
|
|
' Feldstärke aus BUP lesen
|
|
MSFlexGrid1.TextMatrix(Zeile, spalte_RSSI) = objPAM.m_BUP.RSSI
|
|
End If
|
|
|
|
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
|
|
|
Select Case objPAM.mStatus
|
|
Case PAM_inReg, PAM_Send
|
|
blnFertig = False
|
|
End Select
|
|
Next
|
|
Loop While blnFertig = False And lngVerbleibende_ms >= 0 And m_blnCancel = False
|
|
|
|
' wenn alle BUPs empfangen worden sind => true
|
|
WarteAufBUPsmitNeuerAdresse = blnFertig
|
|
For Each varKey In mdictPAMs.Keys
|
|
Set objPAM = mdictPAMs.Item(varKey)
|
|
If Not objPAM.m_BUP Is Nothing Then
|
|
' BUP empfangen
|
|
WarteAufBUPsmitNeuerAdresse = False
|
|
End If
|
|
Next
|
|
End Function
|
|
|
|
Private Sub Form_Unload(Cancel As Integer)
|
|
On Error Resume Next
|
|
Call SIRT_Close
|
|
End Sub
|
|
|
|
|