为什么我的多线程文件下载无法正常工作?



程序启动时,自动下载给定的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.

相关内容

  • 没有找到相关文章

最新更新