Function FritzBoxDaten()
Dim FBOX_ADR As String ' IP der FritzBox
Dim myurl As String ' url der Fritzbox
Dim Text As String ' Text der von der Fritz!Box heruntergeladen wurde
Dim Vorwahl As String ' In den Einstellungen eingegebene Vorwahl
Dim TelName As String ' Gefundener Telefonname
Dim TelNr As String ' Dazugehörige Telefonnummer
Dim Suchwort As String ' Suchwort
Dim SuchArray As Variant
Dim Nebenstellen As Variant
Dim SIPID As String
Dim pos0 As Long
Dim pos1 As Long ' Positionsmarker
Dim pos2 As Long ' Positionsmarker
Dim pos3 As Long ' Positionsmarker
Dim i As Long ' Laufvariable
Dim j As Long ' Laufvariable
Dim TelAnzahl As Long ' Anzahl der gefundenen Telefone
Dim FritzBoxTyp As String
SuchArray = Array("number: '", "number: '", "number: '", _
"partyNo = '", "partyNo = '", "partyNo = '", "partyNo = '", _
"partyNo = '", "partyNo = '", "partyNo = '", "partyNo = '", _
"DeviceIsdnDefauft", "number: isUnpersonalizedMini ? '' : '", "number: isUnpersonalizedMini ? '' : '", _
"number: isUnpersonalizedMini ? '' : '", "number: isUnpersonalizedMini ? '' : '", "number: isUnpersonalizedMini ? '' : '")
Nebenstellen = Array("0", "1", "2", "51", "52", "53", "54", "55", "56", "57", "58", "50", "60", "61", "62", "63", "64")
If DateiPfad = "" Then DateiPfad = GetSetting("FritzBox", "Optionen", "TBini", StandardPfad & "\Einstellungen.ini")
FBOX_ADR = GetINI(DateiPfad, "Optionen", "TBFBAdr", "192.168.178.1")
Vorwahl = GetINI(DateiPfad, "Optionen", "TBVorwahl", "")
myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fondevices"
Text = HTTPTransfer("GET", myurl)
If Not InStr(1, Text, "Anmeldung", vbTextCompare) = 0 Then
If Not FBLogin(True) Then Exit Function
Text = HTTPTransfer("GET", myurl)
End If
'Alten Einstellungen löschen
WriteINI DateiPfad, "Telefone", vbNullString, ""
Text = Replace(Text, Chr(34), "'", , , vbTextCompare) ' " entfernen
Text = Replace(Text, "ü", "ü", , , vbTextCompare) ' Umlaute umarbeiten
Text = Replace(Text, "ä", "ä", , , vbTextCompare)
Text = Replace(Text, "ö", "ö", , , vbTextCompare)
pos1 = 1
'MSNs emitteln
For i = 0 To 9
pos1 = InStr(pos1, Text, "nrs.msn.push('", vbTextCompare) + 14
If Not pos1 = 14 Then
pos2 = InStr(pos1, Text, "'", vbTextCompare)
TelNr = Mid(Text, pos1, pos2 - pos1)
If Not TelNr = "" Then
If Left(TelNr, Len(Vorwahl)) = Vorwahl Then TelNr = Mid(TelNr, Len(Vorwahl) + 1)
WriteINI DateiPfad, "Telefone", "MSN" & CStr(i), TelNr
'Debug.Print "MSN" & CStr(i), TelNr
End If
End If
Next
'Internetnummern ermitteln
For i = 0 To 19
pos1 = InStr(pos1, Text, "nrs.sip.push('", vbTextCompare) + 14
If Not pos1 = 14 Then
pos2 = InStr(pos1, Text, "'", vbTextCompare)
TelNr = Mid(Text, pos1, pos2 - pos1)
If Not TelNr = "" Then
If Left(TelNr, Len(Vorwahl)) = Vorwahl Then TelNr = Mid(TelNr, Len(Vorwahl) + 1)
'WriteINI DateiPfad, "Telefone", "SIP" & CStr(i), TelNr
Debug.Print "SIP" & CStr(i), TelNr
SIPID = i
End If
End If
Next
WriteINI DateiPfad, "Telefone", "SIPID", SIPID
'Debug.Print "SIPID", SIPID
'Festnetznummer ermitteln
pos1 = InStr(1, Text, "telcfg:settings/MSN/POTS", vbTextCompare)
pos2 = InStr(pos1, Text, "value='", vbTextCompare) + 7
pos3 = InStr(pos2, Text, "' id", vbTextCompare)
TelNr = Mid(Text, pos2, pos3 - pos2)
If Left(TelNr, Len(Vorwahl)) = Vorwahl Then TelNr = Mid(TelNr, Len(Vorwahl) + 1)
'Debug.Print "POTS", TelNr
WriteINI DateiPfad, "Telefone", "POTS", TelNr
'Telefone ermitteln
TelAnzahl = 0
pos1 = 1
For i = 0 To 16
pos2 = InStr(pos1, Text, "fonName = '", vbTextCompare) + 11
If Not pos2 = 0 Then
pos1 = pos2
pos2 = InStr(pos1, Text, "'", vbTextCompare)
TelName = Trim(Mid(Text, pos1, pos2 - pos1))
pos1 = InStr(pos2, Text, SuchArray(i), vbTextCompare) + Len(SuchArray(i))
pos2 = InStr(pos1, Text, "'", vbTextCompare)
TelNr = Trim(Mid(Text, pos1, pos2 - pos1))
If Not Trim(TelName) = "" And Not Trim(TelNr) = "" Then
If Left(TelNr, 3) = "SIP" Then TelNr = GetINI(DateiPfad, "Telefone", TelNr, "")
If Left(TelNr, Len(Vorwahl)) = Vorwahl Then TelNr = Mid(TelNr, Len(Vorwahl) + 1)
TelAnzahl = TelAnzahl + 1
WriteINI DateiPfad, "Telefone", CStr(Nebenstellen(i)), TelNr & ";" & TelName
WriteINI DateiPfad, "Telefone", "Anzahl", CStr(TelAnzahl)
Debug.Print CStr(Nebenstellen(i)), TelNr & ";" & TelName
End If
End If
Next
End Function '(FritzBoxDaten)