两种方法使用的Com函数都来源于UrlMon,记得先引用。
直接下载文件到磁盘,URLDownloadToFile声明如下:
functionURLDownloadToFile(
Caller: IUnknown;
URL: PWideChar; { 下载的路径 }
FileName: PWideChar; { 保存到的路径 }
Reserved: DWORD;
StatusCB: IBindStatusCallback
): HResult; stdcall;
function URLDownloadToFileA(Caller: IUnknown; URL: PAnsiChar; FileName: PAnsiChar; Reserved: DWORD; StatusCB: IBindStatusCallback): HResult; stdcall; function URLDownloadToFileW(Caller: IUnknown; URL: PWideChar; FileName: PWideChar; Reserved: DWORD; StatusCB: IBindStatusCallback): HResult; stdcall;
调用示例:
if UrlDownloadToFile(nil, 'http://www.xxxx.com/xxx.xx', 'c:\1.xx', 0, nil) = 0 then
MessageBox(handle, '下载成功', '', 0)
else
MessageBox(handle, '下载失败', '', 0);
URLDownloadToFile下载文件前先在本地的缓存中查找文件,如果缓存有则不会再去网上抓最新的文件,希望总是获取新文件时可在URL后加一个随机数,或用DeleteUrlCacheEntry(URL)清理缓存后再下载
下载到 IStream 流,声明为:
functionURLOpenStream(
p1: IUnknown;
p2: PWideChar; { 下载的路径 }
p3: DWORD;
p4: IBindStatusCallback{接口, 下载后的通过它取得数据 }
): HResult; stdcall;
functionURLOpenStreamA(p1: IUnknown; p2: PAnsiChar; p3: DWORD; p4: IBindStatusCallback): HResult; stdcall;
functionURLOpenStreamW(p1: IUnknown; p2: PWideChar; p3: DWORD; p4: IBindStatusCallback): HResult; stdcall;
IBindStatusCallback 接口的实现
TBindStatusCallback = class(TInterfaceList, IBindStatusCallback) public function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall; function GetPriority(out nPriority): HResult; stdcall; function OnLowResource(reserved: DWORD): HResult; stdcall; function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall; function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall; function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall; function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall; function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
end;
{ TBindStatusCallback } function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; begin Result := S_OK; end; function TBindStatusCallback.GetPriority(out nPriority): HResult; begin Result := S_OK; end; function TBindStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; var Stream: IStream; MS: TMemoryStream; begin if dwSize > 0then begin Stream := IStream(stgmed.stm); MS := TMemoryStream.Create;
MS.SetSize(dwSize);
Stream.Read(MS.Memory, dwSize, nil);
//从MS取数据...
MS.Free;
Result := S_OK; end else Result := E_ABORT; end; function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult; begin Result := S_OK; end; function TBindStatusCallback.OnObjectAvailable(const iid: TGUID; punk: IInterface): HResult; begin Result := S_OK; end; function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; begin //可实现侦测进度,实现代码在此写 Result := S_OK; end; function TBindStatusCallback.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; begin Result := S_OK; end; function TBindStatusCallback.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; begin Result := S_OK; end;
调用代码:
var
url: string;
MyBindStatusCallback: IBindStatusCallback;
begin MyBindStatusCallback := TBindStatusCallback.Create; if Succeeded(URLOpenStream(nil, 'http://www.xxxx.com/xxx.xx', 0, MyBindStatusCallback)) then
//下载成功! else //下载失败!; end;