laatzen/Pruef2000/source/clsPAM.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPAM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public mstrAdresse As String
Public mstrBefehl As String

' für ReSend
Public mbyteP81_1 As Byte
Public mbyteP81_2 As Byte
Public mbyteP12 As Byte

Public mSIRT As SIRTCOM.Wrapper

' für Adresse ändern
Public mstrZieladresse As String  ' zum Adressen ändern

Public m_BUP As clsBUP
Public m_Debug As clsDEBUG
Public m_SEMI As clsSEMI

Public m_lngTimestampSenden As Long
Public mZeile As Integer

Public mStatus As PAMSTATUS
Public mlngSEMI_time As Long
Public mlngWdh As Integer

Public mcntSEMI_empfangen As Long
Public mcntBUP_empfangen As Long
Public mcntDEBUG_empfangen As Long

Public Enum PAMSTATUS
   PAM_Send = 1
   PAM_wait = 2
   PAM_inReg = 3
   SEMI_received_Error = 4
   SEMI_received_OK = 5
   PAM_Resend = 6
End Enum


Public Function GetStatusText() As String
   Select Case mStatus
      Case PAMSTATUS.PAM_Send
         GetStatusText = "send"
      Case PAMSTATUS.PAM_inReg
         GetStatusText = "inReg"
      Case PAMSTATUS.PAM_wait
         GetStatusText = "wait"
      Case PAMSTATUS.SEMI_received_Error
         GetStatusText = "err"
      Case PAMSTATUS.SEMI_received_OK
         GetStatusText = "SEMI OK "
      Case PAMSTATUS.PAM_Resend
         GetStatusText = "resend"
   End Select
End Function

Public Function ReSend() As Boolean
   If mSIRT Is Nothing Then Exit Function
   ReSend = send(mSIRT, mstrAdresse, mstrBefehl, mbyteP81_1, mbyteP81_2)
   mStatus = PAM_Resend
End Function

Public Function send(mySIRT As SIRTCOM.Wrapper, strAdresse As String, strBefehl As String, P81_1 As Byte, P81_2 As Byte) As Long
   Dim ret As Long
   Dim P12 As Byte
   Dim intWdh As Integer
   
   Dim strKeyHex As String
   Dim pin As Long
   
   mstrAdresse = strAdresse
   mstrBefehl = strBefehl
   mbyteP81_1 = P81_1
   mbyteP81_2 = P81_2
   
   Set m_BUP = Nothing
   Set m_Debug = Nothing
   Set m_SEMI = Nothing
   
   
   mcntBUP_empfangen = 0
   mcntDEBUG_empfangen = 0
   mcntSEMI_empfangen = 0
   
   m_lngTimestampSenden = GetTickCount
   
   'PB_1: 128 = h80 = delete all entries from pool, regardless of address: BIT 7 = delPamAll
   'PB_1: 64  = h40 = delete entry with this radio address from pool: BIT 6 = delPamAdr
   'PB_1: 32  = h20 = write entry with this radio address to pool and delete after transmit
   'PB_1: 16  = h10 = write entry with this radio address to pool and delete after SEMI received
   'PB_1: 8   = h08 = write entry with this radio address to pool and leave entry at pool
   'PB_1: 4   = h08 = write entry with this radio address to pool, create Wake Up sequence
   '                  and send out PAM after receive a BUP(LAT) from this address
   '                  and delete after timeOutPam is elapsed
   'PB_1: 2   = h08 =
   
  intWdh = 0
wdh:
   If strBefehl <> "" Then
      
      send = mySIRT.WritePam(P81_1, P81_2, strAdresse, strBefehl, 0, strKeyHex, pin, P12)
      
      send = Statemashine.SendPAM(lstFunkAdr.List(i), strHexCommand, lstFunkAdr.List(i), P81_1, CByte(EinbauplatzNr), Level, strEnckey, CStr(pin))
      mStatus = PAM_Send
      
      mbyteP12 = P12
      If P12 <> 0 Then
         If (P12 And 1) = 1 Then
            ' Buffer full
            mStatus = PAM_wait
         End If
         Debug.Print getP12Text()
      End If
      
      Debug.Print "PAM " & strBefehl & " gesendet an " & strAdresse & ", ret=" & send & ", P12= " & P12
   Else
      send = 1
   End If
   
   Const SirtErrorTimeout = 9
   ' bei Timeout wiederholen
   If send = SirtErrorTimeout And intWdh < 3 Then
      Debug.Print "WritePam wird wiederholt wg. Timeout (" & intWdh & ". Wdh)"
      intWdh = intWdh + 1
      GoTo wdh
   End If
   
End Function


Public Sub DatenEmpfangen(receivedBytes() As Byte, WdhCounter As Integer)
   Dim Adresse As Currency
   
   Adresse = NumberFromByteArray(receivedBytes, 3, 6)

   Select Case receivedBytes(8)
      Case 0, 1
      
         If CStr(Adresse) <> mstrAdresse Then
            Debug.Print "BUP " & receivedBytes(8) & " " & Adresse & "(" & mstrAdresse & ")"
         Else
            Debug.Print "BUP " & receivedBytes(8) & " " & Adresse
         End If
         
            Set m_BUP = New clsBUP
         mcntBUP_empfangen = mcntBUP_empfangen + 1
         m_BUP.Decode receivedBytes
         
         
      Case 11
         Debug.Print "DEBUG" & receivedBytes(8) & " " & Adresse & "(" & mstrAdresse & ")"
         Set m_Debug = New clsDEBUG
         mcntDEBUG_empfangen = mcntDEBUG_empfangen + 1
         m_Debug.Decode receivedBytes
         

      Case 8
         mlngSEMI_time = Round((GetTickCount - m_lngTimestampSenden) / 1000) ' Zeit, die vergangen ist, bis Semi empfangen wurde
         
         Debug.Print "SEMI für " & Adresse & "(war " & mstrAdresse & ") empfangen nach " & mlngSEMI_time & " Sekunden"
         mcntSEMI_empfangen = mcntSEMI_empfangen + 1
         
         Set m_SEMI = New clsSEMI
         m_SEMI.Decode receivedBytes
         mlngWdh = WdhCounter
         
         'Status setzen je nach SEMI Inhalt
         If m_SEMI.PAM_status = 0 Then
            mStatus = SEMI_received_OK
         Else
            Debug.Print "Fehler: PAM Status=" & m_SEMI.getPamStatusText
            mStatus = SEMI_received_Error
         End If
      Case Else
         Debug.Print "unknown " & receivedBytes(8)
   End Select
End Sub





Public Function getP12Text() As String
   Dim BitNr As Integer
   getP12Text = ""
   Const MELDUNGEN = "bufFull osBusy wrongCRC cmdNotExecuted cmdUnknown noEntry byteUnknown wildCardAdr"

   For BitNr = 0 To 7
      If (mbyteP12 And 2 ^ BitNr) = 2 ^ BitNr Then
         getP12Text = getP12Text & Split(MELDUNGEN, " ")(BitNr) & " "
      End If
   Next
End Function