|
Registriert seit: 21. Jul 2002 Ort: Bonn 5.403 Beiträge Turbo Delphi für Win32 |
#1
Die FritzBox ist als DSL-Modem und Router weit verbreitet. Einige Modelle besitzen eine VoIP-Funktion inkl. Liste der ein- und ausgegangenen Anrufe. Diese kann man auch in Delphi auslesen, wie sh17 zeigt:
Delphi-Quellcode:
function GetCallingsList(AUrl: string; var AErrorString: string; APassword: string = ''; CSVIfTrueElseXML : Boolean = true; ADeleteOnBox: boolean = false): string;
var HTTP: TIdHTTP; challenge,response,sid : String; function InternalGetChallenge : String; begin Result := HTTP.Get('http://'+AUrl+'/cgi-bin/webcm?getpage=../html/login_sid.xml'); if Pos('<challenge>',LowerCase(Result))=0 then raise Exception.Create('Fehler beim Initialisieren der Verbindung.'); System.Delete(Result,1,Pos('<challenge>',LowerCase(Result))+10); System.Delete(Result,Pos('</',Result),Length(Result)-Pos('</',Result)+1); end; function InternalGetResponse : String; var Hash : TDCP_md5; Digest: array[0..15] of byte; str : String; i : Integer; begin str := challenge+'-'+APassword; Hash:= TDCP_md5.Create(nil); Hash.Init; Hash.Update(str[1],Length(str)*2); Hash.Final(Digest); // produce the digest Hash.Burn; Hash.Free; Result := ''; for i := 0 to 15 do Result := Result + IntToHex(Digest[i],2); Result := LowerCase(Result); end; function InternalGetSid : String; var Params: TStringList; begin Result := ''; Params:= TStringList.Create; try with Params do begin Clear; Add('login:command/response=' + challenge+'-'+response); Add('getpage=../html/login_sid.xml'); end; Result := HTTP.Post('http://'+AUrl+'/cgi-bin/webcm',params); if Pos('<sid>',LowerCase(Result))=0 then raise Exception.Create('Fehler beim Generieren der Sitzungs-ID.'); System.Delete(Result,1,Pos('<sid>',LowerCase(Result))+4); System.Delete(Result,Pos('</',Result),Length(Result)-Pos('</',Result)+1); finally Params.Free; end; end; function InternalLogout : String; begin Result := HTTP.Get('http://'+AUrl+'/cgi-bin/webcm?security%3Acommand%2Flogout=0&sid='+sid); end; function InternalGetCalllist : String; var response : TStringStream; begin //Anrufliste erzeugen HTTP.Get('http://'+AUrl+'/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:menu=fon&var:pagename=foncalls&sid='+sid); if CSVIfTrueElseXML then Result := HTTP.Get('http://'+AUrl+'/cgi-bin/webcm?getpage=../html/de/'+'FRITZ!Box_Anrufliste.csv'+'&errorpage=..%2Fhtml'+'%2Fde%2Fmenus%2Fmenu2.html&var%3Alang=de&var%3A pagename=foncalls&var%3Aerrorpagename=foncalls&var%3Amenu=fon&var%3Apagemaster=&sid='+sid) else begin response := TStringStream.Create('',TEncoding.UTF8); HTTP.Get('http://'+AUrl+'/cgi-bin/webcm?getpage=../html/de/home/'+'foncallsdaten.xml'+'&errorpage=..%2Fhtml'+'%2Fde%2Fmenus%2Fmenu2.html&var%3Alang=de&var%3A pagename=foncalls&var%3Aerrorpagename=foncalls&var%3Amenu=fon&var%3Apagemaster=&sid='+sid,response); Result := Trim(response.DataString); response.Free; end; end; function InternalClearCalllist : String; var Params : TStringList; begin Result := ''; Params:= TStringList.Create; try with Params do begin Clear; Add('getpage=../html/de/menus/menu2.html'); Add('var:lang=de'); Add('var:pagename=foncalls'); Add('var:menu=fon'); Add('telcfg:settings/ClearJournal=0'); Add('sid='+sid); end; Result := HTTP.Post('http://'+AUrl+'/cgi-bin/webcm',Params); finally Params.Free; end; end; begin Result := ''; AErrorString := ''; HTTP := TIdHttp.Create(nil); try HTTP.HandleRedirects := true; HTTP.Request.ContentLength := -1; HTTP.Request.Accept := 'text/html, */*'; HTTP.HTTPOptions := [hoForceEncodeParams]; try challenge := InternalGetChallenge; response := InternalGetResponse; sid := InternalGetSid; Result := InternalGetCalllist; if ADeleteOnBox then InternalClearCalllist; InternalLogout; except on E:Exception do AErrorString := E.Message; end; finally HTTP.Free; end; end; Der Code unterstützt alle aktuellen Fritz-Boxen, die die Verwaltung einer Sitzungs-ID erforderlich machen, um die Anruferliste auslesen zu können Eine ältere Version stammt von ACE-ppc und arbeitet noch ohne Sitzungs-ID:
Delphi-Quellcode:
[edit=CalganX]Code überarbeitet. Mfg, CalganX[/edit]
function GetCallingsList(AUrl: string; var AErrorString: string; APassword: string = ''; ADeleteOnBox: boolean = false): string;
function StrAfter(const SubStr, Str:string):string; var p:Integer; begin Result := ''; p := Pos(SubStr,Str); if P > 0 then begin Inc(p, Length(SubStr)); while (p<length(str)) and (Str[p]<>'&') do begin Result := Result + Str[p]; Inc(p); end; end; end; var Params: TStringList; HTTP: TIdHTTP; HTML: String; begin HTTP := TIdHttp.Create(nil); Params := TStringList.Create; try with HTTP do begin HandleRedirects := true; Request.ContentLength := -1; Request.Accept := 'text/html, */*'; HTTPOptions := [hoForceEncodeParams]; end; Result := ''; // Wenn Passwort vorhanden, Login durchführen if APassword <> '' then begin with Params do begin Clear; Add('getpage=../html/de/menus/menu2.html'); Add('errorpage=../html/index.html'); Add('var:lang=de'); Add('var:pagename=home'); Add('var:menu=home'); Add('login:command/password=' + APassword); end; // Versuchen einzuloggen try HTML := HTTP.Post('http://' + AUrl + '/cgi-bin/webcm', Params); // Auf ungültiges Passwort prüfen if Pos('Kennwort ist ungültig', HTML) > 0 then AErrorString := 'Kennwort ist ungültig'; except on E: Exception do AErrorString := E.Message; end; end; // Wenn bereits ein Fehler aufgetreten ist, geht's raus if AErrorString = '' then Exit; // Telefonliste holen try HTML := HTTP.Get('http://' + AUrl + '/cgi-bin/webcm?' + 'getpage=../html/de/FRITZ!Box_Anrufliste.csv'); Result := StrAfter('Dauer', HTML); Result := Trim(Result); except on E: Exception do AErrorString := E.Message; end; // Bei Fehler hier enden if AErrorString = '' then Exit; // Telefonliste löschen if (ADeleteOnBox) then begin with Params do begin Clear; Add('getpage=../html/de/menus/menu2.html'); Add('errorpage=../html/de/menus/menu2.html'); Add('var:lang=de'); Add('var:pagename=foncalls'); Add('var:errorpagename=foncalls'); Add('var:menu=fon'); Add('var:pagemaster='); Add('telcfg:settings/ClearJournal=1'); end; try HTML := HTTP.Post('http://' + AUrl + '/cgi-bin/webcm', Params); except on E: Exception do AErrorString := E.Message; end; end; finally HTTP.Free; Params.Free; end; end; [edit=fkerber]Neue Version von sh17 hinzugefügt. Mfg, Frederic[/edit] Geändert von fkerber (11. Nov 2012 um 17:14 Uhr) |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |