Private Sub AnrMonAktion()
' wird durch den Timer regelmäßig ausgeführt
' schaut in der FritzBox im Port 1012 nach und startet entsprechende Unterprogramme
Dim FBStatus As String ' Status-String der FritzBox
Dim aktZeile As String ' aktuelle Zeile im Status-String
Dim lenFBStatus As Long ' Länge des Status-Strings
Dim pos As Long ' Position in einem String
Dim posRING As Long ' Position von RING im Status-String
Dim posCALL As Long ' Position von CALL im Status-String
Dim posCONNECT As Long ' Position von CONNECT im Status-String
Dim posDISCONNECT As Long ' Position von DISCONNECT im Status-String
Dim bOK As Boolean ' 'true' wenn Daten vorhanden (wird nicht ausgewertet)
Dim Dateipfad As String
Dim Uhrzeit As Double
Dim Wartezeit As Double
Dim cmb As CommandBar ' FritzBox-Symbolleiste
Dateipfad = GetSetting("FritzBox", "Optionen", "TBini", "C:\Einstellungen.ini")
' Funktion wird nur einmal ausgeführt (wenn aktiv = 'false')
If Not aktiv Then
aktiv = True
If tcp.IsDataAvailable(GetINI(Dateipfad, "Optionen", "TBTimeOut", "")) Then
FBStatus = ""
bOK = tcp.ReceiveData(FBStatus, lenFBStatus)
If Not Len(FBStatus) = 0 Then
LogFile FBStatus
pos = InStr(FBStatus, Chr(10)) ' Zeilenende suchen und 'FBStatus' zeilenweise auswerten
Do While Not pos = 0
aktZeile = Left(FBStatus, pos)
'Schauen ob "RING", "CALL", "CONNECT" oder "DISCONNECT" übermittelt wurde
posRING = InStr(aktZeile, "RING")
posCALL = InStr(aktZeile, "CALL")
posCONNECT = InStr(aktZeile, "CONNECT")
posDISCONNECT = InStr(aktZeile, "DISCONNECT")
If posCONNECT = posDISCONNECT + 3 Then posCONNECT = 0 '"CONNECT" steckt auch in "DISCONNECT"
'je nach Auftreten auswerten
If Not posRING = 0 Then
AnrMonRING aktZeile, posRING, True, True
aktInterv = GetINI(Dateipfad, "Optionen", "TBmaxInterv", "")
End If
If Not posCALL = 0 Then AnrMonCALL aktZeile, posCALL
If Not posCONNECT = 0 Then AnrMonCONNECT aktZeile, posCONNECT
If Not posDISCONNECT = 0 Then AnrMonDISCONNECT aktZeile, posDISCONNECT
FBStatus = Mid(FBStatus, pos + 1)
pos = InStr(FBStatus, Chr(10))
Loop
End If
End If
If Not InStr(1, tcp.ErrorDescription, "Error in ", vbTextCompare) = 0 Then
Set cmb = Application.ActiveExplorer.CommandBars.Item("FritzBox")
cmb.FindControl(, , "Anrufmonitor").State = msoButtonUp
cmb.FindControl(, , "Anrufmonitor").Enabled = False
LogFile "TCP-IP-Verbindung abgerissen"
tcp.DeleteErrorDesc
AnrMonQuit
Uhrzeit = CDbl(Time)
LogFile "Es wird ca. 30s bis zum Neustart gewartet"
Do
Wartezeit = CDbl(Time) - Uhrzeit
If Wartezeit < 0 Then Wartezeit = Wartezeit + 1
DoEvents
Loop Until Wartezeit >= 30 / 86400
cmb.FindControl(, , "Anrufmonitor").Enabled = True
Initialisierung
Set cmb = Nothing
Exit Sub
End If
' 'formAnrmon' ausblenden, wenn 'aktInterv=1'
If aktInterv > 0 Then
If aktInterv = 1 Then
formAnrMon.Hide
Stop_MP3 "FBDB"
End If
aktInterv = aktInterv - 1
End If
aktiv = False
End If
End Sub '(AnrMonAktion)
Dann dauert der Wählvorgang doch länger.
