谁能全面解析一下 DELPHI中的 UrlMon.pas(50分)

noko1981 · 2006-03-15

谁能全面解析一下 DELPHI中的 UrlMon.pas

babibean · 2006-03-15

温柔一刀 (2000-06-18 19:02:00)   urlmon实现了urlmon.dll的com接口， 可以用来让你编的ActiveForm能够控制它的宿主浏览器，例如： procedure TMyActiveForm.btRedirectClick(Sender: TObject); begin HLinkNavigateString(IUnknown(VCLComObject),'http://www.myserver.com'); end; 可以实现redirect到另一个地址，其中HLinkNavigateString是urlmon中的函数。 天真 (2002-05-09 17:46:00)   关于把网页，以及与网页相关的都保存到硬盘中！ 这个答案如下：例子的效果把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; end. ------------------ 随便找了一下，只有这点资料。

babibean · 2006-03-15

笑傲江湖1976 (2003-12-08 16:28:00)   Uses UrlMon;    SourceFile:='http://192.168.30.10/webpr/RptSals/Sals.xls';    DestFile:='c:/Sals.xls';    try      UrlDownLoadToFile(IUnknown(VclComObject),SourceFIle,DestFile,0,nil);    except    end;

babibean · 2006-03-15

楼主，建议你在大富翁里查一下。有很多资料，基本上可以让你知道这个单元的功能。

noko1981 · 2006-03-17

主要想知道如何得到下载进度

谁能全面解析一下 DELPHI中的 UrlMon.pas(50分)

noko1981

Unregistered / Unconfirmed

babibean

Unregistered / Unconfirmed

babibean

Unregistered / Unconfirmed

babibean

Unregistered / Unconfirmed

noko1981

Unregistered / Unconfirmed

Similar threads