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