i'm trying to call a procedure within a class using super object, but it won't work, what am i doing wrong here ?
Code sample:
program test_rpc;
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
SysUtils, superobject;
type
TCC = class(TObject)
published
procedure controler_method1(const This, Params: ISuperObject; var Result: ISuperObject);
end;
procedure TCC.controler_method1(const This, Params: ISuperObject; var Result: ISuperObject);
var
i: Integer;
begin
write('action called with params ');
writeln(Params.AsString);
end;
var
s: ISuperObject;
CC: TCC;
begin
CC := TCC.Create;
s := TSuperObject.Create;
s.M['controler.action1'] := CC.MethodAddress('controler_method1');
try
s['controler.action1("HHAHAH")'];
finally
s := nil;
writeln('Press enter ...');
readln;
end;
end.
that will crash, what am i doing wrong here ?
it actually gets to "action called with Params" but fails to show the param...
The super method has signature as follows:
TSuperMethod = procedure(const This, Params: ISuperObject;
var Result: ISuperObject);
This means that you cannot use an instance method since an instance method has an incompatible signature. Your method must look like this:
procedure sm(const This, Params: ISuperObject; var Result: ISuperObject);
begin
....
end;
The reason you get a runtime error rather than a compile time error is that you abandoned the type system by using the # operator. Remove the # and your program will fail at compile time with an error message that is a terser version of what I said above.
It's one of the great fallacies of Delphi programming that one must use the # operator to obtain a function pointer. It's a bad habit that you would do well to unlearn.
Related
There's an overloaded version of the Execute function of the TDBXCallback calls in Data.DBXJSon that looks like this
function Execute(Arg: TObject): TObject; overload; virtual; abstract;
Which in my Datasnap client, I've implemented like this:
type
ServerChannelCallBack = class(TDBXCallback)
public
function Execute(const Arg: TJSONValue): TJSONValue; overload; override; // this works!
function Execute(Arg: TObject): TObject; overload; override; // this doesn't
end;
function ServerChannelCallBack.Execute(Arg: TObject): TObject;
var
i: Integer;
begin
Result := TObject.Create; // is this correct?
try
if Arg is TStringList then
begin
FormClient.QueueLogMsg('ServerChannel', 'Got TStringList');
for i := 0 to TStrings(Arg).Count - 1 do
FormClient.QueueLogMsg('ServerChannel', TStringList(Arg)[i]);
end;
finally
end;
end;
This is called from the Datasnap server like this:
procedure TFormServer.Button2Click(Sender: TObject);
var
sr: TStringList;
begin
sr := TStringList.Create;
try
sr.Add('one');
sr.Add('two');
ServerContainer2.DSServer1.BroadcastObject('SERVERCHANNEL', sr);
finally
// sr
end;
end;
This is following on from an example in the video presented by Matt DeLong
Heavyweight Callbacks with DataSnap - Part 1: Thick Client
The callback works perfectly, but only exactly once! On the second call from the server (Button2Click), I get an AV in the client. It might be a bug in the DBX code. I don't know. I can't trace in there. Or perhaps I have initialized the Result from the ServerChannelCallBack.Execute incorrectly. Any assistance is appreciated.
UPDATE
The callback is registered on the client like this:
TFormClient = class(TForm)
CMServerChannel: TDSClientCallbackChannelManager;
...
private
ServerChannelCBID: string;
...
procedure TFormClient.FormCreate(Sender: TObject);
begin
ServerChannelCBID := DateTimeToStr(now);
CMServerChannel.RegisterCallback(
ServerChannelCBID,
ServerChannelCallback.Create
);
...
I'm basing this answer on the DataSnap Server + Client projects which can be downloaded from inside Delphi Seattle using `File | Open from version control'
https://radstudiodemos.svn.sourceforge.net/svnroot/radstudiodemos/branches/RadStudio_XE/Delphi/DataSnap/CallbackChannels
that's mentioned here: http://edn.embarcadero.com/article/41374.
The forms in both the server and client require a slight correction to get them to compile, name to add JSon to their Uses list.
On the server form, I've added the following:
procedure TForm3.Button1Click(Sender: TObject);
var
sr: TStringList;
begin
Inc(CallbackCount); // A form variable
sr := TStringList.Create;
try
sr.Add('Callback: ' + IntToStr(CallbackCount));
sr.Add('two');
ServerContainer1.DSServer1.BroadcastObject('ChannelOne', sr);
finally
// No need for sr.free
end;
end;
(I'm using ChannelOne for consistency with the client)
and on the client I have:
function TCallbackClient.Execute(Arg: TObject): TObject;
var
i: Integer;
begin
// Result := TObject.Create; // is this correct?
Result := TJSONTrue.Create;
try
if Arg is TStringList then
begin
QueueLogValue('Server: Got TStringList');
for i := 0 to TStrings(Arg).Count - 1 do
QueueLogValue('Server:' + TStringList(Arg)[i]);
end;
finally
end;
end;
With those variations from the code you've shown in your q, the server and client run fine, and I can click the server button as many times as I like and neither the server nor any of the clients get "stuck". So I think your problem must be specific to something in the code you are using, but at least the linked project gives you something to work from and compare with.
Btw, I changed the TCallbackClient.Execute return type to TJSONTrue.Create (same as the other override) because that's what it says in Marco Cantu's Delphi 2010 Handbook says it should return, admittedly in the context of a "lightweight" callback while a ServerMethod is executing: returning TJSONFalse tells the server to cancel the executing ServerMethod. However, the callbacks from the server work equally well with the TObject.Create you used.
This simple program doesn't compile. [Tested with XE5 and D10.]
program Project10;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.Classes;
function MakeProc: TThreadProcedure;
begin
Result := procedure begin end;
end;
begin
TThread.Queue(nil, MakeProc);
end.
Compiler reports error
[dcc32 Error] Project10.dpr(16): E2250 There is no overloaded version of 'Queue' that can be called with these arguments
in the TThread.Queue call.
Class TThread implements two Queue overloads.
class procedure Queue(const AThread: TThread; AMethod: TThreadMethod); overload; static;
class procedure Queue(AThread: TThread; AThreadProc: TThreadProcedure); overload; static;
I'm pretty sure that my code should match the second overload.
The only workaround I was able to find is this:
TThread.Queue(nil, procedure begin MakeProc; end);
Am I doing something wrong or is this a compiler bug? Is there a better workaround than my ugly hack?
The compiler evidently thinks you're trying to pass MakeProc itself as the argument. You can tell the compiler that you intend to call that function instead by adding parentheses, just as you would if the function took parameters:
TThread.Queue(nil, MakeProc());
Your workaround wouldn't seem to work. It would compile and run, but the function returned by MakeProc would never execute. Instead, the anonymous method wrapping MakeProc would run, call MakeProc, and then discard that function's result. (Since the function's result doesn't do anything in the code you've provided, you might not have noticed the difference.)
TThread.Queue method takes anonymous procedure as an argument. You cannot reference usual procedure in place of anonymous procedure. But you can call overloaded TThread.Queue method which takes class method reference as an argument. See example below:
type
TMyTestClass = class
public
procedure ThreadProc;
end;
{ TMyTestClass }
procedure TMyTestClass.ThreadProc;
begin
WriteLn('We are in thread');
end;
var
MyTestClass: TMyTestClass;
begin
with TMyTestClass.Create do
try
TThread.Queue(nil, ThreadProc);
finally
Free;
end;
end.
In a common Delphi pattern, i am passing a value as an untyped const to a function:
procedure DoSomething(const Something; SomethingLength: Integer);
begin
//...
end;
In this example, i happen to be passing Windows FORMATETC structure:
procedure Test;
var
omgp: TFormatEtc;
begin
omgp := Default(TFormatEtc);
omgp.cfFormat := RegisterClipboardFormat('CF_PNG');
omgp.ptd := nil;
omgp.dwAspect := DVASPECT_CONTENT or DVASPECT_THUMBNAIL;
omgp.lindex := -1; //all pages
omgp.tymed := TYMED_HGLOBAL;
DoSomething(omgp, SizeOf(omgp));
end;
I need to get the address of this data, so i can pass it to an underlying Windows function something that requires the pointer to the data.
In order to do this, i have always used Pointer(#data):
procedure DoSomething(const Something; SomethingLength: Integer);
begin
SomethingThatNeedsAPointer(Pointer(#Something));
end;
Until this one API call, in one particular case, is failing (it's returning the wrong values). For no particular reason, I happened to look closely at the pointer value being passed. When i was checking everythe parameter value in the debugger i noticed something horrifying. I noticed that:
#Something
Pointer(#Something)
return different values.
#Something should already be a pointer
Pointer(#Something) should be a redundant cast
Which way is the right way to get the address of untyped data?
Edit: People went to lunch on something unrelated to the question. I've edited the question so that hopefully people will focus on the question, and not the example.
This is a debugger bug, whereby the debugger is mis-reporting the value of Pointer(#Salt). I can reproduce the fault in XE5, XE6 and XE7, but not in XE4 and XE8. So it seems that this is a defect introduced in XE5 and removed in XE8.
Whenever you see an issue like this, a debugger fault is always a possibility. In this case we can demonstrate that the fault lies in the debugger with this program:
{$APPTYPE CONSOLE}
uses
System.SysUtils;
procedure DoSomething(const Salt; SaltLength: Integer);
begin
Writeln(IntToHex(NativeUInt(Pointer(#Salt)), 8));
Writeln(IntToHex(NativeUInt(#Salt), 8));
end;
procedure Test;
var
salt: AnsiString;
begin
salt := 'salt';
DoSomething(salt[1], Length(salt));
end;
begin
Test;
end.
This program outputs:
007C9BD4
007C9BD4
even though #Salt and Pointer(#Salt) are accorded different values by the debugger.
Note that this program
{$APPTYPE CONSOLE}
procedure DoSomething(const Salt; SaltLength: Integer);
var
i: Integer;
P: PAnsiChar;
begin
P := #Salt;
for i := 0 to SaltLength-1 do
begin
Writeln(P^);
inc(P);
end;
end;
procedure Test;
var
salt: AnsiString;
begin
salt := 'salt';
DoSomething(salt[1], Length(salt));
end;
begin
Test;
end.
outputs:
s
a
l
t
I cannot reproduce your case in XE8.
The debugger shows same address for both #Salt and Pointer(#Salt).
Likewise the output of this test snippet is identical.
I can only assume that what the debugger is telling you is untrue somehow.
(Update: A test in XE7 reproduces the error in the debugger. The outcome of the snippet is the same though.)
program Test;
{$APPTYPE CONSOLE}
procedure Test1(p: Pointer);
begin
WriteLn(Cardinal(p));
end;
procedure Test(const Salt);
begin
Test1(#Salt);
Test1(Pointer(#Salt));
Test1(Addr(Salt));
end;
var
s:AnsiString;
begin
s := 'Test';
Test( s[1]);
ReadLn;
end.
I recently migrated from D2010 to DXE2 and found a showstopper bug (Or feature?) in XE2 and XE3 (Tested in my friend XE3) related to RTTI generation for TBytes fields inside classes.
I found that the RTTI information for a TBytes variable inside a class is never generated.
The following code works well in D2010, but shows the message "Error" in XE2/XE3
Does anyone have any clue? This will totally break all our software data serialization implementation
To test the code please add Rtti unit to the uses declaration
type
TMyClass = class
public
Field1: Integer;
Field2: TBytes;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
i: Integer;
Data: TMyClass;
Rtti: TRttiContext;
RttiClassType: TRttiInstanceType;
begin
Data := TMyClass.Create;
try
// Get the context
Rtti := TRttiContext.Create;
try
// Get the type for the class
RttiClassType := TRttiInstanceType(Rtti.GetType(Data.ClassInfo));
// Check the fields
for i := 0 to High(RttiClassType.GetFields) do
begin
// Check the field type
if not Assigned(RttiClassType.GetFields[i].FieldType) then
ShowMessage('Error');
end;
finally
Rtti.Free;
end;
finally
Data.Free;
end;
end;
The error message will be displayed when checking for Field2 that is a TBytes becayse the FieldType is always nil!!!
Does anyone has any clue of what have changed in the RTTI from D2010 do XE2? Maybe because the TBytes type was changed from array of Byte to the generic array?
You can fix this error (it is actually not the same bug as the one Mason mentioned).
type
FixTypeInfoAttribute = class(TCustomAttribute)
public
FTypeInfo: PPTypeInfo;
constructor Create(TypeInfo: PTypeInfo);
end;
procedure FixFieldType(TypeInfo: PTypeInfo);
var
ctx: TRttiContext;
t: TRttiType;
f: TRttiField;
a: TCustomAttribute;
n: Cardinal;
begin
t := ctx.GetType(TypeInfo);
for f in t.GetFields do
begin
for a in f.GetAttributes do
begin
if (a is FixTypeInfoAttribute) and f.ClassNameIs('TRttiInstanceFieldEx') then
begin
WriteProcessMemory(GetCurrentProcess, #PFieldExEntry(f.Handle).TypeRef,
#FixTypeInfoAttribute(a).FTypeInfo, SizeOf(Pointer), n);
end;
end;
end;
end;
constructor FixTypeInfoAttribute.Create(TypeInfo: PTypeInfo);
begin
FTypeInfo := PPTypeInfo(PByte(TypeInfo) - SizeOf(Pointer));
end;
Then you add the attribute to your class definition:
type
TMyClass = class
private
Field1: Integer;
[FixTypeInfo(TypeInfo(TBytes))]
Field2: TBytes;
end;
and make sure the FixFieldType routine is called:
initialization
FixFieldType(TypeInfo(TMyClass));
Tested on XE
This is a known issue that was fixed in XE3. Unfortunately, upgrading is the only way to get a fix for it; bug fixes don't usually get ported back.
EDIT: Or not. Apparently this is not actually fixed, as it still occurs in XE3. Reporting it as a new case and mentioning 103729 would probably be the best course of action.
can anyone tell me why I get "Return value ... might be undefined" here:
function TXMLAcceptorBCOLSubmission.createRecordsInBCFEEPAR(AXML: TRipXMLElement): String;
var
...
begin
Result := '';
I am using Delphi 5 and it looks like the problem is caused by declaring more than 30 variables (I know, I know). It doesn't seem to matter what they are called or what types they are.
Following code doesn't generate a warning using Delphi 5 so
either it is a bug in an other Delphi version (you should mention the version you use)
or either it is something you didn't show us yet.
Code
program ProveAPoint;
{$APPTYPE CONSOLE}
uses SysUtils;
type
TRipXMLElement = record
end;
TXMLAcceptorBCOLSubmission = class
public
function createRecordsInBCFEEPAR(AXML: TRipXMLElement): string;
end;
function TXMLAcceptorBCOLSubmission.createRecordsInBCFEEPAR(AXML: TRipXMLElement): String;
begin
Result := '';
end;
var
AXML: TRipXMLElement;
begin
with TXMLAcceptorBCOLSubmission.Create do
begin
createRecordsInBCFEEPAR(AXML);
Free;
end;
end.