Jump to content

Help with Possible Bug in UniGUI


cristianotestai
 Share

Recommended Posts

Hi Farshad,

 

I'm need of your help to solve a possible major bug with UniGui. I am sending attached a TestCase that have two simple projects:

1) TestCaseClient

2) TestCaseServer

 

The TestCaseServer DataSnap is my simple server without any code, just to enable the use of callbacks from customers.

The TestCaseClient is a simple client that sends a Message by recording a CallBackClass. You will see the code, it is very simple.

 

When my TestCaseClient (UniGuiApplication) runs in VCLMode is ok, the message is sent just fine, but if I use StandAloneServer (WebMode) does not work.

I debug and found that the global function "UniMainModule: TUniMainModule" always returns nil in this case, when the thread makes the call:

 

 

{ TMyCallback }

function TMyCallback.Execute(const Arg: TJSONValue): TJSONValue;
begin
  MainForm.QueueLogMsg(Arg.ToString);
  Result := TJSONTrue.Create;
end;

function MainForm: TMainForm;
begin
  Result := TMainForm(UniMainModule.GetFormInstance(TMainForm)); 
end;

function UniMainModule: TUniMainModule;
begin
 if UniApplication<>nil then //UniApplication is always nil with StandAloneServer
   Result := TUniMainModule(UniApplication.UniMainModule)
 else
   Result := TUniMainModule(VCLMainModule);
end;

 

I need to solve this problem urgently as preparing a presentation to some customers and that message management is part of a module of my project.

 

Thanks for help!

 

Best Regards,

 

Cristiano Testai

Brazil

deploy.rar

Link to comment
Share on other sites

  • Administrators

Cristiano made me aware of this problem a while ago.I asked him to share this in forums because I think solution can be helpful for other developers too.

 

First of all, this issue is not a bug. uniGUI objects, both visual and non-visual, are only valid when you access them inside an event generated from a web browser.

 

Let's look at below example:

 

Here is a simple web click event:

 

procedure TMainForm.UniButton1Click(Sender: TObject);
begin
// start of safe zone where uniGUI objects can be accessed


// end of safe zone where uniGUI objects can be accessed
end;

 

In below code MainForm is accessed outside of our safe zone.

 

// TMyCallback is called asynchronously and you can't access uniGUI objects here
function TMyCallback.Execute(const Arg: TJSONValue): TJSONValue;
begin
  MainForm.QueueLogMsg(Arg.ToString);
  Result := TJSONTrue.Create;
end;

 

TMyCallback is called by different mechanisms which are not in sync with uniGUI. i.e. TMyCallback can be called from any thread. uniGUI objects shouldn't be accessed here.

 

 

Solution:

 

The only solution here is synchronizing TMyCallback.with uniGUI events, so uniGUI objects will be accessed from within our safe zone.

 

I modified Main.pas and added required code to synchronize all operations.

 

unit Main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics,
 Controls, Forms, Dialogs, uniGUITypes, uniGUIAbstractClasses,
 uniGUIClasses, uniGUIForm, DBXJSON, DSService, DSProxy, uniEdit, uniMemo,
 uniGUIBaseClasses, uniButton, DBXDataSnap, DBXCommon, DSHTTPCommon, DB,
 SqlExpr;

type
 TMyCallback = class(TDBXCallback)
 private
FCallBackResult : PString;	// This pointer points to call back result 
FCallBackCalled : PBoolean;  // Pointer to boolean which is set when callback is executed
 public
function Execute(const Arg: TJSONValue): TJSONValue; override;
 end;

 TMainForm = class(TUniForm)
UniButton1: TUniButton;
UniMemo1: TUniMemo;
EditMsg: TUniEdit;
SQLConnection1: TSQLConnection;
DSClientCallbackChannelManager1: TDSClientCallbackChannelManager;
procedure UniFormCreate(Sender: TObject);
procedure UniButton1Click(Sender: TObject);
 private
FMyCallbackName: string;

FCalled : Boolean;
FResult : string;
function WaitCallBack(TOut: Integer): Boolean;
procedure InitCallBack;
 public
procedure LogMsg(const s: string);
procedure QueueLogMsg(const s: string);
 end;

function MainForm: TMainForm;

implementation

{$R *.dfm}

uses
 uniGUIVars, MainModule;

function MainForm: TMainForm;
begin
 Result := TMainForm(UniMainModule.GetFormInstance(TMainForm));
end;

{ TMyCallback }

function TMyCallback.Execute(const Arg: TJSONValue): TJSONValue;
begin
 FCallBackResult^:=Arg.ToString;	// capture call back result here
 FCallBackCalled^:=True;   			// signal wiat loop that operation is completed

 Result := TJSONTrue.Create;
end;

procedure TMainForm.LogMsg(const s: string);
begin
 UniMemo1.Lines.Add(DateTimeToStr(Now) + ': ' + s);
end;

procedure TMainForm.InitCallBack;
begin
 FCalled:=False;   // initialize variables
 FResult:='';
end;

// Wait for call back for TOut milliseconds period
function TMainForm.WaitCallBack(TOut: Integer): Boolean;
begin
 while (not FCalled) and (TOut>0) do
 begin
Sleep(1);
Dec(TOut);
 end;
 Result:=FCalled;
end;

procedure TMainForm.QueueLogMsg(const s: string);
begin
 TThread.Queue(nil,
procedure
begin
 	LogMsg(s)
end
 );
end;

procedure TMainForm.UniButton1Click(Sender: TObject);
var AClient: TDSAdminClient;
begin
 // prepare call back variables
 InitCallBack;

 // make call to the server
 AClient := TDSAdminClient.Create(SQLConnection1.DBXConnection);
 try
AClient.BroadcastToChannel(
 	DSClientCallbackChannelManager1.ChannelName,
 	TJSONString.Create(EditMsg.Text)
);
 finally
AClient.Free;
 end;

 // Wait for response from server. Timeout is 1 second
 if WaitCallBack(1000) then
LogMsg(FResult)   // Callback method is executed. Show received message
 else
LogMsg('Timeout');  // Callback timeout
end;

procedure TMainForm.UniFormCreate(Sender: TObject);
var
 FCallBack : TMyCallback;
begin
 // Create callback object
 FCallBack := TMyCallback.Create;

// Assign parameters to pointers. These parameters will be assigned when callback is executed.
 FCallBack.FCallBackResult:=@FResult;
 FCallBack.FCallBackCalled:=@FCalled;

 FMyCallbackName := TDSTunnelSession.GenerateSessionId;
 DSClientCallbackChannelManager1.ManagerId := TDSTunnelSession.GenerateSessionId;
 DSClientCallbackChannelManager1.RegisterCallback(
FMyCallbackName,
FCallback
 );
end;

initialization
 RegisterMainFormClass(TMainForm);

end.

Link to comment
Share on other sites

 

I modified Main.pas and added required code to synchronize all operations.

 

unit Main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics,
 Controls, Forms, Dialogs, uniGUITypes, uniGUIAbstractClasses,
 uniGUIClasses, uniGUIForm, DBXJSON, DSService, DSProxy, uniEdit, uniMemo,
 uniGUIBaseClasses, uniButton, DBXDataSnap, DBXCommon, DSHTTPCommon, DB,
 SqlExpr;

type
 TMyCallback = class(TDBXCallback)
 private
FCallBackResult : PString;	// This pointer points to call back result 
FCallBackCalled : PBoolean;  // Pointer to boolean which is set when callback is executed
 public
function Execute(const Arg: TJSONValue): TJSONValue; override;
 end;

 TMainForm = class(TUniForm)
UniButton1: TUniButton;
UniMemo1: TUniMemo;
EditMsg: TUniEdit;
SQLConnection1: TSQLConnection;
DSClientCallbackChannelManager1: TDSClientCallbackChannelManager;
procedure UniFormCreate(Sender: TObject);
procedure UniButton1Click(Sender: TObject);
 private
FMyCallbackName: string;

FCalled : Boolean;
FResult : string;
function WaitCallBack(TOut: Integer): Boolean;
procedure InitCallBack;
 public
procedure LogMsg(const s: string);
procedure QueueLogMsg(const s: string);
 end;

function MainForm: TMainForm;

implementation

{$R *.dfm}

uses
 uniGUIVars, MainModule;

function MainForm: TMainForm;
begin
 Result := TMainForm(UniMainModule.GetFormInstance(TMainForm));
end;

{ TMyCallback }

function TMyCallback.Execute(const Arg: TJSONValue): TJSONValue;
begin
 FCallBackResult^:=Arg.ToString;	// capture call back result here
 FCallBackCalled^:=True;   			// signal wiat loop that operation is completed

 Result := TJSONTrue.Create;
end;

procedure TMainForm.LogMsg(const s: string);
begin
 UniMemo1.Lines.Add(DateTimeToStr(Now) + ': ' + s);
end;

procedure TMainForm.InitCallBack;
begin
 FCalled:=False;   // initialize variables
 FResult:='';
end;

// Wait for call back for TOut milliseconds period
function TMainForm.WaitCallBack(TOut: Integer): Boolean;
begin
 while (not FCalled) and (TOut>0) do
 begin
Sleep(1);
Dec(TOut);
 end;
 Result:=FCalled;
end;

procedure TMainForm.QueueLogMsg(const s: string);
begin
 TThread.Queue(nil,
procedure
begin
 	LogMsg(s)
end
 );
end;

procedure TMainForm.UniButton1Click(Sender: TObject);
var AClient: TDSAdminClient;
begin
 // prepare call back variables
 InitCallBack;

 // make call to the server
 AClient := TDSAdminClient.Create(SQLConnection1.DBXConnection);
 try
AClient.BroadcastToChannel(
 	DSClientCallbackChannelManager1.ChannelName,
 	TJSONString.Create(EditMsg.Text)
);
 finally
AClient.Free;
 end;

 // Wait for response from server. Timeout is 1 second
 if WaitCallBack(1000) then
LogMsg(FResult)   // Callback method is executed. Show received message
 else
LogMsg('Timeout');  // Callback timeout
end;

procedure TMainForm.UniFormCreate(Sender: TObject);
var
 FCallBack : TMyCallback;
begin
 // Create callback object
 FCallBack := TMyCallback.Create;

// Assign parameters to pointers. These parameters will be assigned when callback is executed.
 FCallBack.FCallBackResult:=@FResult;
 FCallBack.FCallBackCalled:=@FCalled;

 FMyCallbackName := TDSTunnelSession.GenerateSessionId;
 DSClientCallbackChannelManager1.ManagerId := TDSTunnelSession.GenerateSessionId;
 DSClientCallbackChannelManager1.RegisterCallback(
FMyCallbackName,
FCallback
 );
end;

initialization
 RegisterMainFormClass(TMainForm);

end.

 

It worked with the TestCase and also understand the concept of the safe zone.

 

Thanks Farshad!

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...