{******************************************************************************* 单元名称: FileDownLoadFrm.pas 单元说明: 通用的文件下载进度窗体,下载完退出程序,并运行刚下载的文件。 作者时间: Chenshilong, 2016-08-10 *******************************************************************************} unit FileDownLoadFrm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Gauges, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, ShellAPI; type TDownThread = class(TThread) private FURL: string; FFileName: string; FLocalFile: string; FOwner: TObject; procedure SetURL(const Value: string); public property URL: string read FURL write SetURL; procedure Execute; override; end; TFileDownLoadForm = class(TForm) lblFileName: TLabel; gDown: TGauge; ITPDown: TIdHTTP; procedure ITPDownWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); procedure ITPDownWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); procedure ITPDownWorkEnd(Sender: TObject; AWorkMode: TWorkMode); procedure FormCreate(Sender: TObject); private FDownThread: TDownThread; procedure SetURL(const Value: string); { Private declarations } public { Public declarations } property URL: string write SetURL; procedure RefreshDisplay(AFileName: string); end; implementation {$R *.dfm} { TFileDownLoadForm } procedure TFileDownLoadForm.ITPDownWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin gDown.MinValue := 0; gDown.Progress := 0; gDown.MaxValue := AWorkCountMax; end; procedure TFileDownLoadForm.ITPDownWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin gDown.Progress := AWorkCount; end; procedure TFileDownLoadForm.ITPDownWorkEnd(Sender: TObject; AWorkMode: TWorkMode); begin // For test. // Application.MessageBox(PChar('下完了!'), '操作提醒', MB_OK + MB_ICONWARNING); end; procedure TFileDownLoadForm.SetURL(const Value: string); begin FDownThread.URL := Value; end; procedure TFileDownLoadForm.RefreshDisplay(AFileName: string); begin lblFileName.Caption := AFileName; lblFileName.Update; end; { TDownThread } procedure TDownThread.Execute; var vStream: TMemoryStream; begin inherited; if Trim(FURL) = '' then Exit; vStream := TMemoryStream.Create; try TFileDownLoadForm(FOwner).ITPDown.Get(FURL, vStream); vStream.SaveToFile(FLocalFile); ShellExecute(Handle, 'open', pchar(FLocalFile), nil, nil, SW_SHOWNORMAL); TFileDownLoadForm(FOwner).Close; Synchronize(Application.Terminate); // 同步到主线程,不然执行后没响应。 finally vStream.Free; end; end; procedure TFileDownLoadForm.FormCreate(Sender: TObject); begin FDownThread := TDownThread.Create(True); FDownThread.FOwner := Self; FDownThread.FreeOnTerminate := True; end; procedure TDownThread.SetURL(const Value: string); var s, path: string; begin FURL := Value; path := ExtractFilePath(Application.ExeName) + 'Web\'; ForceDirectories(path); // 反斜杠 ExtractFileName 函数搞不定,这里先转换 s := StringReplace(Value, '/', '\', [rfReplaceAll, rfIgnoreCase]); FFileName := ExtractFileName(s); FLocalFile := path + FFileName; TFileDownLoadForm(FOwner).RefreshDisplay(FFileName); Resume; // 在这里唤醒 end; end.