Outlook Wählhilfe (Makro) ohne Box zu modifizieren

[Pikachu]

Hallo,

Eine Änderung könnte so aussehen:

formWählbox.frm 241a

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

'
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:

'    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
'

die Sid angehängt werden bei allen in der Funktion Ja oder Nein.


Gruß Erwin :banned: :done:

 

[Kruemelino]

Hallo,

mein Bruder hat eine Testversion des Makro-Dinsbumses soweit fertig, dass sie sich wieder mit der Fritz!Box versteht und auch die Telefone ausgelesen werden.

Bitte habt noch etwas Geduld. Ich will keine Dateien herumschicken, die einfach nicht funktionieren.

Bugs die in der V3 behoben wurden müssen irgendwann auch aus der V2 raus. Teilweise hab ich das schon gemacht, aber halt nur teilweise.

Ich habe vor die Auswertung des ANrufmonitors neu zu schreiben. Aber das kann später kommen.

Ob und wie weit ältere FB-Versionen unterstützt werden, kann ich noch nicht sagen.

Soviel Dazu


Die sid muss nur angehangen werden, wenn die FB das unterstützt. Inwieweit sich die 7150 weiterentwickelt hat, weiß ich nicht.

Gruß Gert

 

[Pikachu]

Hallo,

Das dient als Beispiel nur um mal zu Zeigen dass man
es hinbekommen kann, dass es mit der Sid gehen kann ohne
jetzt den ganzen Code zu zerlegen, wenn du das mal Testen
kannst oder schon getestet hast kannst du mir ja sagen ob es klappt,
die Login_Sid Funktion, hast du ja schon von mir erhalten,
die sollte auf Boxen mit und ohne SID Funktionieren,
was mir aufgefallen ist dass einige Boxen den SID zusatz ignorieren
wenn sie das nicht unterstützen.

Gruß Erwin

 

[ip_trainer]

Was mache ich falsch?

Hallo zusammen,

dies ist mein erster Beitrag in diesem Form. Darum möchte ich mich vorab noch schnell bei allen bedanken, die hier so fleißig schrieiben und das Wählmakro immer weiterentwickeln und verbessern. @kruemelino: ich hoffe deine Prüfungen sind gut gelaufen...

Ich selbst benutze noch eine der ersten Versionen des Makros - habe es damals installiert und bin erst vor ein paar Wochen wieder in die Materie eingetaucht, als nach dem Erwerb einer FB 7270 das Makro nicht mehr funktioniert hat.

Nun habe ich versucht das Makro auf Basis aller Infos hier im Forum und der Technical Note von AVM wieder zum Laufen zu bringen, aber es klappt nicht

Was ich nicht verstehe:

Wenn ich aus der login_sid.xml den challenge-Wert auslese und mich dann mit korrektem response-Wert einlogge - woher bekomme ich dann im Anschluss die SID? Sobald ich wieder auf die login_sid.xml zugreifen, ist diese ja wieder 000... und der challenge-Wert ein anderer. Das verstehe ich nicht, und daran scheitert dann wohl auch jede weitere Anfrage in meinem Code (s.u.), da ich ja keine sid zum Anhängen habe. Hmmm

Hier was ich bisher zusammengebastelt habe:

Function sendRequestToBox(dialCode As String, fonanschluss As Integer) As String
    Dim http As New WinHttpRequest
    Dim FormData
    Dim WinHTTPPostRequest
    Dim ResponseInfo As String
    
    'Ab hier neue Definitionen
    Dim login_sid
    Dim BeginC
    Dim LenC
    Dim Challenge
    Dim BeginS
    Dim LenS
    Dim SID
    Dim Response

    
    '############################################################################
    ' Formulardaten für Login erzeugen
    '############################################################################
    
    'Open URL As POST request and set Content-Type header
    http.Open "POST", "http://fritz.box/cgi-bin/webcm", False
    http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
    '<Challenge-Code> und <SID> auslesen
    http.send URLEncoder("getpage") & "=" & URLEncoder("../html/login_sid.xml")
    login_sid = http.ResponseText

MsgBox ("Inhalt der login_sid.xml: " + login_sid)

        'Extrahieren
        BeginC = InStr(1, login_sid, "<Challenge>") + 11
        LenC = InStr(11, login_sid, "</Challenge>") - BeginC
        
        BeginS = InStr(1, login_sid, "<SID>") + 5
        LenS = InStr(5, login_sid, "</SID>") - BeginS
    
    'Ergebnisse
    Challenge = Mid(login_sid, BeginC, LenC)
    SID = Mid(login_sid, BeginS, LenS)
   

MsgBox ("Challenge: " & Challenge + ", SID: " + SID)


    'Falls sid leer ist ->Anmelden erforderlich
    If Val(SID) = 0 Then
        
            'MD5-Erzeugungs-Kontrolle -> in Ordnung
            'Challenge = "1234567z"
            'Dim password As String
            'password = "äbc"
            
            'Response = Challenge + "-" + MD5_string(Challenge + "-" + password)
            
            '--> Ergibt wie inder Technical Note beschrieben: 1234567z-9e224a41eeefa284df7bb0f26c2913e2
        
        
        
        'Echten Response-Code aus Challenge & Kennwort generieren
        Response = Challenge + "-" + MD5_string(Challenge + "-" + FBOX_PASSWORD)
    
        FormData = URLEncoder("getpage") & "=" & URLEncoder("../html/de/menus/menu2.html") & "&" & URLEncoder("login:command/response") & "=" & Response
                         
MsgBox ("Form-Data: " & FormData)
                         
        On Error GoTo catch ' Fehler abfangen
          
        'Send the form data To URL
        http.send FormData
         
        'On Error GoTo 0 ' Fehler nicht mehr abfangen

    End If
    
    
    
    '##########################################################################
    ' Formulardaten erzeugen um Nummer zu wählen
    '##########################################################################
    FormData = URLEncoder("getpage") & "=" & URLEncoder("../html/de/menus/menu2.html") & _
               "&" & URLEncoder("telcfg:settings/DialPort") & "=" & URLEncoder(fonanschluss) & _
               "&" & URLEncoder("telcfg:command/Dial") & "=" & URLEncoder(dialCode) & _
               "&" & URLEncoder("sid") & "=" & URLEncoder(SID)
  
    ' Formulardaten senden
    On Error GoTo catch ' Fehler abfangen
    
    
MsgBox ("Formdata: " & FormData)


    http.send FormData
    
    On Error GoTo 0 ' Fehler nicht mehr abfangen
  
    ' Antwort empfangen
    WinHTTPPostRequest = http.ResponseText
    

MsgBox ("Http-Antwort: " & WinHTTPPostRequest)


    ' 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 (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
        
catch:
     ResponseInfo = vbNewLine & "Fehler bei HTTP/Post"
     If Err.number = -2147012889 Then
         MsgBox "Fritz!Box konnte nicht gefunden werden. Ist die Netzwerkverbindung OK?", vbCritical, "Fehler"
     Else
         MsgBox "Fehler: " & Err.Description, vbCritical, "Fehler"
     End If
     
finally:
     'Fenster schließen
     'formSelTel.Hide
     
     sendRequestToBox = ResponseInfo
    
End Function

Dann bekomme ich folgendes in den Msg-Boxen zurück:

---------------------------
Inhalt der login_sid.xml:

<SessionInfo> <iswriteaccess>0</iswriteaccess> <SID>0000000000000000</SID> <Challenge>cd20aadd</Challenge> </SessionInfo>

---------------------------
Daraus generiert:

Challenge: cd20aadd
SID: 0000000000000000

---------------------------
Login-Anfrage (urldecoded):

getpage=../html/de/menus/menu2.html&login:command/response=cd20aadd-70119681c0ed9xxxb3784c27541b7a47

---------------------------
Http-Antwort (Login-Anfrage):

<head>
<!-- lang: "de"; ethnr: "lan0" -->
<!-- OEM "1und1"/"1und1", Seite ""/"" -->
<!-- var:usePSTN: 0 -->
<title>FRITZ!Box</title>
<meta http-equiv=content-type content="text/html; charset=utf-8">
<meta http-equiv="expires" content="0">
<style type="text/css">
[...]

---------------------------
Wählanfrage (urldecoded):

getpage=../html/de/menus/menu2.html&telcfg:settings/DialPort=52&telcfg:command/Dial=0163481xxxx#&sid=0000000000000000

---------------------------
Http-Antwort (Wählanfrage ):

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<!--loginPage-->
<head>
[...]

---------------------------



Das Wählmakro zeigt mir dann einen Fehler an ("Fehler! Evtl. Passwort falsch?") - und gewählt wird natürlich auch nicht...


Ok, erst mal danke fürs Lesen, vielleicht hat ja jemand einen Tip für mich.

Gruß
tp

 

[Kruemelino]

Ja Danke alle gut verlaufen.

Die sid steht in der Antwort zu auf
getpage=../html/de/menus/menu2.html&login:command/response=cd20aadd-70119681c0ed9xxxb3784c27541b7a47

<input type="hidden" name="sid" value="2800851ce6c383f2" id="uiPostSid">

Wenn du sie ausliest musst du halt darauf achten, dass sie mehrfach in der Antwort drin steht.
u.A: <input type="hidden" name="sid" value="2800851ce6c383f2">
und nochmal in den Funktionen

Gruß Gert

 

[ip_trainer]

Hi Gert,

danke für die Antwort. Aber in meiner Antwort steht irgendwie gar nichts verwertbares drin:

<head>
<!-- lang: "de"; ethnr: "lan0" -->
<!-- OEM "1und1"/"1und1", Seite ""/"" -->
<!-- var:usePSTN: 0 -->
<title>FRITZ!Box</title>
<meta http-equiv=content-type content="text/html; charset=utf-8">
<meta http-equiv="expires" content="0">
<style type="text/css">
body { font-family: Arial, Helvetica, sans-serif; color: #000000; margin: 15px 0px 0px 0px;
background-color: #fff1b1;
background-image: url(/html/de/images/bg_ramp.jpg);
background-repeat: repeat-x;
background-position: 0 0; }
p, table, form, div, textarea, label, ul, ol, li
{ font-size: 13px; padding: 0px; margin: 0px; }
input, select, button
{ font-size: 13px; }
div,ul,ol,li { text-align: left; }
tr,td { padding: 1px 0px; margin: 0px; text-align: left; }
img { border: 0px none; }
a:link { color: #003366; text

Oder verstehe ich dich falsch?

Gruß
tp

 

[Pikachu]

Wenn der Login fehl schlägt dann bekommt man die Startseite oder eine Fehlerseite zurück.

 

[ip_trainer]

Das ist es ja gerade, was mich verwirrt. In der http-Antwort oben steht werden was von Fehler, noch ist es die login-Seite.

Pikachu hat mir eben eine Datei geschickt, aus der werde ich vielleicht schlau. Falls ich es damit hinbekomme, gebe ich noch Bescheid wo der Fehler lag.

Trotzdem Danke!

 

[Pikachu]

Das sollte:

If Val(SID) = 0 Then

man vermeiden, da bekommst du eine schöne Fehlermeldung,
denn die Sid wird als Hex zurückgeliefert, darum sollte man es so machen hier:

If Val("&H" + SID) = 0 Then

wenn es schon sein muss.

 

[ip_trainer]

If Val("&H" + SID) = 0 Then

Ok, das stimmt ... Danke für den hint.


Hast du denn eine Idee, warum bei mir in der Antwortseite keine sid drin steht?

 

[Pikachu]

Schau dir mal die Function FFSP_Login_Sid
an darin wirst du die Lösung finden.

Wird oben im Beispiel hier aufgerufen:

'
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
'

 

[ip_trainer]

Gelöst

Hallo an alle,

ich habe es geschafft, das alte Ding läuft wieder ...

Mein Fehler war (unter anderem), dass ich nicht bedacht habe, dass eine MsgBox nur eine bestimmte Anzahl von Zeichen aufnehmen kann. Die "sid" war in der http-Antwort enthalten, ich habe sie nur nicht gesehen.

Also, für alle die gerne noch die alte Version weiter verwenden möchten: die im Anhang angefügten Dateien funktionieren bei der FB 7270 (sowohl mit den direkt an der Fritzbox angeschlossenen ISDN-Telefonen, als auch mit den DECT-Telefonen, wenn man als Anschluss ISDN S0, also Port 50 einstellt)

Danke an Pikachu und Kruemelino für die schnellen Antworten!

Gruß
tp


Hier noch mal die Veränderungen am Hauptmodul (FritzBoxDial.bas), die Datei ist aber ebenfalls im Anhang enthalten:

Function sendRequestToBox(dialCode As String, fonanschluss As Integer) As String
    Dim http As New WinHttpRequest
    Dim FormData
    Dim WinHTTPPostRequest
    Dim ResponseInfo As String
    
    'Ab hier neue Definitionen
    Dim login_sid
    Dim BeginC
    Dim LenC
    Dim Challenge
    Dim BeginS As String
    Dim LenS As String
    Dim SID
    Dim Response

    
    '############################################################################
    ' Formulardaten für Login erzeugen
    '
    ' Wichtig:  Erst POST senden um einzuloggen, dann ein weiteres POST
    '           um die Nummer zu wählen.
    '           Bei der Fritzbox kann scheinbar innerhalb eines Zeitfensters
    '           von ca. 10-15 min ein telcfg:command/Dial abgesetzt werden,
    '           ohne ein login:command/password zu übergeben. Es reicht aus,
    '           wenn innerhalb der letzten 10-15 min ein login:command/password
    '           erfolgt ist.
    '
    '           Wird nun versucht beides innerhalb eines POSTs durchzuführen
    '           (also einloggen und wählen), und wurde innerhalb der letzten
    '           10-15 min noch kein login:command/password aufgerufen, so ist
    '           lediglich der Login erfolgreich, der Anruf wird aber NICHT
    '           ausgeführt.
    '
    '           Desweiteren muss nun bei jeder Anfrage die sid übertragen werden,
    '           sonst wird die Session wieder zerstört!
    '
    '############################################################################
    
    'Open URL As POST request and set Content-Type header
    http.Open "POST", "http://fritz.box/cgi-bin/webcm", False
    http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
    '<Challenge-Code> und <SID> auslesen
    http.send URLEncoder("getpage") & "=" & URLEncoder("../html/login_sid.xml")
    login_sid = http.ResponseText

'MsgBox ("Inhalt der login_sid.xml: " + login_sid)

        'Extrahieren
        BeginC = InStr(1, login_sid, "<Challenge>") + 11
        LenC = InStr(11, login_sid, "</Challenge>") - BeginC
        
        BeginS = InStr(1, login_sid, "<SID>") + 5
        LenS = InStr(5, login_sid, "</SID>") - BeginS
    
    'Ergebnisse
    Challenge = Mid(login_sid, BeginC, LenC)
    SID = Mid(login_sid, BeginS, LenS)
   

'MsgBox ("Challenge: " & Challenge + ", SID: " + SID)


    'Falls sid leer ist ->Anmelden erforderlich
    If Val("&H" + SID) = 0 Then
        
        'Response-Code aus Challenge & Kennwort generieren
        Response = Challenge + "-" + MD5_string(Challenge + "-" + FBOX_PASSWORD)
    
        FormData = URLEncoder("getpage") & "=" & URLEncoder("../html/de/menus/menu2.html") & "&" & URLEncoder("login:command/response") & "=" & Response
                         
                         
        On Error GoTo catch ' Fehler abfangen
          
        'Send the form data To URL
        http.send FormData
         
        ' Antwort empfangen
        WinHTTPPostRequest = http.ResponseText

        
        'Extrahieren
        Dim start As String
        Dim ende As String
        
        start = "<input type=" + Chr$(34) + "hidden" + Chr$(34) + " name=" + Chr$(34) + "sid" + Chr$(34) + " value=" + Chr$(34)
        ende = Chr$(34) + " id=" + Chr$(34) + "uiPostSid" + Chr$(34) + ">"

        
        BeginS = InStr(1, WinHTTPPostRequest, start) + 39
        LenS = InStr(16, WinHTTPPostRequest, ende) - BeginS
    
    
        'Ergebnis (muss ab jetzt bei jeder Anfrage angehängt werden)
        SID = Mid(WinHTTPPostRequest, BeginS, LenS)

        
        'On Error GoTo 0 ' Fehler nicht mehr abfangen

    End If
    
    
    
    '##########################################################################
    ' Formulardaten erzeugen um Nummer zu wählen
    '##########################################################################
    FormData = URLEncoder("getpage") & "=" & URLEncoder("../html/de/menus/menu2.html") & _
               "&" & URLEncoder("telcfg:settings/DialPort") & "=" & URLEncoder(fonanschluss) & _
               "&" & URLEncoder("telcfg:command/Dial") & "=" & URLEncoder(dialCode) & _
               "&" & URLEncoder("sid") & "=" & URLEncoder(SID) ' "sid" muss hier kleingeschrieben werden
  
    ' Formulardaten senden
    On Error GoTo catch ' Fehler abfangen
    
    http.send FormData
    
    On Error GoTo 0 ' Fehler nicht mehr abfangen
  
    ' Antwort empfangen
    WinHTTPPostRequest = http.ResponseText


    ' 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, bei der sich der Benutzer anmelden muss
        
        If (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
        
catch:
     ResponseInfo = vbNewLine & "Fehler bei HTTP/Post"
     If Err.number = -2147012889 Then
         MsgBox "Fritz!Box konnte nicht gefunden werden. Ist die Netzwerkverbindung OK?", vbCritical, "Fehler"
     Else
         MsgBox "Fehler: " & Err.Description, vbCritical, "Fehler"
     End If
     
finally:
     'Fenster schließen
     formSelTel.Hide
     
     sendRequestToBox = ResponseInfo
    
End Function

 

[Kruemelino]

Hallo,

ich hab jetzt Windows 7 installiert, und heute den ganzen Nachmittag daran rumgedoktort dieses Addin zum Laufen zu bekommen. Leider mit keinem Erfolg. Es scheint aber an Windows 7 zu liegen, denn auf anderen Rechnern hab ich kein Problem. Sicherlich liegt es daran, dass Windows 7 noch zu neu ist und sicher an der ein oder anderen Stelle Inkompatibilitäten sind.

soviel dazu

 

[bin-wech]

Habe die neue 3er Version auch schon auf Win7 versucht.
Install läuft ohne Fehler durch. Aber es fehlt mir dann die Symbolleiste in Outlook.

 

[Kruemelino]

Ich hab sogar die Installationsroutine angepasst, dass sie auch mit aktiviertem UAC (auch für Vista interessant) funktioniert. Allerdings wird die Datei FritzBoxDial.dll.manifest nicht mitinstalliert. Frag mich nicht warum...

 

[bin-wech]

Im Programmverzeichnis steht aber besagte Datei bei mir drin.
Heißt, dass sie nicht ins System eingreift.

 

[Kruemelino]

Ja das funktioniert bei deiner Instalation. Dafür funktioniert das SetCaspol nicht. Ich müsste dir eine Testversion zukommen lassen. Vielleicht geht die ja besser.

 

[bin-wech]

Stimmt - die SetCaspol meldet beim Ausführen einen Fehler.
Schick mir die neue Testversion zum testen.

 

[ledo2502]

Hallo,
bin vergangene Woche auf diese Seite gestoßen und muss ein großes Lob für dieses Projekt aussprechen.

Ich habe versucht die Makro Version 2.4 auf Windows 7 und Outlook 2007 zu installieren, jedoch ohne auch nur einen kleinsten Erfolg. Dies liegt zum einen auch daran, dass ich die neuste Firmware-Version 29.04.76 installiert habe.

Ich würde ganz gerne mir mal die 3er Version anschauen. Ich habe auch Visual Studio Professional. Könntest du (Kruemelino) mir die aktuelle dev. Version mal zuschicken, oder mich auf die Mailing Liste setzten? Ich habe dir eine PN mit meiner Emailadresse geschickt.

Vielen Dank, ledo2502

 

[Kruemelino]

Tata

Ich habs heute hinbekommen. Läuft auf Windows 7, auch mit aktiviertem UAC. Ich schick die V3.0.1 dann gleich noch raus. Dann veröffentliche ich sie auch für andere.

Gruß Kruemel