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<75>ck, falls "nicht wiederholen" ausgew<65>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<64>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 <20>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<75>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<50>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 <20>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<75>nderung
|
||
objPAM.mStatus = PAM_inReg
|
||
readAllPams = readAllPams & Str(Adresse)
|
||
|
||
' die zugeh<65>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<73>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
|
||
|
||
|