Threading inconsistency Delphi xe6

So, I've always faced MAJOR headaches when threading in delphi xe4-6, whether it be from threads not executing, exception handling causes app crashes, or simply the on terminate method never getting called. All the workarounds I've been instructed to use have become very tedious with issues still haunting me in XE6. My code generally has looked something like this:

procedure TmLoginForm.LoginClick(Sender: TObject);
var
  l:TLoginThread;
begin
  SyncTimer.Enabled:=true;
  l:=TLoginThread.Create(true);
  l.username:=UsernameEdit.Text;
  l.password:=PasswordEdit.Text;
  l.FreeOnTerminate:=true;
  l.Start;
end;



procedure TLoginThread.Execute;
var
  Success     : Boolean;
  Error       : String;
begin
  inherited;
  Success := True;
  if login(USERNAME,PASSWORD) then
  begin
    // do another network call maybe to get dif data.
  end else
  begin
    Success := False;
    Error   := 'Login Failed. Check User/Pass combo.';
  end; 

  Synchronize(
  procedure
    if success = true then
    begin
      DifferentForm.Show;
    end else
    begin
      ShowMessage('Error: '+SLineBreak+Error);
    end;
    SyncTimer.Enabled := False;
  end);
end;

And then I came across this unit from the samples in Delphi and from the forums:

unit AnonThread;

interface

uses
  System.Classes, System.SysUtils, System.Generics.Collections;

type
  EAnonymousThreadException = class(Exception);

  TAnonymousThread<T> = class(TThread)
  private
    class var
      CRunningThreads:TList<TThread>;
  private
    FThreadFunc: TFunc<T>;
    FOnErrorProc: TProc<Exception>;
    FOnFinishedProc: TProc<T>;
    FResult: T;
    FStartSuspended: Boolean;
  private
    procedure ThreadTerminate(Sender: TObject);
  protected
    procedure Execute; override;
  public
    constructor Create(AThreadFunc: TFunc<T>; AOnFinishedProc: TProc<T>;
      AOnErrorProc: TProc<Exception>; ACreateSuspended: Boolean = False;
      AFreeOnTerminate: Boolean = True);

    class constructor Create;
    class destructor Destroy;
 end;

implementation

{$IFDEF MACOS}
uses
{$IFDEF IOS}
  iOSapi.Foundation
{$ELSE}
  MacApi.Foundation
{$ENDIF IOS}
  ;
{$ENDIF MACOS}

{ TAnonymousThread }

class constructor TAnonymousThread<T>.Create;
begin
  inherited;
  CRunningThreads := TList<TThread>.Create;
end;

class destructor TAnonymousThread<T>.Destroy;
begin
  CRunningThreads.Free;
  inherited;
end;

constructor TAnonymousThread<T>.Create(AThreadFunc: TFunc<T>; AOnFinishedProc: TProc<T>;
  AOnErrorProc: TProc<Exception>; ACreateSuspended: Boolean = False; AFreeOnTerminate: Boolean = True);
begin
  FOnFinishedProc := AOnFinishedProc;
  FOnErrorProc := AOnErrorProc;
  FThreadFunc := AThreadFunc;
  OnTerminate := ThreadTerminate;
  FreeOnTerminate := AFreeOnTerminate;
  FStartSuspended := ACreateSuspended;

  //Store a reference to this thread instance so it will play nicely in an ARC
  //environment. Failure to do so can result in the TThread.Execute method
  //not executing. See http://qc.embarcadero.com/wc/qcmain.aspx?d=113580
  CRunningThreads.Add(Self);

  inherited Create(ACreateSuspended);
end;

procedure TAnonymousThread<T>.Execute;
{$IFDEF MACOS}
var
  lPool: NSAutoreleasePool;
{$ENDIF}
begin
{$IFDEF MACOS}
  //Need to create an autorelease pool, otherwise any autorelease objects
  //may leak.
  //See https://developer.apple.com/library/ios/#documentation/Cocoa/Conceptual/MemoryMgmt/Articles/mmAutoreleasePools.html#//apple_ref/doc/uid/20000047-CJBFBEDI
  lPool := TNSAutoreleasePool.Create;
  try
{$ENDIF}
    FResult := FThreadFunc;
{$IFDEF MACOS}
  finally
    lPool.drain;
  end;
{$ENDIF}
end;

procedure TAnonymousThread<T>.ThreadTerminate(Sender: TObject);
var
  lException: Exception;
begin
  try
    if Assigned(FatalException) and Assigned(FOnErrorProc) then
    begin
      if FatalException is Exception then
        lException := Exception(FatalException)
      else
        lException := EAnonymousThreadException.Create(FatalException.ClassName);
      FOnErrorProc(lException)
    end
    else if Assigned(FOnFinishedProc) then
      FOnFinishedProc(FResult);
  finally
    CRunningThreads.Remove(Self);
  end;
end;

end.

Why is that this anon thread unit above works flawlessly 100% of the time and my code crashes sometimes? For example, I can exec the same thread 6 times in a row, but then maybe on the 7th (or the first for that matter) time it causes the app to crash. No exceptions ever come up when debugging so I dont have a clue where to start fixing the issue. Also, why is it that I need a separate timer that calls "CheckSynchronize" for my code in order to GUI updates to happen but it is not needed when I use the anon thread unit?

Maybe someone can point me in the right direction to ask this question elsewhere if here is not the place. Sorry, I'm diving into documentation already, trying my best to understand.

Here is an example of a thread that may work 20 times in a row, but then randomly cause app to crash

inherited;
    try
      SQL:= 'Some SQL string'; 
      if GetSQL(SQL,XMLData) then
        synchronize(
        procedure
        var
          i:Integer;
        begin
          try
            mTasksForm.TasksListView.BeginUpdate;
            if mTasksForm.TasksListView.Items.Count>0 then
              mTasksForm.TasksListView.Items.Clear;
            XMLDocument := TXMLDocument.Create(nil);
            XMLDocument.Active:=True;
            XMLDocument.Version:='1.0';
            XMLDocument.LoadFromXML(XMLData);
            XMLNode:=XMLDocument.DocumentElement.ChildNodes['Record'];
            i:=0;
            if XMLNode.ChildNodes['ID'].Text <>'' then
            while XMLNode <> nil do
            begin
              LItem := mTasksForm.TasksListView.Items.AddItem;

              with LItem do
              begin
                Text := XMLNode.ChildNodes['LOCATION'].Text;

                Detail := XMLNode.ChildNodes['DESC'].Text +
                            SLineBreak+
                            'Assigned To: '+XMLNode.ChildNodes['NAME'].Text

                tag := StrToInt(XMLNode.ChildNodes['ID'].Text);
                color := TRectangle.Create(nil);
                with color do
                begin
                  if XMLNode.ChildNodes['STATUS'].Text = STATUS_DONE then
                    fill.Color := TAlphaColors.Lime  
                  else if XMLNode.ChildNodes['STATUS'].Text = STATUS_OK then
                    fill.Color := TAlphaColors.Yellow
                  else
                    fill.Color := TAlphaColors.Crimson;
                  stroke.Color := fill.Color;
                  ButtonText := XMLNode.ChildNodes['STATUS'].Text;
                end;
                Bitmap := Color.MakeScreenshot;
              end;
              XMLNode:=XMLNode.NextSibling;
            end;
          finally
            mTasksForm.TasksListView.EndUpdate;
            for i := 0 to mTasksForm.TasksListView.Controls.Count-1 do
            begin
              if mTasksForm.TasksListView.Controls[I].ClassType = TSearchBox then
              begin
                SearchBox := TSearchBox(mTasksForm.TasksListView.Controls[I]);
                Break;
              end;
            end;
            SearchBox.Text:=' ';
            SearchBox.text := ''; //have in here because if the searchbox has text, when attempting to add items then app crashes
          end;
        end)
      else
        error := 'Please check internet connection.';
  finally
    synchronize(
    procedure
    begin
      if error <> '' then
        ShowMessage('Erorr: '+error);

      mTasksForm.Spinner.Visible:=false;
      mTasksForm.SyncTimer.Enabled:=false;
    end);
  end;
end;

here is the GETSQL method

function GetSQL(SQL:String;var XMLData:String):Boolean;
var
  PostResult,
  ReturnCode          : String;
  PostData            : TStringList;
  IdHTTP              : TIdHTTP;
  XMLDocument         : IXMLDocument;
  XMLNode             : IXMLNode;

  Test                : String;
begin
  Result:=False;
  XMLData:='';
  XMLDocument:=TXMLDocument.Create(nil);
  IdHTTP:=TIdHTTP.Create(nil);
  PostData:=TStringList.Create;
  PostData.Add('session='+SessionID);
  PostData.Add('database='+Encode(DATABASE,''));
  PostData.Add('sql='+Encode(SQL,''));
  IdHTTP.Request.ContentEncoding:='UTF-8';
  IdHTTP.Request.ContentType:='application/x-www-form-urlencoded';
  IdHTTP.ConnectTimeout:=100000;
  IdHTTP.ReadTimeout:=1000000;
  try
    PostResult:=IdHTTP.Post(SERVER_URL+GET_METHOD,PostData);
    XMLDocument.Active:=True;
    XMLDocument.Version:='1.0';
    test := Decode(PostResult,'');
    XMLDocument.LoadFromXML(Decode(PostResult,''));
    XMLNode:=XMLDocument.DocumentElement;
    try
      ReturnCode:=XMLNode.ChildNodes['status'].Text;
    except
      ReturnCode:='200';
    end;
    if ReturnCode='' then begin
      ReturnCode:='200';
    end;
    if ReturnCode='200' then begin
      Result:=True;
      XMLData:=Decode(PostResult,'');
    end;
  except
    on E: Exception do begin
      result:=false;
    end;
  end;
  PostData.Free;
  IdHTTP.Free;
end;

Recommended topics

Hot tags