{$mode objfpc}{$H+}
{$ModeSwitch pChartoString}
{$define UseCThreads}
interface
uses
{$IFDEF UNIX}
{$IFDEF UseCThreads}
cthreads,
{$ENDIF}
{$ENDIF}
Interfaces,
...
...
const
{$IFDEF MSWINDOWS}
EmpyreanAPIDLL = 'DbXServerAPI.dll';
libEmpyreanCrypto = 'libEmpyreanCrypto.dll';
{$ENDIF MSWINDOWS}
{$IFDEF DARWIN}
EmpyreanAPIDLL = 'libdbxserverapi.dylib';
{$linklib libdbxserverapi.dylib}
libEmpyreanCrypto = 'libEmpyreanCrypto.dylib';
{$linklib libEmpyreanCrypto.dylib}
{$ENDIF DARWIN}
...
...
type
TgetStatusThread = class(TThread)
private
fStatusText: string;
eMail: string;
procedure ShowStatus;
protected
procedure Execute; override;
public
Constructor Create(CreateSuspended : boolean);
end;
...
...
function checkUserStatus(loginName: pChar; out successBoolean: pChar; out responseMessage: pChar; out errorCode: pChar; out errorMessage: pChar) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external EmpyreanAPIDLL;
...
...
constructor TgetStatusThread.Create(CreateSuspended : boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := True;
end;
...
...
procedure TfEMPServerTest.bCheckUserStatusClick(Sender: TObject);
var
getStatusThread: TgetStatusThread;
begin
WriteLog('DEBUG', 'in TfEMPServerTest.bCheckUserStatusClick');
getStatusThread := TgetStatusThread.Create(True);
WriteLog('DEBUG', 'before start');
getStatusThread.Email := checkUserStatusEmailEdit.Text;
getStatusThread.Start; // START THE THREAD - YES THIS WORKS
WriteLog('DEBUG', 'after start');
end;
procedure TgetStatusThread.ShowStatus;
// this method is executed by the mainthread and can therefore access all GUI elements.
begin
fEMPServerTest.Memo1.Lines.Add('Status Returned: ' + fStatusText);
showmessage('TgetStatusThread.ShowStatus Status Returned: ' + fStatusText);
WriteLog('DEBUG', 'Status Returned: ' + fStatusText);
end;
procedure TgetStatusThread.Execute;
var
successBoolean: pChar;
responseMessage: pChar;
errorCode: pChar;
errorMessage: pChar;
ReturnResult: integer;
newStatus : string;
begin
Writelog('DEBUG', 'In TgetStatusThread.Execute Thread'); // I DEFINATELY GET HERE AND THE LOG IS WRITTEN TO
fStatusText := 'TgetStatusThread Starting...';
Writelog('DEBUG', fStatusText);
Synchronize(@Showstatus);
fStatusText := 'TgetStatusThread Running...';
Writelog('DEBUG', fStatusText);
Synchronize(@Showstatus);
responseMessage := 'Nil Response';
ReturnResult := checkUserStatus(pChar(Email), successBoolean, responseMessage, errorCode, errorMessage); // THIS IS A CALL TO A FUNCTION IN A DYLIB AND IT HANGS HERE
WriteLog('DEBUG', 'TgetStatusThread.Execute after checkUserStatus'); // NEVER EXECUTED
fStatusText := 'Return Result: ' + inttostr(ReturnResult) + #13#10 + 'Response: ' + string(responseMessage);
Synchronize(@Showstatus);
fStatusText := 'TgetStatusThread Terminating...';
Synchronize(@Showstatus);
WriteLog('DEBUG', fStatusText);
while (not Terminated) and (responseMessage = 'Nil Response')do
begin
NewStatus := 'TgetStatusThread Update';
Writelog('DEBUG', NewStatus);
if NewStatus <> fStatusText then
begin
fStatusText := newStatus;
Writelog('DEBUG', 'TgetStatusThread Loop synchronize');
Synchronize(@Showstatus);
end;
end;
end;