Enregistrer une page web

Résolu
Utilisateur anonyme - 22 sept. 2004 à 23:42
jobtunisieyasser Messages postés 123 Date d'inscription lundi 6 septembre 2004 Statut Membre Dernière intervention 23 mars 2007 - 24 sept. 2004 à 17:39
je cherche a enregistrer une pge web donnée en parametre au format HTML sur mon disque (la meme chose que, sous IE, menu fichier->enregistrer sous avec "page web complete d'activer))

si qq'un sait faire.....

merci

3 réponses

Utilisateur anonyme
23 sept. 2004 à 22:26
presque parfait....
Comme tu en parles, j'aurais aimé avoir TOUTES la pages, imags comprises ? Est- ce abusé de te demander comment je peux le faire ?

Merci

NB : tu parles de parser. j'entends ca a toutes les sauces . C'est quoi parser ?
0
arnaud_tournier Messages postés 34 Date d'inscription jeudi 16 septembre 2004 Statut Membre Dernière intervention 25 mars 2007
24 sept. 2004 à 12:46
En fait, parser un fichier veut tout simplement dire analyser le fichier pour en retirer ce qui t intérresse. Dans ton cas, il faut que tu recherche toutes les pages et les images associées dans ta page et que tu les téléchargent, J ai modifie le petit bout de coe que je t avais donne pour qu il convienne peut etre un peu miseux a ce que tu recherche....

unit Unit1;

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.

Arnaud
0
jobtunisieyasser Messages postés 123 Date d'inscription lundi 6 septembre 2004 Statut Membre Dernière intervention 23 mars 2007
24 sept. 2004 à 17:39
arnaud_tournier !!! 8-)
Cool
Jézeka ALLAh'o khyaran

@_______=-Jobtunisie-=_______@
|..................NOURON ALA NOUR.......................|
0