给你我的程序，思路已在，你要求的也在，不过自己要改改才能用
关于把网页，以及与网页相关的都保存到硬盘中！
这个答案如下：例子的效果把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);
functiondo
wnloadFile(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)do
wnto 1do
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;
begin
pos,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)>0do
begin
begin
pos:=pos('src=',memo)+4;
while (memo[begin
pos]=' ') or (memo[begin
pos]='"')do
begin
inc(begin
pos);
end;
endpos:=begin
pos+1;
while (memo[endpos]<>' ') and (memo[endpos]<>'"')and (memo[endpos]<>'>')do
begin
inc(endpos);
end;
// s:=copy(memo,begin
pos,endpos-begin
pos);
s:=dealwith(copy(memo,begin
pos,endpos-begin
pos),'www.sina.com.cn');
// showmessage(s);
if (imagelist.indexof(s)=-1)or(imagelist=nil) then
begin
imagelist.Add(s);
do
wnloadFile(s,'d:/download/'+getfilename(s));
end;
delete(memo,1,endpos);
end;
except
showmessage(inttostr(begin
pos)+','+inttostr(endpos));
end;
showmessage(inttostr(imagelist.count));
for i :=0 to imagelist.count-1do
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;
begin
pos: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)do
wnto 1do
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)<>0do
begin
begin
pos:=pos('../',url);
delete(url,1,begin
pos+2);
while i>=1do
begin
if baseurl='/' then
begin
dec(i);
break;
end;
dec(i);
end;
end;
dealwith:=copy(baseurl,1,i)+'/'+url;
end;
dealwith:=url;
end;
end.
