下载文件时程序假死

Question

这里有一种下载文件的方法,但下载时程序会严重假死
uses UrlMon;
function DownloadFile(Source, Dest: string): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
    except
      Result := False;
    end;
  end;
  
  if DownloadFile('http://www.borland.com/delphi6.zip, 'c:\kylix.zip') then
ShowMessage('Download succesful')
else ShowMessage('Download unsuccesful') 求一种下载文件程序不假死的方法.
在纯程里使用idhttp.get可以避免假死的情况,
求一简洁的写法:下载完后提示下载完成.

Answer 1

下载时共用UI线程，导致UI线程一直忙下载，重画等消息不被处理，就假死了。要想不假死，只有放在另一线程里面了。

Answer 2

{ Delphi File Download Thread Class , Copyright (c) Zhou Zuoji } unit FileDownLoadThread; 
interface 
uses 
    Classes, 
    SysUtils, 
    Windows, 
    ActiveX, 
    UrlMon; 
const 
    S_ABORT = HRESULT($80004004); 
    
type 
    TFileDownLoadThread = class; 
    
    TDownLoadProcessEvent = procedure(Sender:TFileDownLoadThread;Progress, ProgressMax:Cardinal) of object; 
    TDownLoadCompleteEvent = procedure(Sender:TFileDownLoadThread) of object ; 
    TDownLoadFailEvent = procedure(Sender:TFileDownLoadThread;Reason:LongInt) of object ; 
    TDownLoadMonitor = class( TInterfacedObject, IBindStatusCallback ) 
    private 
        FShouldAbort: Boolean; 
        FThread:TFileDownLoadThread; 
    protected 
        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; 
    public 
        constructor Create(AThread:TFileDownLoadThread); 
        property ShouldAbort: Boolean read FShouldAbort write FShouldAbort; 
    end; 
    TFileDownLoadThread = class( TThread ) 
    private 
        FSourceURL: string; 
        FSaveFileName: string; 
        FProgress,FProgressMax:Cardinal; 
        FOnProcess: TDownLoadProcessEvent; 
        FOnComplete: TDownLoadCompleteEvent; 
        FOnFail: TDownLoadFailEvent; 
        FMonitor: TDownLoadMonitor; 
    protected 
        procedure Execute; override; 
        procedure UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText:string); 
        procedure DoUpdateUI; 
    public 
        constructor Create( ASrcURL, ASaveFileName: string; AProgressEvent:TDownLoadProcessEvent = nil; 
          ACompleteEvent:TDownLoadCompleteEvent = nil;AFailEvent:TDownLoadFailEvent=nil;CreateSuspended: Boolean=False ); 
        property SourceURL: string read FSourceURL; 
        property SaveFileName: string read FSaveFileName; 
        property OnProcess: TDownLoadProcessEvent read FOnProcess write FOnProcess; 
        property OnComplete: TDownLoadCompleteEvent read FOnComplete write FOnComplete; 
        property OnFail: TDownLoadFailEvent read FOnFail write FOnFail; 
    end; 
implementation 
constructor TDownLoadMonitor.Create(AThread: TFileDownLoadThread); 
begin 
    inherited Create; 
    FThread:=AThread; 
    FShouldAbort:=False; 
end; 
function TDownLoadMonitor.GetBindInfo( out grfBINDF: DWORD; var bindinfo: TBindInfo ): HResult; 
begin 
    result := S_OK; 
end; 
function TDownLoadMonitor.GetPriority( out nPriority ): HResult; 
begin 
    Result := S_OK; 
end; 
function TDownLoadMonitor.OnDataAvailable( grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium ): HResult; 
begin 
    Result := S_OK; 
end; 
function TDownLoadMonitor.OnLowResource( reserved: DWORD ): HResult; 
begin 
    Result := S_OK; 
end; 
function TDownLoadMonitor.OnObjectAvailable( const iid: TGUID; punk: IInterface ): HResult; 
begin 
    Result := S_OK; 
end; 
function TDownLoadMonitor.OnProgress( ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR ): HResult; 
begin 
    if FThread <>nil then 
        FThread.UpdateProgress(ulProgress,ulProgressMax,ulStatusCode,''); 
    if FShouldAbort then 
        Result := E_ABORT 
    else 
        Result := S_OK; 
end; 
function TDownLoadMonitor.OnStartBinding( dwReserved: DWORD; pib: IBinding ): HResult; 
begin 
    Result := S_OK; 
end; 
function TDownLoadMonitor.OnStopBinding( hresult: HResult; szError: LPCWSTR ): HResult; 
begin 
    Result := S_OK; 
end; 
{ TFileDownLoadThread } 
constructor TFileDownLoadThread.Create( ASrcURL, ASaveFileName: string;AProgressEvent:TDownLoadProcessEvent ; 
          ACompleteEvent:TDownLoadCompleteEvent;AFailEvent:TDownLoadFailEvent; CreateSuspended: Boolean ); 
begin 
    if (@AProgressEvent=nil) or (@ACompleteEvent=nil) or (@AFailEvent=nil) then 
        CreateSuspended:=True; 
    inherited Create( CreateSuspended ); 
    FSourceURL:=ASrcURL; 
    FSaveFileName:=ASaveFileName; 
    FOnProcess:=AProgressEvent; 
    FOnComplete:=ACompleteEvent; 
    FOnFail:=AFailEvent; 
end; 
procedure TFileDownLoadThread.DoUpdateUI; 
begin 
    if Assigned(FOnProcess) then 
        FOnProcess(Self,FProgress,FProgressMax); 
end; 
procedure TFileDownLoadThread.Execute; 
var 
    DownRet:HRESULT; 
begin 
    inherited; 
    FMonitor:=TDownLoadMonitor.Create(Self); 
    DownRet:= URLDownloadToFile( nil, PAnsiChar( FSourceURL ), PAnsiChar( FSaveFileName ), 0,FMonitor as IBindStatusCallback); 
    if DownRet=S_OK then 
    begin 
        if Assigned(FOnComplete) then 
            FOnComplete(Self); 
    end 
    else 
    begin 
        if Assigned(FOnFail) then 
            FOnFail(Self,DownRet); 
    end; 
    FMonitor:=nil; 
end; 
procedure TFileDownLoadThread.UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText: string); 
begin 
    FProgress:=Progress; 
    FProgressMax:=ProgressMax; 
    Synchronize(DoUpdateUI); 
    if Terminated then 
        FMonitor.ShouldAbort:=True; 
end; 
end. //测试通过unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,FileDownLoadThread;type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure DownLoadFail(Sender:TFileDownLoadThread;Reason:LongInt);
    procedure DownLoadProcess(Sender:TFileDownLoadThread;Progress, ProgressMax:Cardinal);
    procedure DownLoadComplete(Sender:TFileDownLoadThread);
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
begin
  TFileDownLoadThread.Create('http://www.xxx.com/xxx/client.exe','c:\123.exe',DownLoadProcess,DownLoadComplete,DownLoadFail,false);
end;procedure TForm1.DownLoadComplete(Sender: TFileDownLoadThread);
begin
  showmessage('OK.');
end;procedure TForm1.DownLoadFail(Sender: TFileDownLoadThread;
  Reason: Integer);
begin
  showmessage('failed.');
end;procedure TForm1.DownLoadProcess(Sender: TFileDownLoadThread; Progress,
  ProgressMax: Cardinal);
begin
  //弄个进度条
end;end.

Answer 3

加一个这个控件IdAntiFreeze1试试，什么都不用设