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
  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);
  private
    FURL: string;
    FFileName: string;
    FLocalFile: string;
    procedure SetURL(const Value: string);
    { Private declarations }
  public
    { Public declarations }
    property URL: string read FURL write SetURL;

    function DownFile: Boolean;
  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
  // 
end;

procedure TFileDownLoadForm.SetURL(const Value: string);
var s: string;
begin
  FURL := Value;
  // 反斜杠 ExtractFileName 函数搞不定，这里先转换
  s := StringReplace(FURL, '/', '\', [rfReplaceAll, rfIgnoreCase]);
  FFileName := ExtractFileName(s);
  FLocalFile := 'Web\' + FFileName;
  lblFileName.Caption := FFileName;
  lblFileName.Update;
end;

function TFileDownLoadForm.DownFile: Boolean;
var
  vStream: TMemoryStream;
begin
  Result := False;

  if Trim(URL) = '' then Exit;

  vStream := TMemoryStream.Create;
  try
    try
      ITPDown.Get(URL, vStream);
      vStream.SaveToFile(FLocalFile);
      Result := True;
      ShellExecute(Handle, 'open', pchar(FLocalFile), nil, nil, SW_SHOWNORMAL);
      Application.Terminate;
    except
      Result := False;
    end;
  finally
    vStream.Free;
  end;
end;

end.