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