|
@@ -16,6 +16,18 @@ uses
|
|
|
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;
|
|
@@ -25,17 +37,15 @@ type
|
|
|
procedure ITPDownWork(Sender: TObject; AWorkMode: TWorkMode;
|
|
|
const AWorkCount: Integer);
|
|
|
procedure ITPDownWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
|
|
|
+ procedure FormCreate(Sender: TObject);
|
|
|
private
|
|
|
- FURL: string;
|
|
|
- FFileName: string;
|
|
|
- FLocalFile: string;
|
|
|
+ FDownThread: TDownThread;
|
|
|
procedure SetURL(const Value: string);
|
|
|
{ Private declarations }
|
|
|
public
|
|
|
{ Public declarations }
|
|
|
- property URL: string read FURL write SetURL;
|
|
|
-
|
|
|
- function DownFile: Boolean;
|
|
|
+ property URL: string write SetURL;
|
|
|
+ procedure RefreshDisplay(AFileName: string);
|
|
|
end;
|
|
|
|
|
|
implementation
|
|
@@ -65,39 +75,56 @@ 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;
|
|
|
+ FDownThread.URL := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileDownLoadForm.RefreshDisplay(AFileName: string);
|
|
|
+begin
|
|
|
+ lblFileName.Caption := AFileName;
|
|
|
lblFileName.Update;
|
|
|
end;
|
|
|
|
|
|
-function TFileDownLoadForm.DownFile: Boolean;
|
|
|
+{ TDownThread }
|
|
|
+
|
|
|
+procedure TDownThread.Execute;
|
|
|
var
|
|
|
vStream: TMemoryStream;
|
|
|
begin
|
|
|
- Result := False;
|
|
|
+ inherited;
|
|
|
|
|
|
- if Trim(URL) = '' then Exit;
|
|
|
+ if Trim(FURL) = '' 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;
|
|
|
+ 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: string;
|
|
|
+begin
|
|
|
+ FURL := Value;
|
|
|
+ // 反斜杠 ExtractFileName 函数搞不定,这里先转换
|
|
|
+ s := StringReplace(Value, '/', '\', [rfReplaceAll, rfIgnoreCase]);
|
|
|
+ FFileName := ExtractFileName(s);
|
|
|
+ FLocalFile := 'Web\' + FFileName;
|
|
|
+ TFileDownLoadForm(FOwner).RefreshDisplay(FFileName);
|
|
|
+
|
|
|
+ Resume; // 在这里唤醒
|
|
|
+end;
|
|
|
+
|
|
|
end.
|