如何把WEBBROWSER中显示的内容存成本地文件（什么格式都行）？

Question

如题

Answer 1

例子的效果把www.sina.com.cn的网页保存下来！：）
unit Unit1;interfaceuses
  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[i]='\')or(s[i]='/') 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:=dealwith(copy(memo,beginpos,endpos-beginpos),'www.sina.com.cn');
        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[i],getfilename(imagelist.strings[i]),[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;
    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[i]='\' 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[i]='\' then
                begin
                    dec(i);
                    break;
                end;
                dec(i);
            end;
        end;
        dealwith:=copy(baseurl,1,i)+'\'+url;
    end;
    dealwith:=url;
end;