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;

Comments are closed.