Einzelnen Beitrag anzeigen

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