AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Internet / LAN / ASP.NET Delphi Anrufliste der FritzBox auslesen
Thema durchsuchen
Ansicht
Themen-Optionen

Anrufliste der FritzBox auslesen

Ein Thema von CalganX · begonnen am 4. Mai 2007
Antwort Antwort
CalganX

Registriert seit: 21. Jul 2002
Ort: Bonn
5.403 Beiträge
 
Turbo Delphi für Win32
 
#1

Anrufliste der FritzBox auslesen

  Alt 4. Mai 2007, 22:33
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:
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=CalganX]Code überarbeitet. Mfg, CalganX[/edit]
[edit=fkerber]Neue Version von sh17 hinzugefügt. Mfg, Frederic[/edit]

Geändert von fkerber (11. Nov 2012 um 16:14 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort

Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:20 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz