Enregistre un site web, les liens associés et les images contenues dans la page web

Soyez le premier à donner votre avis sur cette source.

Snippet vu 10 740 fois - Téléchargée 38 fois

Commenter

Contenu du snippet

Enregistre un site WEB, les liens associés et les images contenues dans la page WEB

Source / Exemple : 


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.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (arnaud_tournier)