Pikachu
Aktives Mitglied
- Mitglied seit
- 18 Nov 2006
- Beiträge
- 2,424
- Punkte für Reaktionen
- 36
- Punkte
- 48
Hallo,
Eine Änderung könnte so aussehen:
formWählbox.frm 241a
FritzBox.bas 241a
Frage muss hier:
die Sid angehängt werden bei allen in der Funktion Ja oder Nein.
Gruß Erwin :banned: :done:
Eine Änderung könnte so aussehen:
formWählbox.frm 241a
Code:
Private Function sendRequestToBox(dialCode As String, fonanschluss As Long) As String
' überträgt die zum Verbindungsaufbau notwendigen Daten per WinHttp an die FritzBox
' Parameter: dialCode (string): zu wählende Nummer
' fonanschluss (long): Welcher Anschluss wird verwendet?
' Rückgabewert (String): Antworttext (Status)
' 11.08.2009
Dim sFormdata As String ' an die FritzBox zu sendende Daten
Dim WinHTTPPostRequest As String ' Antwort der FritzBox
Dim FBOX_ADR As String ' IP-Adresse der FritzBox
Dim FBOX_PWD As String ' Passwort der FritzBox
Dim ResponseInfo As String ' Antwortstring
Dim DateiPfad As String
Static sSID As String ' SessionID
DateiPfad = GetSetting("FritzBox", "Optionen", "TBini", StandardPfad & "\Einstellungen.ini")
FBOX_ADR = GetINI(DateiPfad, "Optionen", "TBFBAdr", "192.168.178.1")
FBOX_PWD = GetINI(DateiPfad, "Optionen", "TBPasswort", "")
If FritzBox.FB_Login_Sid(FBOX_ADR, FBOX_PWD, sSID) = 1 Then
' If FritzBox.FBLogin(True) Then
If dialCode = "ATH" Then
sFormdata = "getpage=../html/de/menus/menu2.html&telcfg:settings/UseClickToDial=1" + _
"&telcfg:settings/DialPort=" + CStr(fonanschluss) + "&telcfg:command/Hangup&sid=" + sSID
Else
sFormdata = "getpage=../html/de/menus/menu2.html&telcfg:settings/UseClickToDial=1" + _
"&telcfg:settings/DialPort=" + CStr(fonanschluss) + "&telcfg:command/Dial=" + dialCode + "&sid=" + sSID
' sFormdata = "getpage=../html/de/menus/menu2.html&telcfg:settings/DialPort=" _
' & CStr(fonanschluss) & "&telcfg:command/Dial=" & dialCode
End If
' Antwort empfangen
' WinHTTPPostRequest = HTTPTransferRT("post", "http://" & FBOX_ADR & "/cgi-bin/webcm", sFormdata)
WinHTTPPostRequest = HTTPTransfer("post", "http://" & FBOX_ADR & "/cgi-bin/webcm", sFormdata)
' Antwort auswerten
If Len(WinHTTPPostRequest) > 0 Then
' Wenn der String "FRITZ!Box Anmeldung" im Reponse enthalten ist, ist etwas schief gelaufen.
' Dann kommt die Fritz Box-Anmeldeseite, wo sich der Benutzer anmelden muss
If Not InStr(WinHTTPPostRequest, "FRITZ!Box Anmeldung") = 0 Then
' Wahrscheinlich falsches Passwort
ResponseInfo = "Fehler!" & vbNewLine & "Evtl. Passwort falsch?"
Else
If dialCode = "ATH" Then
ResponseInfo = "Verbindungsaufbau" & vbNewLine & "wurde abgebrochen!"
Else
ResponseInfo = "Wähle " & dialCode & vbNewLine & "Jetzt abheben!"
End If
End If
End If
' Fertig
GoTo finally
End If
catch:
ResponseInfo = vbNewLine & "Fehler bei HTTP/Post"
If Err.Number = -2147012889 Then
Meldung "Es is ein Fehler aufgetreten: Die Fritz!Box konnte nicht gefunden werden. Ist die Netzwerkverbindung OK?", vbCritical
Else
Meldung "Es is ein Fehler aufgetreten: " & Err.Description, vbCritical
End If
finally:
sendRequestToBox = ResponseInfo
End Function
FritzBox.bas 241a
Code:
'
Function Initialisierung()
' Diese Funktion initialisiert den Makrostart. Vorher wird jedoch überprüft,
' ob die Einstellungen OK sind und ob die Fritz!Box verfügbar ist.
' Die Funktion wird sicher noch erweitert.
Dim Fehlergrund As String
Dim FBAddr As String
Dim FBPassWort As String ' Passwort der FritzBox ' 11.08.2009
Static sSID As String ' SessionID ' 11.08.2009
Dim FehlerVorhanden As Boolean ' wird true wenn ein Fehler auftritt
DateiPfad = GetSetting("FritzBox", "Optionen", "TBini", StandardPfad & "\Einstellungen.ini")
WriteINI DateiPfad, "Optionen", "Version", "2.41"
KeyÄnderung
FehlerVorhanden = False
FBAddr = GetINI(DateiPfad, "Optionen", "TBFBAdr", "-1")
FBPassWort = GetINI(DateiPfad, "Optionen", "TBPasswort", "") ' 11.08.2009
' Überprüfung der Einstellungen
If GetINI(DateiPfad, "Optionen", "TBTimeOut", "-1") = "-1" Or _
GetINI(DateiPfad, "Optionen", "TBIntervall", "-1") = "-1" Or _
GetINI(DateiPfad, "Optionen", "TBmaxInterv", "-1") = "-1" Or _
GetINI(DateiPfad, "Optionen", "TBVorwahl", "-1") = "-1" Or _
FBAddr = "-1" Then
FehlerVorhanden = True
Fehlergrund = "Benötigte Einstellungen fehlerhaft! Bitte überprüfen."
formConfig.Show
End If
'Ping zur Fritz!box
If Not FehlerVorhanden Then
If Not Ping(FBAddr) Then
FehlerVorhanden = True
Fehlergrund = Fehlergrund & vbNewLine & "Keine Fritz!Box gefunden."
End If
End If
' Es wird ein Einloggen erzungen.
If Not FehlerVorhanden Then
' IF NOT FBLogin(True) THEN
IF FB_Login_Sid(FBAddr, FBPassWort, sSID) <> 1 THEN ' 11.08.2009
FehlerVorhanden = True
Fehlergrund = Fehlergrund & vbNewLine & "Einloggen fehlgeschlagen"
End If
End If
' Fehlerauswertung.
If FehlerVorhanden Then
LogFile "Initialisierung fehlgeschlagen! Start abgebrochen." & vbNewLine & Fehlergrund
Meldung "Initialisierung fehlgeschlagen! Start abgebrochen." & vbNewLine & Fehlergrund, vbCritical
Else
LogFile "Initialisierung abgeschlossen! Start..."
FritzBoxSymbolleisten
WBSchließen
VersionsCheck
If GetINI(DateiPfad, "Telefone", "Anzahl", "0") = "0" Then FritzBoxDaten
If Not aktiv Then AnrMonStart
End If
End Function '(Initialisierung)
'
Sub DownloadAnrListe()
Dim FBAdresse As String ' IP der FritzBox
Dim FBPassWort As String ' Passwort der FritzBox ' 11.08.2009
Static sSID As String ' SessionID ' 11.08.2009
Dim http As New MSXML2.XMLHTTP30
Dim XmlHttpMon As New HttpMonitor
' mit dem Download der Anrufliste beginnen (nur wenn Journaleinträge angelegt werden sollen)
' dadurch werden auch Anrufe eingetragen, die nicht vom Anrufmonitor erfasst wurden (z.B. Rechner war aus)
' Passwort übermitteln
If DateiPfad = "" Then DateiPfad = GetSetting("FritzBox", "Optionen", "TBini", StandardPfad & "\Einstellungen.ini")
FBAdresse = GetINI(DateiPfad, "Optionen", "TBFBAdr", "192.168.178.1")
FBPassWort = GetINI(DateiPfad, "Optionen", "TBPasswort", "") ' 11.08.2009
' If FBLogin(True) Then
If FB_Login_Sid(FBAdresse, FBPassWort, sSID) = 1 Then ' 11.08.2009
' Webseite aufrufen, damit Anrufliste.csv aktualisiert wird
' HTTPTransfer "GET", "http://" & FBAdresse & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=foncalls"
HTTPTransfer "GET", "http://" & FBAdresse & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=foncalls&sid=" + sSID ' 11.08.2009
Set XmlHttpMon.XmlHttpReq = httpAsync ' httpAsync wird an die Klasse HttpMonitor übergeben (damit die weiß worum es geht)
httpAsync.onreadystatechange = XmlHttpMon ' damit wird festgelegt, was im Falle von onreadystatechange passieren soll
' httpAsync.Open "GET", "http://" & FBAdresse & "/cgi-bin/webcm?getpage=../html/de/FRITZ!Box_Anrufliste.csv", True
httpAsync.Open "GET", "http://" & FBAdresse & "/cgi-bin/webcm?" + "&sid=" + sSID + "&getpage=../html/de/FRITZ!Box_Anrufliste.csv", True ' 11.08.2009
httpAsync.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
On Error GoTo CATCH
httpAsync.send
On Error GoTo 0
nichtkomplett = True
LogFile "Download von 'Anrufliste.csv' wurde gestartet"
End If
Exit Sub
CATCH:
LogFile "Fehler in 'DownloadAnrListe'"
LogFile "Fehler-Nr.: " & Err.Number
LogFile "Fehler-Beschreibung: " & Err.Description
nichtkomplett = False
Meldung "Fehler beim Herunterladen der Anrufliste: " & vbNewLine & Err.Description, vbCritical
End Sub '(DownloadAnrListe)
'
Sub Anrufliste2Excel()
' wird durch das Symbol 'Anrufliste herunterladen' in der 'FritzBox'-Symbolleiste ausgeführt
' läd die Anrufliste herunter und öffnet sie in Excel
Dim formdata As String ' Daten die an FritzBox übermittelt werden (Passwort)
Dim FBOX_ADR As String ' IP-Adresse der FritzBox
Dim FBOX_PWD As String ' Passwort der FritzBox ' 11.08.2009
Static sSID As String ' SessionID ' 11.08.2009
Dim myurl As String ' url der Fritzbox
Dim csvAnrListe As String ' Anrufliste
Dim Datei As String ' Dateiname der Anrufliste
Dim olfolder As Object
Dim olNamespace As Outlook.NameSpace ' MAPI-Namespace
Dim LandesVW As String
Dim KontaktID As String
Dim StoreID As String
Dim i As Long
Dim AnrName As String
Dim Anzahl As Long
Dim rws As Boolean
Dim TelNr As String
Dim vCard As String
If DateiPfad = "" Then DateiPfad = GetSetting("FritzBox", "Optionen", "TBini", StandardPfad & "\Einstellungen.ini")
' Passwort übermitteln
FBOX_ADR = GetINI(DateiPfad, "Optionen", "TBFBAdr", "")
FBOX_PWD = GetINI(DateiPfad, "Optionen", "TBPasswort", "") ' 11.08.2009
' If FBLogin(True) Then
If FB_Login_Sid(FBOX_ADR, FBOX_PWD, sSID) = 1 Then ' 11.08.2009
Datei = GetDirectory("Bitte geben Sie einen Ordner an, indem die Anrufliste (AnrListe.csv) gespeichert werden soll:")
If Not Datei = "" Then
Datei = Datei & "\AnrListe.csv"
' Webseite aufrufen damit Anrufliste aktualisiert wird
' myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=foncalls"
myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=foncalls&sid=" + sSID ' 11.08.2009
HTTPTransfer "GET", myurl
' Anrufliste herunterladen
LogFile "Die Anrufliste wird heruntergeladen"
' myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/FRITZ!Box_Anrufliste.csv"
myurl = "http://" & FBAdresse & "/cgi-bin/webcm?" + "&sid=" + sSID + "&getpage=../html/de/FRITZ!Box_Anrufliste.csv" ' 11.08.2009
csvAnrListe = HTTPTransfer("GET", myurl)
csvAnrListe = Replace(csvAnrListe, ";", ",", , , vbTextCompare)
' Anrufliste als Datei speichern
Open Datei For Binary As #1
Put #1, , csvAnrListe
Close #1
LogFile "Die Anrufliste wurde heruntergeladen und unter " & Datei & " gespeichert."
'Anrufliste mit Excel öffnen
With CreateObject("Excel.Application")
.workbooks.Open FileName:=Datei, ReadOnly:=False, Format:=4
.Range("B:B").NumberFormat = "m/d/yyyy h:mm"
.Range("D:D").NumberFormat = "0#######################"
.Range("F:F").NumberFormat = "0#######################"
.Range("1:1").NumberFormat = "General"
.Range("A:H").Columns.AutoFit
If Meldung("Möchten Sie die Anrufliste auswerten?", vbYesNo) = vbYes Then
LandesVW = GetINI(DateiPfad, "Optionen", "TBLandesVW", "0049")
WriteINI DateiPfad, "Journal", "Abbruch", False
Set olNamespace = GetNamespace("MAPI")
If GetINI(DateiPfad, "Optionen", "CBKHO", True) Then
Set olfolder = olNamespace.GetDefaultFolder(olFolderContacts)
Else
Set olfolder = olNamespace
End If
Anzahl = 1
.Range("H1") = "Name"
Do
Anzahl = Anzahl + 1
Loop Until .Range("A" & Anzahl) = ""
Anzahl = Anzahl - 1
formStatus.ProgressBar.Max = Anzahl
formStatus.Show vbModeless
For i = 2 To Anzahl
vCard = ""
TelNr = "0" & .Range("D" & i)
If Not TelNr = "0" Then
If FritzBox.FindeKontakt(TelNr, "", LandesVW, KontaktID, StoreID, olfolder) Then
With olNamespace.GetItemFromID(KontaktID, StoreID)
AnrName = Replace(.FullName & " (" & .CompanyName & ")", " ()", "")
End With
.Range("H" & i) = AnrName
Else
' Anrufer per Rückwärtssuche ermitteln
TelNr = "0" & .Range("D" & i)
If GetINI(DateiPfad, "Optionen", "CBRückwärtssuche", False) Then
Select Case GetINI(DateiPfad, "Optionen", "CBoxRWSuche", "0")
Case "0"
rws = RWSDasTelefonbuch(TelNr, vCard)
Case "1"
rws = RWSGoYellow(TelNr, vCard)
Case "2"
rws = RWS11880(TelNr, vCard)
Case "3"
rws = RWStelsearch(TelNr, vCard)
End Select
If rws Then
AnrName = ReadFNfromVCard(vCard)
AnrName = Replace(AnrName, Chr(13), "", , , vbTextCompare)
.Range("H" & i) = AnrName
End If
End If
End If
End If
formStatus.ProgressBar.Value = i
formStatus.Label1.Caption = i & " / " & Anzahl & " (" & Round(((i) / Anzahl) * 100, 1) & " %)"
If GetINI(DateiPfad, "Journal", "Abbruch", False) Then i = Anzahl ' Abbruch
Next
formStatus.hide
.Visible = True
Else
.Visible = True
End If
End With
End If
End If
End Sub '(Anrufliste2Excel)
'
FUNCTION FritzBoxDaten()
DIM FBOX_ADR AS STRING ' IP-Adresse der FritzBox
DIM FBOX_PWD AS STRING ' Passwort der FritzBox ' 11.08.2009
STATIC sSID AS STRING ' SessionID ' 11.08.2009
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("DeviceFonExt0", "DeviceFonExt1", "DeviceFonExt2", _
"DeviceFonIsdn1", "DeviceFonIsdn2", "DeviceFonIsdn3", "DeviceFonIsdn4", _
"DeviceFonIsdn5", "DeviceFonIsdn6", "DeviceFonIsdn7", "DeviceFonISDN8", _
"DeviceIsdnDefauft")
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")
FBOX_PWD = GetINI(DateiPfad, "Optionen", "TBPasswort", "") ' 11.08.2009
IF FB_Login_Sid(FBOX_ADR, FBOX_PWD, sSID) <> 1 THEN EXIT FUNCTION ' 11.08.2009
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"
myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fondevices" + "&sid=" + sSID ' 11.08.2009
TEXT = HTTPTransfer("GET", myurl)
IF NOT INSTR(1, TEXT, "Anmeldung", vbTextCompare) = 0 THEN
' If Not FBLogin(True) Then Exit Function
IF FB_Login_Sid(FBOX_ADR, FBOX_PWD, sSID) <> 1 THEN EXIT FUNCTION ' 11.08.2009
TEXT = HTTPTransfer("GET", myurl)
END IF
'
'
' .....
'
'Fritz!Fon 7150
' myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fonlistisdn"
myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fonlistisdn" + "&sid=" + sSID ' 11.08.2009
'
'
' < - nur ein Teil von: FUNCTION FritzBoxDaten()
'
'
'
FUNCTION FB_Login_Sid(sHost AS STRING, sPassword AS STRING, sSID AS STRING) AS LONG
' 11.08.2009
sPassword = Crypt(sPassword, GetSetting("FritzBox", "Optionen", "Zugang", "")
FB_Login_Sid = FFSP_Login_Sid(sHost, sPassword, sSID)
'
END FUNCTION
'
Frage muss hier:
Code:
' myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fondevices"
myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fondevices" + "&sid=" + sSID ' 11.08.2009
'
' .....
'
'Fritz!Fon 7150
' myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fonlistisdn"
myurl = "http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fonlistisdn" + "&sid=" + sSID ' 11.08.2009
'
Gruß Erwin :banned: :done:
Zuletzt bearbeitet: