Measure/Forms/FileDownLoadFrm.pas

{*******************************************************************************
  单元名称：  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.