multithreading - 通过线程下载图像错误

Question

祝所有 StackOverFlow 成员(member)和读者新年快乐!

我今天来找你是为了询问有关 Delphi 中线程的问题(我浏览了大部分已经发布的关于该主题的内容，但找不到线索)。

我有一个非常简单的测试应用程序，其中包含一个表单(frmIMGDown)和一个线程单元。在表格上找到

• 一个 T 按钮
• TImage
• 一个 TprogressBar

单击时，该按钮会启动一个线程，从网络下载图像，在此过程中更新进度条并在 Timage 中显示下载的图像。

只要调用表单 (frmIMGDown) 是主应用程序表单，或者如果从另一个表单调用它，但所有表单都是在应用程序启动时创建，则此操作正常>.

现在，如果我通过按钮动态创建 frmIMGDown，请单击主窗体:

procedure TForm1.Button2Click(Sender: TObject);
var
  frmIMGDown : TfrmIMGDown;
begin
  try
    frmIMGDown := TfrmIMGDown.Create(nil);
    frmIMGDown.ShowModal;
  finally
    frmIMGDown.Free;
  end;
end;

我收到地址访问冲突...错误

如果我改变

frmIMGDown := TfrmIMGDown.Create(nil);

至

frmIMGDown := TfrmIMGDown.Create(Form1);

结果是一样的，但有同样的错误。

我怀疑这与我实现的线程以及可能使用的变量有关，并且我尝试将其发送回 frmIMGDown，但我找不到解决方案。

这是线程单元:

unit unit_MyThread;

interface

uses
  Classes, IdHTTP, VCL.Forms, SyStem.UITypes, SysUtils, VCL.Dialogs, Graphics, IdTCPClient, IdTCPConnection, IdComponent,IdBaseComponent;

type
  TIdHTTPThread = class(TThread)
  private
    FURL : String;
    idHTTP: TIdHTTP;
    B : TBitMap;
    W : TWICImage;
    //MS : TMemoryStream;
  public
    Constructor Create(CreateSuspended: Boolean);
    Destructor Destroy; override;
    Property URL : String read FURL WRITE FURL;
    procedure OnWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure OnWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  protected
    procedure Execute; override;
  end;

implementation
uses
  unit_IMG_Down;

Constructor TiDHTTPThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(Suspended);
  IdHTTP := TIdHTTP.Create;
  Screen.Cursor := crHourGlass;
  IdHTTP.onWork := OnWork;
  IdHTTP.OnWorkbegin := OnWorkBegin;
  IdHTTP.OnWorkEnd := OnWorkEnd;
  B := TBitmap.Create;
  W := TWICImage.Create;
end;

Destructor TIdHTTPThread.Destroy;
begin
  idHTTP.Free;
  B.Free;
  W.Free;
  Screen.Cursor := crDefault;
  inherited Destroy;
end;

procedure TIdHTTPThread.Execute;
var
  MS : TMemoryStream;
begin
  Screen.Cursor := crHourGlass;
    try
      MS := TMemoryStream.Create;
      try
        IdHTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';

        IdHTTP.Get(URL,MS);
        MS.Position := 0;
        W.LoadFromStream(MS);
        B.Assign(W);
        frmIMGDown.Image3.Picture.Assign(B);
      except
        On E: Exception do ShowMessage(E.Message);
      end;
    finally
      MS.Free;
    end;
end;

procedure TIdHTTPThread.OnWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
var
  Http: TIdHTTP;
  ContentLength: Int64;
  Percent: Integer;
begin
  Http := TIdHTTP(ASender);
  ContentLength := Http.Response.ContentLength;

  if (Pos('chunked', LowerCase(Http.Response.TransferEncoding)) = 0) and
     (ContentLength > 0) then
  begin
    Percent := 100*AWorkCount div ContentLength;
    frmIMGDown.ProgressBar3.Position := AWorkCount +2;
    frmIMGDown.ProgressBar3.Position := AWorkCount -1;
  end;
end;

procedure TIdHTTPThread.OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
  frmIMGDown.ProgressBar3.Visible := True;
  frmIMGDown.ProgressBar3.Position := 0;
end;

procedure TIdHTTPThread.OnWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  frmIMGDown.ProgressBar3.Visible := false;
end;

end.

以及从按钮调用线程

procedure TfrmIMGDown.Button3Click(Sender: TObject);
var
  HTTPThread : TIdHTTPThread;
begin
  HTTPThread := TIdHTTPThread.Create(False);
  HTTPThread.URL := 'https://bw-1651cf0d2f737d7adeab84d339dbabd3-bcs.s3.amazonaws.com/products/product_119522/Full119522_283b3acc91f119ab4b2939b1beb67211.jpg';

  HTTPThread.FreeOnTerminate := True;
end;

旁注:我使用 TWICImage 下载图像(LoadFromStream)，因为我不知道图像将采用哪种格式(此处 URl 是硬编码用于测试)，然后将其分配给 TBitmap。

提前致谢，再次祝大家新年快乐。

数学

Answer 1

您的线程正在访问表单的全局指针变量。当您收到访问冲突错误时，这是​​因为您没有将新的 Form 对象分配给该全局变量，而是将其分配给同名的局部变量。所以当线程试图访问全局指针时它是无效的。

解决方案是让 Form 对象将其 Self 指针传递给线程，然后将其存储在线程的成员中。根本不要依赖全局指针。

更好的解决方案是根本不让线程知道有关 UI 的任何信息。我建议在线程类中定义事件，并让线程在需要时触发这些事件(图像下载、进度更新、错误等)。然后，表单可以为这些事件分配处理程序，以根据需要更新 UI。

此外，在访问表单的 UI 控件时，您的线程未与主线程同步。 VCL 不是线程安全的，因此您必须同步对 UI 的访问。即使 TBitmap 也不是线程安全的(不确定 TWICImage)，您在使用时必须Lock其Canvas它在一个线程中，完成后解锁。

此外，您还存在竞争条件，因为您允许线程(可能)在分配其 URL 和 FreeOnTermulated 值之前开始运行。您需要创建处于挂起状态的线程，并且在完成初始化之后才开始运行它。最好的方法是使用 CreateSuspished=False 创建线程，并在线程的构造函数本身中处理所有初始化。线程在其构造函数退出之前不会开始运行。否则，使用 CreateSuspished=True 创建线程，并在准备就绪时显式恢复它。

话虽如此，尝试更多类似这样的事情:

unit unit_MyThread;

interface

uses
  Classes, IdComponent, IdBaseComponent;

type
  THTTPStage = (HTTPInit, HTTPDownloading, HTTPDone);
  THTTPStatusEvent = procedure(Sender: TObject; Progress, Total: Int64; Stage: THTTPStage) of object;
  THTTPImageEvent = procedure(Sender: TObject; Data: TStream) of object;

  THTTPThread = class(TThread)
  private
    FURL : String;
    FStream : TMemoryStream;
    FProgress, FTotal : Int64;
    FStage : THTTPStage;
    FOnStatus : THTTPStatusEvent;
    FOnImage : THTTPImageEvent;
    procedure DoOnStatus;
    procedure DoOnImage;
    procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  protected
    procedure Execute; override;
  public
    constructor Create(const AURL: string);
    property OnStatus: THTTPStatusEvent read FOnStatus write FOnStatus;
    property OnImage: THTTPImageEvent read FOnImage write FOnImage;
  end;

implementation

uses
  IdTCPClient, IdTCPConnection, IdHTTP;

constructor THTTPThread.Create(const AURL: string);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FURL := AURL;
end;

procedure THTTPThread.Execute;
var
  IdHTTP: TIdHTTP;
begin
  IdHTTP := TIdHTTP.Create;
  try
    IdHTTP.OnWork := HTTPWork;
    IdHTTP.OnWorkBegin := HTTPWorkBegin;
    IdHTTP.OnWorkEnd := HTTPWorkEnd;
    IdHTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
    FStream := TMemoryStream.Create;
    try
      IdHTTP.Get(FURL, FStream);
      FStream.Position := 0;
      if Assigned(FOnImage) then
        Synchronize(DoOnImage);
    finally
      FStream.Free;
    end;
  finally
    IdHTTP.Free;
  end;
end;

procedure THTTPThread.DoOnStatus;
begin
  if Assigned(FOnStatus) then
    FOnStatus(Self, FProgress, FTotal, FStage);
end;

procedure THTTPThread.DoOnImage;
begin
  if Assigned(FOnImage) then
    FOnImage(Self, FStream);
end;

procedure THTTPThread.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  if AWorkMode = wmRead then
  begin
    FProgress := AWorkCount;
    FStage := HTTPDownloading;
    if Assigned(FOnStatus) then
      Synchronize(DoOnStatus);
  end;
end;

procedure THTTPThread.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  if AWorkMode = wmRead then
  begin
    FProgress := 0;
    FTotal := AWorkCountMax;
    FStage := HTTPInit;
    if Assigned(FOnStatus) then
      Synchronize(DoOnStatus);
  end;  
end;

procedure THTTPThread.HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  if AWorkMode = wmRead then
  begin
    FProgress := FTotal;
    FStage := HTTPDone;
    if Assigned(FOnStatus) then
      Synchronize(DoOnStatus);
  end;
end;

end.

procedure TfrmIMGDown.Button3Click(Sender: TObject);
var
  HTTPThread : THTTPThread;
begin
  HTTPThread := THTTPThread.Create('https://bw-1651cf0d2f737d7adeab84d339dbabd3-bcs.s3.amazonaws.com/products/product_119522/Full119522_283b3acc91f119ab4b2939b1beb67211.jpg');
  HTTPThread.OnStatus := HTTPStatus;
  HTTPThread.OnImage := HTTPImage;
  HTTPThread.OnTerminate := HTTPTerminated;
  HTTPThread.Resume;
end;

procedure TfrmIMGDown.HTTPStatus(Sender: TObject; Progress, Total: Int64; Stage: THTTPStage);
begin
  case Stage of
    HTTPInit: begin
      ProgressBar3.Visible := True;
      ProgressBar3.Position := 0;
      ProgressBar3.Max := 100;
      Screen.Cursor := crHourGlass;
    end;
    HTTPDownloading: begin
      if Total <> 0 then
        ProgressBar3.Position := 100*Progress div Total;
    end;
    HTTPDone: begin
      ProgressBar3.Visible := false;
      Screen.Cursor := crDefault;
    end;
end;

procedure TfrmIMGDown.HTTPImage(Sender: TObject; Data: TStream);
var
  J: TJPEGImage;
begin
  J := TJPEGImage.Create;
  try
    J.LoadFromStream(Data);
    Image3.Picture.Assign(J);
  finally
    J.Free;
  end;
end;

procedure TfrmIMGDown.HTTPTerminated(Sender: TObject);
begin
  if TThread(Sender).FatalException <> nil then
    ShowMessage(Exception(TThread(Sender).FatalException).Message);
end;