Image Download through thread error

Question

Happy new year to all StackOverFlow member and readers !

I come to you today for a question regarding threads in Delphi (I browsed most of what was already posted on the subject but could not find a clue).

I have a very simple test application with one Form (frmIMGDown) and a thread unit. On the form are found

a Tbutton
a TImage
a TprogressBar

When clicked, the button starts a thread that downloads an image from the web, updates the progressbar during the process and displays a downloaded image in the Timage.

This works fine as long as the calling Form (frmIMGDown) is the main application form, OR if it is called from another form but all forms are created on application start.

Now, if I dynamically create frmIMGDown from a button click on the Main Form with :

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

I get an Access Violation at address... error

If I change

frmIMGDown := TfrmIMGDown.Create(nil);

to

frmIMGDown := TfrmIMGDown.Create(Form1);

the result is the same with the same error.

I suspect this has to do with the thread I implemented and maybe the variables used and that I try to send back to frmIMGDown, but I can't find the solution.

Here is the thread unit :

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.

And the call to thread from the button

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;

SIDE NOTE : I used TWICImage to download the image (LoadFromStream) because I don't known which format the image will be (here the URl is hard-coded for the test) and assign it to a TBitmap after that.

Thanks in advance and, again, a happy new year to all.

Math

Please note that, in your first code snippet, frmIMGDown := TfrmIMGDown.Create(nil); MUST be the line immediately BEFORE the try. Otherwise, if the constructor raises an exception (which it is perfectly allowed to do), you will do frmIMGDown.Free on a random pointer frmIMGDown, which is very bad (AV, memory corruption, ...). — Andreas Rejbrand

Remy Lebeau Remy Lebeau · Accepted Answer · 2018-01-08T06:28:45

Your thread is accessing the Form's global pointer variable. When you get the Access Violation error, it is because you are not assigning the new Form object to that global variable, you are assigning it to a local variable of the same name instead. So the global pointer is invalid when the thread tries to access it.

The solution is to have the Form object pass its Self pointer to the thread, and then store it in a member of the thread. Don't rely on the global pointer at all.

A better solution is to not let the thread know anything about the UI at all. I would suggest defining events in the thread class, and have the thread fire those events when needed (image downloaded, progress updates, errors, etc). Then the Form can assign handlers to those events to update the UI as needed.

Also, your thread is not synchronizing with the main thread when accessing the Form's UI controls. The VCL is not thread-safe, so you MUST synchronize access to the UI. Even TBitmap is not thread-safe (not sure about TWICImage), you must Lock its Canvas when working with it in a thread, and Unlock when done.

Also, you have a race condition, as you are allowing the thread to (potentially) start running before you have assigned its URL and FreeOnTerminated values. You need to create the thread in a suspended state and not start it running until after you finish initializing it. The best way to do that is to create the thread with CreateSuspended=False and handle all of the initializations in the thread's constructor itself. The thread will not start running until its constructor exits. Otherwise, create the thread with CreateSuspended=True and explicitly resume it when ready.

With all of that said, try something more like this:

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;

Image Download through thread error

1 Answers