程序启动时,自动下载给定的EXE文件,但如果我想中止当前进程并重新启动下载或/并且如果EXE一次成功下载并想再次下载,程序停止并出现错误消息:"raise exception class EIdHTTPProtocolException"
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,idhttp, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
IdHTTP1: TIdHTTP;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure DownloadFile;
end;
type
xy = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure friss;
end;
var
Form1: TForm1;
szal:xy;
Stream: TMemoryStream;
implementation
{$R *.dfm}
procedure xy.friss;
begin
ShowMessage('kész');
szal.terminate;
end;
procedure TForm1.Button1Click(Sender: TObject); //abort
begin
szal.Suspend;
szal.Terminate;
end;
procedure TForm1.Button2Click(Sender: TObject); //restart
begin
szal:=xy.Create(true);
szal.Resume;
end;
procedure tform1.DownloadFile;
var
Url, FileName: String;
begin
idhttp1:=idhttp1.Create(self);
Url := 'http://livecd.com/downloads/ActiveDataStudioSetup.exe';
Filename := 'c:setup.zip';
Stream := TMemoryStream.Create;
try
IdHTTP1.Get(Url, Stream);
Stream.SaveToFile(FileName);
finally
Stream.Free;
IdHTTP1.free;
end;
end;
procedure xy.execute;
begin
form1.DownloadFile;
Synchronize(friss);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
szal:=xy.Create(true);
szal.Resume;
end;
procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
begin
form1.ProgressBar1.Position:=AWorkCount;
end;
procedure TForm1.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
begin
form1.ProgressBar1.Max:=AWorkCountMax;
form1.ProgressBar1.Position:=0;
end;
end.
源代码:http://pastebin.com/9DvSyTD7项目:http://osztott.com/ubXN/cucc.zip
EIdHTTPProtocolException
表示HTTP服务器发送回一个错误,例如请求的资源没有找到或无法访问。这与你的线程逻辑无关。
然而,你的代码通常有很多问题——误用TThread
和动态组件,不同步工作线程与主UI线程,等等。
试试这样写:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
procedure StartDownload;
procedure StopDownload;
procedure DownloadFinished(Sender: TObject);
public
end;
var
Form1: TForm1;
implementation
uses
IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdSync;
{$R *.dfm}
type
TDownloadThread = class(TThread)
private
{ Private declarations }
procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
protected
procedure Execute; override;
public
property ReturnValue;
property Terminated;
end;
TDownloadStatusNotify = class(TIdNotify)
protected
Value: Integer;
DownloadBegin: Boolean;
procedure DoNotify; override;
public
constructor Create(AValue: Integer: ADownloadBegin: Boolean); reintroduce;
end;
TFreeDownloadThreadNotify = class(TIdNotify)
protected
Thread: TDownloadThread;
procedure DoNotify; override;
public
constructor Create(AThread: TDownloadThread); reintroduce;
end;
procedure TDownloadThread.Execute;
var
Url, Filename: string;
HTTP: TIdHTTP;
Stream: TMemoryStream;
begin
Url := 'http://livecd.com/downloads/ActiveDataStudioSetup.exe';
Filename := 'c:setup.zip';
HTTP := TIdHTTP.Create(nil);
try
HTTP.OnWorkBegin := HTTPWorkBegin;
HTTP.OnWork := HTTPWork;
Stream := TMemoryStream.Create;
try
HTTP.Get(Url, Stream);
Stream.SaveToFile(Filename);
finally
Stream.Free;
end;
finally
HTTP.Free;
end;
ReturnValue := 1;
end;
procedure TDownloadThread.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
begin
if Terminated then SysUtils.Abort;
if AWorkMode = wmRead then
TDownloadStatusNotify.Create(AWorkCountMax, True).Notify;
end;
procedure TDownloadThread.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
begin
if Terminated then SysUtils.Abort;
if AWorkMode = wmRead then
TDownloadStatusNotify.Create(AWorkCount, False).Notify;
end;
constructor TDownloadStatusNotify.Create(AValue: Integer; ADownloadBegin: Boolean);
begin
inherited Create;
Value := AValue;
DownloadBegin := ADownloadBegin;
end;
procedure TDownloadStatusNotify.DoNotify;
begin
if DownloadBegin then
begin
Form1.ProgressBar1.Position := 0;
Form1.ProgressBar1.Max := Value;
end else
begin
if Form1.ProgressBar1.Max > 0 then
begin
Form1.ProgressBar1.Position := Value;
end else
begin
// the download size is unknown (most likely chunked) so
// display the current Value somewhere else...
end;
end;
end;
constructor TFreeDownloadThreadNotify.Create(AThread: TDownloadThread);
begin
inherited Create;
MainThreadUsesNotify := True;
Thread := AThread;
end;
procedure TFreeDownloadThreadNotify.DoNotify;
begin
Thread.Free;
end;
var
szal: TDownloadThread = nil;
procedure TForm1.FormCreate(Sender: TObject);
begin
StartDownload;
end;
procedure TForm1.Button1Click(Sender: TObject); //abort
begin
StopDownload;
end;
procedure TForm1.Button2Click(Sender: TObject); //restart
begin
StopDownload;
StartDownload;
end;
procedure TForm1.StartDownload;
begin
szal := TDownloadThread.Create(True);
sza1.OnTerminate := DownloadFinished;
szal.Resume;
end;
procedure TForm1.StopDownload;
begin
if sza1 <> nil then
begin
szal.Terminate;
sza1.WaitFor;
FreeAndNil(sza1);
end;
end;
procedure TForm1.DownloadFinished(Sender: TObject);
begin
if sza1.ReturnValue = 1 then
ShowMessage('kész')
else if sza1.Terminated then
ShowMessage('félbeszakadt')
else
ShowMessage('hiba');
if not sza1.Terminated then
begin
TFreeDownloadThreadNotify.Create(sza1).Notify;
sza1 := nil;
end;
end;
end.