ENREGISTRE UN SITE WEB, LES LIENS ASSOCIÉS ET LES IMAGES CONTENUES DANS LA PAGE WEB

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
    function enregistre(sHost, sBaseFichier, sURL: String) : String;
    function RechercheEtEnregistre(sHost, sBaseFichier : String; var sTextASauver, sText : String; sDeLaBalise, sALaBalise: String): String;
    function Parse(sHost, sBaseFichier, sText : String) : String;
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

uses idHTTP;

{$R *.dfm}

function TForm1.enregistre(sHost, sBaseFichier, sURL: String) : String;
var idHTTP : TIdHTTP;
    MemoryStream : TMemoryStream;
    sTmp : String;
    sDir : String;
begin
    idHTTP := TIdHTTP.Create(nil);
    if sHost = '' then
    begin
      try
        idHTTP.Get(sURL);
        sHost := 'http://' + idHTTP.Host;
      Except on exception do
        begin
          result := '';
          exit;
        end;
      end;
    end;
    MemoryStream := TMemoryStream.Create;
    if pos(sHost, sURL) > 0 then
    begin
      sTmp := copy(sURL,pos(sHost, sURL) + length(sHost),length(sURL));
    end
    else
    begin
      sTmp := sURL;
    end;
    try
      try
        idHTTP.Get(sHost + sTmp,MemoryStream);
      Except on exception do
        begin
          Result := enregistre('', sBaseFichier, sURL);
          exit;
        end;
      end;
      sTmp := StringReplace(sTmp,'/','\',[rfReplaceAll]);
      ForceDirectories(sBaseFichier + idHTTP.Host);
      sTmp := StringReplace(sTmp, '|','_',[rfReplaceAll]);
      sTmp := StringReplace(sTmp, '*','_',[rfReplaceAll]);
      sTmp := StringReplace(sTmp, ':','_',[rfReplaceAll]);
      sTmp := StringReplace(sTmp, '?','_',[rfReplaceAll]);
      sTmp := sBaseFichier + idHTTP.Host + '\' + sTmp;
      sDir := ExtractFileDir(sTmp);
      ForceDirectories(sDir);
      if ExtractFilename(sTmp) = '' then
      begin
        sTmp := sTmp + '\index.html';
      end;
      MemoryStream.SaveToFile(sTmp);
      FreeAndNil(MemoryStream);
      FreeAndNil(idHTTP);
      result := sTmp;
    except on e:Exception do
      begin
        showMessage(e.Message);
        result := '';
      end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    sFilename : String;
    slTmp : TStringList;
begin
  sFilename := enregistre('http://www.delphi.fr', 'c:\', '');
  slTmp := TStringList.Create();
  slTmp.LoadFromFile(sFilename);
  slTmp.Text :=  Parse('http://www.google.fr', 'c:\', slTmp.Text);
  slTmp.SaveToFile(sFilename);
  FreeAndNil(slTmp);
end;

function TForm1.RechercheEtEnregistre(sHost, sBaseFichier : String; var sTextASauver, sText : String; sDeLaBalise, sALaBalise: String): String;
var
  sTmp, sOldTmp : String;
  sFilename : String;
begin
  Result := sTextASauver;
  While pos(sDeLaBalise, sText) > 0 do
  begin
    sTmp := copy(sText, pos(sDeLaBalise, sText) + length(sDeLaBalise), length(sText));
    if sTmp <> '' then
    begin
      sTmp := copy(sTmp,1, pos(sALaBalise, sTmp) - 1);
      if sTmp <> '' then
      begin
        sFileName := enregistre(sHost, sBaseFichier, sTmp);
        Result := StringReplace(Result,sDeLaBalise + sTmp + sALaBalise, sDeLaBalise + 'file://' + sFileName + sALaBalise,[]);
        sText := StringReplace(sText,sDeLaBalise + sTmp + sALaBalise, '',[]);
      end;
    end;
  end;
end;

function TForm1.Parse(sHost, sBaseFichier, sText: String): String;
begin
  result := sText;
  result := RechercheEtEnregistre(sHost, sBaseFichier, result, sText, 'src=''', '''');
  result := RechercheEtEnregistre(sHost, sBaseFichier, result, sText, 'src="', '"');
  result := RechercheEtEnregistre(sHost, sBaseFichier, result, sText, 'src=', '>');
  result := RechercheEtEnregistre(sHost, sBaseFichier, result, sText, 'href=''', '''');
  result := RechercheEtEnregistre(sHost, sBaseFichier, result, sText, 'href="', '"');
  result := RechercheEtEnregistre(sHost, sBaseFichier, result, sText, 'href=', '>');
end;

end.