I am trying to make a callback, sending different object types and some extra info for the objects. So I made this class:
TCallBackObject = class
Sender : string;
ObjectClass : string;
Obj : TObject;
Status : integer;
ID : integer;
end;
In different situations I create different Objects in the Obj field, but I always get the error message when executing DSServer.BroadcastObject "Internal: Cannot instantiate object ..."
Here is my really simple example: http://www.4shared.com/file/fONlAGM3/DataSnapExample.html
Please see the example and tell me what is wrong...
On the client side, the objects classes are not in the executable.
To be sure, try this dirty check. Create a reference in the client code referring to the used classes.
eg.
TForm6 = class(TForm)
SQLConnection1: TSQLConnection;
DSClientCallbackChannelManager1: TDSClientCallbackChannelManager;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure OnExecute(AValue: TObject);
private
c: TCat; //dummy refernce to the class
d: TDog; //dummy refernce to the class
co: TCAllbackObject; //dummy refernce to the class
public
{ Public declarations }
end;
Now it should works.
A cleaner way is to use an empty register class method for each classes. As the following:
TCallBackObject = class
Sender: string;
ObjectClass: string;
Obj: TObject;
Status: integer;
ID: integer;
class procedure Register;
end;
...
class procedure TCallBackObject.Register;
begin
//
end;
initialization
TCallBackObject.Register;
end.
Related
I am calling a function for SOAP service and one of the required parameters is TWideStringDynArray. How do I initialize and populate this type of array? Or is there another way to convert a normal array to this type?
This is how it's defined in SOAP class
...
ArrayOfString = TWideStringDynArray;
...
PrsDataGet = class(TRemotable)
private
FsRetVal: WideString;
FsInParam: ArrayOfString;
published
property sRetVal: WideString read FsRetVal write FsRetVal;
property sInParam: ArrayOfString read FsInParam write FsInParam;
end;
If i set FsInParam as a array of WideString it says incompatible types
procedure TForm1.Button1Click(Sender: TObject);
var
QuotePrice : Real;
rezultat:WideString;
mnozica:array [0..4] of integer;
parametri: array of WideString;
obstaja:boolean;
PrsGet:PrsDataGet;
PrsFind:PrsDataGet;
begin
PrsGet.sRetVal :=rezultat;
SetLength(parametri, 4);
parametri[0]:= '1234';
parametri[1]:= 'wsprsinfotest';
parametri[2]:= 'efwefawf';
parametri[3]:= 'PRS_MN_P';
PrsGet.sInParam :=parametri;
If i change type of parametri to ArrayOfString it doesn't complain of incompatible types anymore but then it throws an Access Violation at SetLength(parametri, 4);
EDIT
To reproduce the problem:
I import WSDL definition into delphi from https://wwwt.ajpes.si/wsPrsInfo/PrsInfo.asmx?WSDL
Code for the service call:
unit UnKlicServisa;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Rio, SoapHTTPClient,Types,
UnWsPrsInfo_1, UnWsPrsInfo_2;
type
TForm1 = class(TForm)
HTTPRIO1: THTTPRIO;
Edit1: TEdit;
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
rezultat:WideString;
parametri: ArrayOfString;
obstaja:boolean;
PrsGet:PrsDataGet;
begin
PrsGet.sRetVal :=rezultat;
parametri[0]:= '1234';
parametri[1]:= 'wsprsinfotest';
parametri[2]:= '3423445';
parametri[3]:= 'PRS_MN_P';
PrsGet.sInParam :=parametri;
if Trim(Edit1.Text) <> '' then
begin
(HTTPRIO1 as PrsInfoSoap).PrsDataGet(PrsGet);
end
else
begin
MessageDlg('Enter a Valid ISBN code',mtInformation,[mbOk],0);
Edit1.SetFocus;
end;
end;
end.
Note FPC 3.2.0+ also allows array constructors
{$mode Delphi}
uses types;
var arr : TWideStringDynArray;
begin
arr:=TWideStringDynArray.Create('1234','wsprsinfotest','efwefawf','PRS_MN_P');
end.
I have the following class hierarchy
I would like to be able to dynamically assign anonymous methods which operate on objects of both types TB and TC.
So here is a simple contrived example:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TNotifyEventWrapper = class
private
FProc: TProc<TObject>;
public
constructor Create(Proc: TProc<TObject>);
published
procedure Event(Sender: TObject);
end;
IA = interface
procedure Foo;
end;
TA = class(TInterfacedObject)
procedure Foo;
end;
TB = class(TA, IA)
procedure Foo;
end;
TC = class(TA, IA)
procedure Foo;
end;
TControl = class
strict private
public
class var NEW : TNotifyEventWrapper;
class var Foo : TNotifyEvent;
class function GetWrapper<T:TA, IA, constructor>(D: T): TNotifyEventWrapper;
class procedure AssignFooHandler<T:TA, IA, constructor>;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TC.Foo;
begin
ShowMessage('TC.Foo');
end;
class function TControl.GetWrapper<T>(D: T): TNotifyEventWrapper;
begin
Result :=
TNotifyEventWrapper.Create
(
procedure (S : TObject)
begin
T(D).Foo;
end
);
end;
class procedure TControl.AssignFooHandler<T>;
var
X : T;
begin
X := T.Create;
try
TControl.NEW := TControl.GetWrapper<T>(X);
TControl.Foo := TControl.NEW.Event;
finally
FreeAndNil(X);
end;
end;
procedure TA.Foo;
begin
ShowMessage('TA.Foo');
end;
procedure TB.Foo;
begin
ShowMessage('TB.Foo');
end;
constructor TNotifyEventWrapper.Create(Proc: TProc<TObject>);
begin
inherited Create;
FProc := Proc;
end;
procedure TNotifyEventWrapper.Event(Sender: TObject);
begin
FProc(Sender);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TControl.Foo(Sender);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TControl.AssignFooHandler<TC>; //TB
end;
end.
I would like to be able to call
TControl.AssignFooHandler<TC>;
And have the TControl.Foo(Sender); method invoke TC.Foo
Also I want TControl.AssignFooHandler<TB>; to result in TControl.Foo(Sender); invoking TB.Foo
Unfortunately, when I run this, it always invokes the base class method TA.Foo.
I'm not sure how to get around this.
Your Generic is constrained to descendants of TA and IA. TA.Foo is not declared as virtual, and T(B|C).Foo() are not declared to override it. That is why TA.Foo() is being called every time. You need to make TA.Foo() virtual and T(B|C).Foo override it, then T(B/C).Foo will get called as expected.
Also, you are freeing the T(A/B/C) object that you are passing to TControl.GetWrapper() before TControl.Foo() ever gets a chance to invoke the Foo() method of that object. In this particular example, it is OK since none of the Foo() methods access any object member fields, but once you start doing that in actual production code, it is likely to crash. You need to keep the T(A/B/C) object alive until you are done using the TNotifyEventWrapper object.
I am trying to compose my own ThreadManager unit in Delphi and I have this so far:
unit uThreadManager;
interface
uses
Classes,
Windows;
type
TCustomTThread = class (TThread)
public
TaskData : Pointer;
end;
type
TWorkerThread = class(TObject)
private
TaskDataList : TList;
TaskDataListCrit : TRTLCriticalSection;
function ReadTotalTasks : Integer;
public
constructor Create;
destructor Destroy; override;
property TotalTasks : Integer read ReadTotalTasks;
function AddTask(Thread: TCustomTThread; Data: Pointer) : Integer;
procedure Delete (Index : Integer);
end;
implementation
type
PTaskData = ^TTaskData;
TTaskData = record
Thread : TCustomTThread;
TaskPointer : Pointer;
end;
procedure TWorkerThread.Delete(Index: Integer);
var
TaskData : PTaskData;
begin
EnterCriticalSection(TaskDataListCrit);
TaskData := TaskDataList.Items[Index];
TaskDataList.Delete(Index);
LeaveCriticalSection(TaskDataListCrit);
TaskData^.Thread.Free;
Dispose(TaskData);
end;
function TWorkerThread.ReadTotalTasks;
begin
EnterCriticalSection(TaskDataListCrit);
result := TaskDataList.Count;
LeaveCriticalSection(TaskDataListCrit);
end;
destructor TWorkerThread.Destroy;
begin
DeleteCriticalSection(TaskDataListCrit);
TaskDataList.Free;
inherited;
end;
constructor TWorkerThread.Create;
begin
inherited;
InitializeCriticalSection(TaskDataListCrit);
TaskDataList := TList.Create;
end;
function TWorkerThread.AddTask(Thread: TCustomTThread; Data: Pointer) : Integer;
var
NewTask : PTaskData;
begin
EnterCriticalSection(TaskDataListCrit);
New(NewTask);
// I would like to create a new instance of TCustomTThread here!
//NewTask^.Thread := ...
NewTask^.TaskPointer := Data;
result := TaskDataList.Add (NewTask);
LeaveCriticalSection(TaskDataListCrit);
end;
end.
I came across the problem with the parameter from my AddTask procedure...
Here is an example on what I am trying to do:
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, uThreadManager;
type
TForm2 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
type
TTheCustomThread = class (TCustomTThread)
public
procedure Execute; override;
end;
implementation
{$R *.dfm}
procedure TTheCustomThread.Execute;
begin
// My Code
end;
procedure TForm2.Button1Click(Sender: TObject);
var
NewWorkerThread : TWorkerThread;
begin
NewWorkerThread := TWorkerThread.Create;
NewWorkerThread.AddTask(TTheCustomThread, NIL);
end;
end.
this code gives me the error:
[dcc32 Error] Unit2.pas(42): E2010 Incompatible types:
'TCustomTThread' and 'class of TTheCustomThread'
I could fix this by declaring a new TTheCustomThread var in the stack but I would like to avoid this cause I won't need it at all later and AddTask will create a new instance of TTheCustomThread. I could use TClass and then typecast to TCustomThread but I was wondering if there's anything else to make this work.
Thank you for your help.
Your function AddTask is defined as so:
function AddTask(Thread: TCustomTThread; Data: Pointer) : Integer;
The first parameter that you pass is of type TCustomTThread. That is an instance of TCustomTThread.
You call the function like this:
AddTask(TTheCustomThread, nil);
Here you pass the class rather than an instance. Hence the compiler error.
Now, it seems that what you want to do is pass the class. Inside AddTask you wish to receive a class and then create a new instance. Declare a class type like so:
type
TTheCustomThreadClass = class of TTheCustomThread;
Change AddTask to receive that type:
function AddTask(ThreadClass: TCustomTThreadClass; Data: Pointer) : Integer;
And inside the implementation, create an instance like this:
NewTask^.Thread := ThreadClass.Create;
Very likely you will want to declare the constructor of TTheCustomThread to be virtual to allow derived classes the freedom to define constructors that can be executed from your factory creation mechanism.
I am new to Delphi and have a problem with creating a new form dynamically. I want to create the new form with the elements properties from the gui I made. Here is the form I want to dynamically create :
unit AddEmployeeF;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TAddEmployee = class(TForm)
GroupBox1: TGroupBox;
AddName: TLabel;
AddDept: TLabel;
AddPhone: TLabel;
AddExtension: TLabel;
AddDetails: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure CancelButtonClick(Sender: TObject);
private
{ Private declarations }
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
end;
var
AddEmployee: TAddEmployee;
implementation
{$R *.dfm}
constructor TAddEmployee.CreateNew(AOwner: TComponent; Dummy: Integer = 0; Detail : String);
begin
inherited Create(AOwner);
AddDetails.Caption := Detail;
end;
procedure TAddEmployee.CancelButtonClick(Sender: TObject);
begin
self.Close;
end;
end.
I dont want to create all the gui elements again in the constructor, just to modificate some properties of the elements, like caption but keep the positions and other properties from the gui definition. It's possible? And how to create the form from another form, like this? :
procedure TWelcome.SpeedButton1Click(Sender: TObject);
var
myForm :TAddEmployee;
begin
myForm := TAddEmployee.CreateNew(AOwner, Dummy, Details);
myForm.ShowModal;
end;
You overrode the wrong constructor. The TForm.CreateNew() constructor bypasses DFM streaming, so all of your design-time components will not be created at run-time. Worse, your overridden CreateNew() constructor is calling the inherited TForm.Create() constructor, which calls CreateNew() internally, thus you will get stuck in an endless loop that causes an stack overflow error at runtime.
To do what you are asking for, override the TForm.Create() constructor instead, or define a whole new constructor that calls TForm.Create() internally. Do not involve TForm.CreateNew() at all.
type
TAddEmployee = class(TForm)
...
public
constructor Create(AOwner: TComponent); override; // optional
constructor CreateWithDetail(AOwner: TComponent; Detail : String);
end;
constructor TAddEmployee.Create(AOwner: TComponent);
begin
CreateWithDetail(AOwner, 'Some Default Value Here');
end;
constructor TAddEmployee.CreateWithDetail(AOwner: TComponent; Detail : String);
begin
inherited Create(AOwner);
AddDetails.Caption := Detail;
end;
procedure TWelcome.SpeedButton1Click(Sender: TObject);
var
myForm : TAddEmployee;
begin
myForm := TAddEmployee.CreateWithDetail(AOwner, Details);
myForm.ShowModal;
myForm.Free;
end;
Declare your constructor like this:
constructor Create(AOwner: TComponent; const Detail: string); reintroduce;
Implement it like this:
constructor TAddEmployee.Create(AOwner: TComponent; const Detail: string);
begin
inherited Create(AOwner);
AddDetails.Caption := Detail;
end;
Call it like this:
myForm := TAddEmployee.Create(MainForm, Details);
I'm not sure what you want to pass as the owner. Could be the main form, could be something else.
You should also remove the global variable named AddEmployee and so force yourself to take control over instantiating the form.
I chose to name my constructor Create, and so hide the inherited constructor of that name, to force consumers of the class to supply the Details parameter in order to make an instance of the class.
I have a TForm as this:
TMyForm = class (TForm)
[MyAttr('Data')]
edit1: TEdit;
private
FData: String;
end
When I try to get the fields of this form via RTTI, I only get the edit1 field, not FDATA, and when I query for edit1 field attributes a get a empty array.
For anoteher class that not inherit TForm, all work ok. ¿why?
edit for sample
type
{$RTTI EXPLICIT FIELDS([vcPrivate,vcProtected, vcPublic])}
TForm3 = class(TForm)
[TCustomAttribute]
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
[TCustomAttribute]
FData: String;
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
procedure TForm3.Button1Click(Sender: TObject);
var
LCtx: TRttiContext;
LField: TRttiField;
LAttr: TCustomAttribute;
begin
for LField in LCtx.GetType(Self.ClassInfo).GetDeclaredFields do
begin
Memo1.Lines.Add(lField.Name);
for LAttr in LField.GetAttributes do
Memo1.Lines.Add(#9+LAttr.ClassName);
end;
end;
end.
result where button1 is clicked:
FData
TCustomAttribute
Button1
Memo1
There could be a $RTTI directive somewhere in your project that's causing extended RTTI to not work.
Try adding the following just before the declaration of TMyForm:
{$RTTI EXPLICIT
METHODS(DefaultMethodRttiVisibility)
FIELDS(DefaultFieldRttiVisibility)
PROPERTIES(DefaultPropertyRttiVisibility)}
This will reset RTTI generation for everything declared after it, and you should get proper RTTI after that point.