URL download classes

[Kahn (卡恩)]

M$在IE3以後在Win32 API上加了一個URL moniker的功能, 看看自己Delphi程式庫
原始碼的urlmon.pas, 就知道裡頭有一堆東西....嗯, 不過說歸說, 怎麼用哩? :Q

底下就有兩個簡單(也許也好用?)的UrlMon.dll裡頭功能的包裝物件, 一個算是
根本的base class, 另一個是專門用來作非同步下傳指定URL定址資料的物件類別:Q

只要在TURLDownloader.Create時傳入URL跟下傳好後本地存放的檔名作為頭兩個參數,
剩下兩個progress跟Done的參數就隨你高興要不要用了, 不用就填上NIL就好了。
（不過填NIL就不知道下傳狀態跟何時完成了:Q)

剩下的, 不要問我, 自己看......看不懂的人應該回家好好充實自己的功力。

unit urldl;

interface

uses
  Windows, Classes, ComObj, ActiveX, URLMon;

type
  TProgressNotify = function(ulProgress: Longint; ulProgressMax: Longint;
      ulStatusCode: Longint; szStatusText: PWideChar):HResult of object;

  TURLFunctionObject = class(TInterfacedObject, IBindStatusCallback)
  protected
    FOnProgress : TProgressNotify;
    // IBindStatusCallback
    function OnStartBinding(dwReserved: Longint; pib: IBinding): HResult;
      stdcall;
    function GetPriority(out pnPriority: Longint): HResult;
      stdcall;
    function OnLowResource(reserved: Longint): HResult;
      stdcall;
    function OnProgress(ulProgress: Longint; ulProgressMax: Longint;
      ulStatusCode: Longint; szStatusText: PWideChar): HResult;
      stdcall;
    function OnStopBinding( hRes: HResult; szError: PWideChar ): HResult;
      stdcall;
    function GetBindInfo(out grfBINDF: Longint; var pbindinfo: TBindInfo):
      HResult;stdcall;
    function OnDataAvailable(grfBSCF: Longint; dwSize: Longint;
      var pformatetc: TFormatEtc; var pstgmed: TSTGMEDIUM): HResult;
      stdcall;
    function OnObjectAvailable(const iid: TGUID; const punk: IUnknown): HResult;
      stdcall;
    function ProgressCallBack(ulProgress: Longint; ulProgressMax: Longint;
      ulStatusCode: Longint; szStatusText: PWideChar): HResult;virtual;
  public
    constructor Create(
      const URL, Localname: String;
      progress:TProgressNotify;Done:TNotifyEvent);
    function URLFunction(const URL, Filename:pchar):HResult;virtual;
  end;

  TURLDownloader = class(TURLFunctionObject)
  protected
    function ProgressCallBack(ulProgress: Longint; ulProgressMax: Longint;
      ulStatusCode: Longint; szStatusText: PWideChar): HResult;
      override;
  public
    function URLFunction(const URL, Filename:pchar):HResult;override;
  end;

type
  TDownloadThread = class(TThread)
  public
    myurl, myfile : string;
    mycomobj : TURLFunctionObject;
    oleresult : HResult;
    procedure Execute;override;
  end;

implementation

function TURLFunctionObject.OnStartBinding;
begin
  result:=E_NOTIMPL;
end;
function TURLFunctionObject.GetPriority;
begin
  result:=E_NOTIMPL;
end;
function TURLFunctionObject.OnLowResource;
begin
  result:=E_NOTIMPL;
end;
function TURLFunctionObject.OnProgress;
begin
  result:=ProgressCallBack(ulProgress, ulProgressMax,
      ulStatusCode, szStatusText);
end;
function TURLFunctionObject.OnStopBinding;
begin
  result:=E_NOTIMPL;
end;
function TURLFunctionObject.GetBindInfo;
begin
  result:=E_NOTIMPL;
end;
function TURLFunctionObject.OnDataAvailable;
begin
  result:=E_NOTIMPL;
end;
function TURLFunctionObject.OnObjectAvailable;
begin
  result:=E_NOTIMPL;
end;
function TURLFunctionObject.ProgressCallback;
begin
  result:=E_NOTIMPL;
end;
function TURLFunctionObject.URLFunction;
begin
  result:=E_NOTIMPL;
end;

constructor TURLFunctionObject.Create;
begin
  inherited create;
  fonprogress:=progress;
  with tdownloadthread.create(true) do
  begin
    freeonterminate:=true;
    myurl:=url;
    myfile:=localname;
    mycomobj:=self;
    onterminate:=done;
    resume;
  end;
end;


function TURLDownloader.ProgressCallBack;
begin
  if assigned(fonprogress) then
  result:=fonprogress(
    ulProgress, ulProgressMax,
    ulStatusCode, szStatusText) else
  result:=S_OK;
end;

function TURLDownloader.URLFunction;
begin
  result:=URLDownloadToFile(nil,
    url,filename,0,self);
end;

procedure TDownloadThread.execute;
begin
  oleresult:=
    mycomobj.URLFunction(pchar(myurl),pchar(myfile));
end;

end.



--
※ 發信站: 批踢踢實業坊(ptt.twbbs.org) 
◆ From: as1po10.tc.ficn