给你个例子：）
来自：天真, 时间：2002-5-9 17:46:00, ID：1091382 | 编辑
关于把网页，以及与网页相关的都保存到硬盘中！
这个答案如下：例子的效果把www.sina.com.cn的网页保存下来！：）
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,nmhttp,urlmon,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Splitter1: TSplitter;
procedure Button1Click(Sender: TObject);
private
procedure savedata(url,memo:string);
function dealwith(url,baseurl:string):string; //处理网页路径
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.savedata(url,memo:string);
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result:=False;
end;
end;
function getfilename(s:string):string;
var i:integer;
begin
for i:=length(s) downto 1 do
begin
if (s='/')or(s='/') then
break;
end;
result:=copy(s,i+1,length(s)-i);
end;
var i:integer;
imagelist:tstringlist;
bmplist:tstringlist;
tempmemo:string;
beginpos,endpos:integer;
path:string;
s:string;
memorystream:tmemorystream;
begin
bmplist:=tstringlist.Create ;
bmplist.Add('.bmp');
bmplist.Add('.jpg');
bmplist.Add('.swf');
bmplist.Add('.gif');
path:='d:/download/';
tempmemo:=memo;
imagelist:=tstringlist.create;
try
while pos('src=',memo)>0 do
begin
beginpos:=pos('src=',memo)+4;
while (memo[beginpos]=' ') or (memo[beginpos]='"') do
begin
inc(beginpos);
end;
endpos:=beginpos+1;
while (memo[endpos]<>' ') and (memo[endpos]<>'"')and (memo[endpos]<>'>')do
begin
inc(endpos);
end;
// s:=copy(memo,beginpos,endpos-beginpos);
s:=dealwith(copy(memo,beginpos,endpos-beginpos),'www.sina.com.cn');
// showmessage(s);
if (imagelist.indexof(s)=-1)or(imagelist=nil) then
begin
imagelist.Add(s);
DownloadFile(s,'d:/download/'+getfilename(s));
end;
delete(memo,1,endpos);
end;
except
showmessage(inttostr(beginpos)+','+inttostr(endpos));
end;
showmessage(inttostr(imagelist.count));
for i :=0 to imagelist.count-1 do
begin
memo1.text:=stringreplace(memo1.text,imagelist.strings,getfilename(imagelist.strings),[rfReplaceAll]);
end;
memorystream:=tmemorystream.Create ;
memorystream.Position :=0;
imagelist.Free;
bmplist.Free ;
memorystream.Free ;
memo1.Lines.SaveToFile('d:/download/index.htm');
showmessage('ok');
end;
procedure TForm1.Button1Click(Sender: TObject);
var s:string;
nmhttp:tnmhttp;
begin
//建立nmhttp
nmhttp:=tnmhttp.Create(nil);
NMHTTP.InputFileMode := FALSE;
NMHTTP.OutputFileMode := FALSE;
// NMHTTP.ReportLevel := Status_Basic;
try
nmhttp.Get('www.sina.com.cn');
s:=nmhttp.body;
except
end;
memo1.text:=s;
savedata('sss',s);
end;
function Tform1.dealwith(url,baseurl:string):string; //处理网页路径
var i:integer;
beginpos:integer;
begin
URL:=stringreplace(url,'"','',[rfReplaceAll]);
if url[1]+url[2]+url[3]+url[4]+url[5]+url[6]+url[7]='http://' then
dealwith:=url;
URL:=stringreplace(url,'/','/',[rfReplaceAll]);
if pos(' ',url)<>0 then
begin
url:=copy(url,1, pos(' ',url)-1);
end;
for i:=length(baseurl) downto 1 do
begin
if baseurl='/' then
BEGIN
break;
END;
end;
IF I<>1 THEN
baseurl:=copy(baseurl,1,i)
ELSE
BASEURL:=BASEURL+'/';
if ((pos('.',url)<>0)and(pos('./',url)=0)and(url[1]<>'/')) or (pos('www.',url)<>0) then
dealwith:=url;
if (pos('../',url)=0)AND (POS('./',URL)=0) then //没有指定目录//??要改改
begin
if url[1]='/' then
url:=copy(url,2,length(url)-1);
dealwith:=baseurl+url;
end
else
begin
i:=length(baseurl)-1;
while pos('../',url)<>0 do
begin
beginpos:=pos('../',url);
delete(url,1,beginpos+2);
while i>=1 do
begin
if baseurl='/' then
begin
dec(i);
break;
end;
dec(i);
end;
end;
dealwith:=copy(baseurl,1,i)+'/'+url;
end;
dealwith:=url;
end;
