when implementing an Event with the definition below Spring4D will add and invoke method but will not remove handler ( with IEvent<TaskItemChangeEvent>.Remove(MyProc) ) when asked as it does not identify it.
{$M+}
TaskItemChangeEvent = reference to procedure(const TaskItem: ITaskItem; Event: TTaskListEvent);
The following does work but I do not want to be forced to be bound to an object.
{$M+}
TaskItemChangeEvent = procedure(const TaskItem: ITaskItem; Event: TTaskListEvent) of Object;
I believe the issue is this line in TEventBase.Remove as a reference to procedure is not a TMethod?
if TMethod(handlers[i]) = TMethod(handler) then
The reason is the compiler possibly creating different instances of the anonymous method between the place where you add and where you remove them.
Look at the following code:
var
proc: TProc;
procedure Add(p: TProc);
begin
proc := p;
end;
procedure Remove(p: TProc);
begin
Writeln(PPointer(#proc)^ = PPointer(#p)^);
end;
procedure A;
var
p: TProc;
begin
p := procedure begin end;
Add(p);
Remove(p);
end;
procedure B;
begin
Add(procedure begin end);
Remove(procedure begin end);
end;
procedure C;
begin
Add(A);
Remove(A);
end;
begin
A;
B;
C;
Readln;
end.
You will notice that in B and C it will print False because the two anonymous methods being passed to Add and Remove differ from each other. While in B it's obvious in C it is not but the compiler actually transforms the code into this:
procedure C;
begin
Add(procedure begin A(); end);
Remove(procedure begin A(); end);
end;
That means if you want to use IEvent<> with a method reference type and be able to remove you need to keep the reference that you added in order for them to be equal and thus be able to be found when calling Remove.
The fact that internally in TEventBase the references are all handled as TMethod has nothing to do with that - when passing an anonymous method it is being transformed into a TMethod. After all an anonymous method type is an interface being backed by an object which the compiler creates which makes it possible to do such conversion and causes the necessity to keep the reference that was added in order to remove it.
I have a function inside an object that concatenates JSON text. The function result is a String - the resulting JSON text. The function simply appends text to the end of the result...
function TDestination.GetAsJSON: String;
procedure A(const Text: String);
begin
Result:= Result + Text + sLineBreak;
end;
begin
A(' {');
A(' "name":"'+EncodeStr(FName)+'",');
A(' "directory":"'+EncodeStr(FDirectory)+'",');
A(' "description":"'+EncodeStr(FDescription)+'"');
A(' }');
end;
This function is called repeatedly in a loop from within another parent object...
function TDestinations.GetAsJSON: String;
procedure A(const Text: String);
begin
Result:= Result + Text + sLineBreak;
end;
var
X: Integer;
begin
A(' [');
for X := 0 to Count - 1 do begin
if X > 0 then A(' ,');
Result:= Result + Items[X].AsJSON;
end;
A(' ]');
end;
In the second function, Items[X].AsJSON is calling the first function.
The problem is that the second (and all further) calls to TDestination.GetAsJSON still have the string sitting in the function result from the last time it was called.
The solution is to simply initialize the result with Result:= ''; at the beginning of the function. But the question is why should I have to? Why does this string get left behind?
What makes it puzzling is that each different call to this function is from within a completely separate instance of that object. I would understand if it was the exact same object instance, but it's not.
Guido Gybels in his article "Using Assembler in Delphi" denotes that functions with long string type result return it as implicit var-parameter. So compiler treats your function as:
(hidden)var
temp_s: String;
procedure GetAsJSON(var temps: String);
...
GetAsJSON(temp_s);
UsedResult1 := temp_s;
...
GetAsJSON(temp_s);
UsedResult2 := temp_s;
So hidden string can retain its value under certain conditions.
Anyway, you're not relying on the initialization of integer result by 0, right?
Edit: This behavior is documented: Delphi help link (section Handling Function Results)
I know what changed. I know why. But..
TComplicatedCallMaker = record
Param1: TRecordType;
Param2: TRecordType;
{...}
Param15: TRecordType;
procedure Call;
end;
function ComplicatedCall: TComplicatedCallMaker;
begin
{ Fill default param values }
end;
procedure DoingSomeWorkHere;
begin
with ComplicatedCall do begin
Param7 := Value7;
Param12 := Value12;
Call;
end;
end;
This has perfectly worked before Delphi 2010. An extremely useful technique for making calls which accept a load of parameters but usually only need two or three. Never the same ones though.
And now it gives... guess what?
E2064: Left side cannot be assigned to.
Can't this helpful new behavior be disabled somehow? Any ideas on how to modify the pattern so it works?
Because seriously, losing such a handy technique (and rewriting a bunch of code) for no apparent reason...
I find it a little surprising that this ever worked but since you say it did I'm sure you are right. I'd guess the change was made without consideration for record methods. Without the ability to call methods then this construct would be rather pointless.
Anyway, the compiler isn't going to let you off the hook on this one so you'll have to do this:
type
TRecordType = record end;
TComplicatedCallMaker = record
Param1: TRecordType;
procedure Call;
end;
function ComplicatedCall: TComplicatedCallMaker;
begin
{ Fill default param values }
end;
procedure DoingSomeWorkHere(const Value: TRecordType);
var
CallMaker: TComplicatedCallMaker;
begin
CallMaker := ComplicatedCall;
with CallMaker do begin
Param1 := Value;
Call;
end;
end;
I... think I did it
I hope Delphi developers see what they make their programmers do!
type
PCallMaker = ^TCallMaker;
TCallMaker = record
Param1: integer;
Param2: integer;
function This: PCallMaker; inline;
procedure Call; inline;
end;
function TCallMaker.This: PCallMaker;
begin
Result := #Self;
{ Record functions HAVE to have correct self-pointer,
or they wouldn’t be able to modify data. }
end;
procedure TCallMaker.Call;
begin
writeln(Param1, ' ', Param2);
end;
function CallMaker: TCallMaker; inline
begin
Result.Param1 := 0;
Result.Param2 := 0;
end;
procedure DoingSomeWorkHere;
var cm: TCallMaker;
begin
{Test the assumption that cm is consistent}
cm := CallMaker;
if cm.This <> #cm then
raise Exception.Create('This wasn''t our lucky day.');
{Make a call}
with CallMaker.This^ do begin
Param1 := 100;
Param2 := 500;
Call;
end;
end;
This works, preserves all the good points of the old version (speed, simplicity, small call overhead) but aren't there any hidden problems with this approach?
As already discussed in Rtti data manipulation and consistency in Delphi 2010 a consistency between the original data and rtti values can be reached by accessing members by using a pair of TRttiField and an instance pointer. This would be very easy in case of a simple class with only basic member types (like e.g. integers or strings).
But what if we have structured field types?
Here is an example:
TIntArray = array [0..1] of Integer;
TPointArray = array [0..1] of Point;
TExampleClass = class
private
FPoint : TPoint;
FAnotherClass : TAnotherClass;
FIntArray : TIntArray;
FPointArray : TPointArray;
public
property Point : TPoint read FPoint write FPoint;
//.... and so on
end;
For an easy access of Members I want to buil a tree of member-nodes, which provides an interface for getting and setting values, getting attributes, serializing/deserializing values and so on.
TMemberNode = class
private
FMember : TRttiMember;
FParent : TMemberNode;
FInstance : Pointer;
public
property Value : TValue read GetValue write SetValue; //uses FInstance
end;
So the most important thing is getting/setting the values, which is done - as stated before - by using the GetValue and SetValue functions of TRttiField.
So what is the Instance for FPoint members? Let's say Parent is the Node for TExample class, where the instance is known and the member is a field, then Instance would be:
FInstance := Pointer (Integer (Parent.Instance) + TRttiField (FMember).Offset);
But what if I want to know the Instance for a record property? There is no offset in this case. So is there a better solution to get a pointer to the data?
For the FAnotherClass member, the Instance would be:
FInstance := Parent.Value.AsObject;
So far the solution works, and data manipulation can be done by using rtti or the original types, without losing information.
But things get harder, when working with arrays. Especially the second array of Points. How can I get the instance for the members of points in this case?
TRttiField.GetValue where the field's type is a value type gets you a copy. This is by design. TValue.MakeWithoutCopy is for managing reference counts on things like interfaces and strings; it is not for avoiding this copy behaviour. TValue is intentionally not designed to mimic Variant's ByRef behaviour, where you can end up with references to (e.g.) stack objects inside a TValue, increasing the risk of stale pointers. It would also be counter-intuitive; when you say GetValue, you should expect a value, not a reference.
Probably the most efficient way to manipulate values of value types when they are stored inside other structures is to step back and add another level of indirection: by calculating offsets rather than working with TValue directly for all the intermediary value typed steps along the path to the item.
This can be encapsulated fairly trivially. I spent the past hour or so writing up a little TLocation record which uses RTTI to do this:
type
TLocation = record
Addr: Pointer;
Typ: TRttiType;
class function FromValue(C: TRttiContext; const AValue: TValue): TLocation; static;
function GetValue: TValue;
procedure SetValue(const AValue: TValue);
function Follow(const APath: string): TLocation;
procedure Dereference;
procedure Index(n: Integer);
procedure FieldRef(const name: string);
end;
function GetPathLocation(const APath: string; ARoot: TLocation): TLocation; forward;
{ TLocation }
type
PPByte = ^PByte;
procedure TLocation.Dereference;
begin
if not (Typ is TRttiPointerType) then
raise Exception.CreateFmt('^ applied to non-pointer type %s', [Typ.Name]);
Addr := PPointer(Addr)^;
Typ := TRttiPointerType(Typ).ReferredType;
end;
procedure TLocation.FieldRef(const name: string);
var
f: TRttiField;
begin
if Typ is TRttiRecordType then
begin
f := Typ.GetField(name);
Addr := PByte(Addr) + f.Offset;
Typ := f.FieldType;
end
else if Typ is TRttiInstanceType then
begin
f := Typ.GetField(name);
Addr := PPByte(Addr)^ + f.Offset;
Typ := f.FieldType;
end
else
raise Exception.CreateFmt('. applied to type %s, which is not a record or class',
[Typ.Name]);
end;
function TLocation.Follow(const APath: string): TLocation;
begin
Result := GetPathLocation(APath, Self);
end;
class function TLocation.FromValue(C: TRttiContext; const AValue: TValue): TLocation;
begin
Result.Typ := C.GetType(AValue.TypeInfo);
Result.Addr := AValue.GetReferenceToRawData;
end;
function TLocation.GetValue: TValue;
begin
TValue.Make(Addr, Typ.Handle, Result);
end;
procedure TLocation.Index(n: Integer);
var
sa: TRttiArrayType;
da: TRttiDynamicArrayType;
begin
if Typ is TRttiArrayType then
begin
// extending this to work with multi-dimensional arrays and non-zero
// based arrays is left as an exercise for the reader ... :)
sa := TRttiArrayType(Typ);
Addr := PByte(Addr) + sa.ElementType.TypeSize * n;
Typ := sa.ElementType;
end
else if Typ is TRttiDynamicArrayType then
begin
da := TRttiDynamicArrayType(Typ);
Addr := PPByte(Addr)^ + da.ElementType.TypeSize * n;
Typ := da.ElementType;
end
else
raise Exception.CreateFmt('[] applied to non-array type %s', [Typ.Name]);
end;
procedure TLocation.SetValue(const AValue: TValue);
begin
AValue.Cast(Typ.Handle).ExtractRawData(Addr);
end;
This type can be used to navigate locations within values using RTTI. To make it slightly easier to use, and slightly more fun for me to write, I also wrote a parser - the Follow method:
function GetPathLocation(const APath: string; ARoot: TLocation): TLocation;
{ Lexer }
function SkipWhite(p: PChar): PChar;
begin
while IsWhiteSpace(p^) do
Inc(p);
Result := p;
end;
function ScanName(p: PChar; out s: string): PChar;
begin
Result := p;
while IsLetterOrDigit(Result^) do
Inc(Result);
SetString(s, p, Result - p);
end;
function ScanNumber(p: PChar; out n: Integer): PChar;
var
v: Integer;
begin
v := 0;
while (p >= '0') and (p <= '9') do
begin
v := v * 10 + Ord(p^) - Ord('0');
Inc(p);
end;
n := v;
Result := p;
end;
const
tkEof = #0;
tkNumber = #1;
tkName = #2;
tkDot = '.';
tkLBracket = '[';
tkRBracket = ']';
var
cp: PChar;
currToken: Char;
nameToken: string;
numToken: Integer;
function NextToken: Char;
function SetToken(p: PChar): PChar;
begin
currToken := p^;
Result := p + 1;
end;
var
p: PChar;
begin
p := cp;
p := SkipWhite(p);
if p^ = #0 then
begin
cp := p;
currToken := tkEof;
Exit(currToken);
end;
case p^ of
'0'..'9':
begin
cp := ScanNumber(p, numToken);
currToken := tkNumber;
end;
'^', '[', ']', '.': cp := SetToken(p);
else
cp := ScanName(p, nameToken);
if nameToken = '' then
raise Exception.Create('Invalid path - expected a name');
currToken := tkName;
end;
Result := currToken;
end;
function Describe(tok: Char): string;
begin
case tok of
tkEof: Result := 'end of string';
tkNumber: Result := 'number';
tkName: Result := 'name';
else
Result := '''' + tok + '''';
end;
end;
procedure Expect(tok: Char);
begin
if tok <> currToken then
raise Exception.CreateFmt('Expected %s but got %s',
[Describe(tok), Describe(currToken)]);
end;
{ Semantic actions are methods on TLocation }
var
loc: TLocation;
{ Driver and parser }
begin
cp := PChar(APath);
NextToken;
loc := ARoot;
// Syntax:
// path ::= ( '.' <name> | '[' <num> ']' | '^' )+ ;;
// Semantics:
// '<name>' are field names, '[]' is array indexing, '^' is pointer
// indirection.
// Parser continuously calculates the address of the value in question,
// starting from the root.
// When we see a name, we look that up as a field on the current type,
// then add its offset to our current location if the current location is
// a value type, or indirect (PPointer(x)^) the current location before
// adding the offset if the current location is a reference type. If not
// a record or class type, then it's an error.
// When we see an indexing, we expect the current location to be an array
// and we update the location to the address of the element inside the array.
// All dimensions are flattened (multiplied out) and zero-based.
// When we see indirection, we expect the current location to be a pointer,
// and dereference it.
while True do
begin
case currToken of
tkEof: Break;
'.':
begin
NextToken;
Expect(tkName);
loc.FieldRef(nameToken);
NextToken;
end;
'[':
begin
NextToken;
Expect(tkNumber);
loc.Index(numToken);
NextToken;
Expect(']');
NextToken;
end;
'^':
begin
loc.Dereference;
NextToken;
end;
else
raise Exception.Create('Invalid path syntax: expected ".", "[" or "^"');
end;
end;
Result := loc;
end;
Here's an example type, and a routine (P) that manipulates it:
type
TPoint = record
X, Y: Integer;
end;
TArr = array[0..9] of TPoint;
TFoo = class
private
FArr: TArr;
constructor Create;
function ToString: string; override;
end;
{ TFoo }
constructor TFoo.Create;
var
i: Integer;
begin
for i := Low(FArr) to High(FArr) do
begin
FArr[i].X := i;
FArr[i].Y := -i;
end;
end;
function TFoo.ToString: string;
var
i: Integer;
begin
Result := '';
for i := Low(FArr) to High(FArr) do
Result := Result + Format('(%d, %d) ', [FArr[i].X, FArr[i].Y]);
end;
procedure P;
var
obj: TFoo;
loc: TLocation;
ctx: TRttiContext;
begin
obj := TFoo.Create;
Writeln(obj.ToString);
ctx := TRttiContext.Create;
loc := TLocation.FromValue(ctx, obj);
Writeln(loc.Follow('.FArr[2].X').GetValue.ToString);
Writeln(obj.FArr[2].X);
loc.Follow('.FArr[2].X').SetValue(42);
Writeln(obj.FArr[2].X); // observe value changed
// alternate syntax, not using path parser, but location destructive updates
loc.FieldRef('FArr');
loc.Index(2);
loc.FieldRef('X');
loc.SetValue(24);
Writeln(obj.FArr[2].X); // observe value changed again
Writeln(obj.ToString);
end;
The principle can be extended to other types and Delphi expression syntax, or TLocation may be changed to return new TLocation instances rather than destructive self-updates, or non-flat array indexing may be supported, etc.
You're touching a few concepts and problems with this question. First of all you've mixed in some record types and some properties, and I'd like to handle this first. Then I'll give you some short info on how to read the "Left" and "Top" fields of a record when that record is part of an field in a class... Then I'll give you suggestions on how to make this work generically. I'm probably going to explain a bit more then it's required, but it's midnight over here and I can't sleep!
Example:
TPoint = record
Top: Integer;
Left: Integer;
end;
TMyClass = class
protected
function GetMyPoint: TPoint;
procedure SetMyPoint(Value:TPoint);
public
AnPoint: TPoint;
property MyPoint: TPoint read GetMyPoint write SetMyPoint;
end;
function TMyClass.GetMyPoint:Tpoint;
begin
Result := AnPoint;
end;
procedure TMyClass.SetMyPoint(Value:TPoint);
begin
AnPoint := Value;
end;
Here's the deal. If you write this code, at runtime it will do what it seems to be doing:
var X:TMyClass;
x.AnPoint.Left := 7;
But this code will not work the same:
var X:TMyClass;
x.MyPoint.Left := 7;
Because that code is equivalent to:
var X:TMyClass;
var tmp:TPoint;
tmp := X.GetMyPoint;
tmp.Left := 7;
The way to fix this is to do something like this:
var X:TMyClass;
var P:TPoint;
P := X.MyPoint;
P.Left := 7;
X.MyPoint := P;
Moving on, you want to do the same with RTTI. You may get RTTI for both the "AnPoint:TPoint" field and for the "MyPoint:TPoint" field. Because using RTTI you're essentially using a function to get the value, you'll need do use the "Make local copy, change, write back" technique with both (the same kind of code as for the X.MyPoint example).
When doing it with RTTI we'll always start from the "root" (a TExampleClass instance, or a TMyClass instance) and use nothing but a series of Rtti GetValue and SetValue methods to get the value of the deep field or set the value of the same deep field.
We'll assume we have the following:
AnPointFieldRtti: TRttiField; // This is RTTI for the AnPoint field in the TMyClass class
LeftFieldRtti: TRttiField; // This is RTTI for the Left field of the TPoint record
We want to emulate this:
var X:TMyClass;
begin
X.AnPoint.Left := 7;
end;
We'll brake that into steps, we're aiming for this:
var X:TMyClass;
V:TPoint;
begin
V := X.AnPoint;
V.Left := 7;
X.AnPoint := V;
end;
Because we want to do it with RTTI, and we want it to work with anything, we will not use the "TPoint" type. So as expected we first do this:
var X:TMyClass;
V:TValue; // This will hide a TPoint value, but we'll pretend we don't know
begin
V := AnPointFieldRtti.GetValue(X);
end;
For the next step we'll use the GetReferenceToRawData to get a pointer to the TPoint record hidden in the V:TValue (you know, the one we pretend we know nothing about - except the fact it's a RECORD). Once we get a pointer to that record, we can call the SetValue method to move that "7" inside the record.
LeftFieldRtti.SetValue(V.GetReferenceToRawData, 7);
This is allmost it. Now we just need to move the TValue back into X:TMyClass:
AnPointFieldRtti.SetValue(X, V)
From head-to-tail it would look like this:
var X:TMyClass;
V:TPoint;
begin
V := AnPointFieldRtti.GetValue(X);
LeftFieldRtti.SetValue(V.GetReferenceToRawData, 7);
AnPointFieldRtti.SetValue(X, V);
end;
This can obviously be expanded to handle structures of any depth. Just remember that you need to do it step-by-step: The first GetValue uses the "root" instance, then the next GetValue uses an Instance that's extracted from the previous GetValue result. For records we may use TValue.GetReferenceToRawData, for objects we can use TValue.AsObject!
The next tricky bit is doing this in a generic way, so you can implement your bi-directional tree-like structure. For that, I'd recommend storing the path from "root" to your field in the form of an TRttiMember array (casting will then be used to find the actual runtype type, so we can call GetValue and SetValue). An node would look something like this:
TMemberNode = class
private
FMember : array of TRttiMember; // path from root
RootInstance:Pointer;
public
function GetValue:TValue;
procedure SetValue(Value:TValue);
end;
The implementation of GetValue is very simple:
function TMemberNode.GetValue:TValue;
var i:Integer;
begin
Result := FMember[0].GetValue(RootInstance);
for i:=1 to High(FMember) do
if FMember[i-1].FieldType.IsRecord then
Result := FMember[i].GetValue(Result.GetReferenceToRawData)
else
Result := FMember[i].GetValue(Result.AsObject);
end;
The implementation of SetValue would be a tiny little bit more involved. Because of those (pesky?) records we'll need to do everything the GetValue routine does (because we need the Instance pointer for the very last FMember element), then we'll be able to call SetValue, but we might need to call SetValue for it's parent, and then for it's parent's parent, and so on... This obviously means we need to KEEP all the intermediary TValue's intact, just in case we need them. So here we go:
procedure TMemberNode.SetValue(Value:TValue);
var Values:array of TValue;
i:Integer;
begin
if Length(FMember) = 1 then
FMember[0].SetValue(RootInstance, Value) // this is the trivial case
else
begin
// We've got an strucutred case! Let the fun begin.
SetLength(Values, Length(FMember)-1); // We don't need space for the last FMember
// Initialization. The first is being read from the RootInstance
Values[0] := FMember[0].GetValue(RootInstance);
// Starting from the second path element, but stoping short of the last
// path element, we read the next value
for i:=1 to Length(FMember)-2 do // we'll stop before the last FMember element
if FMember[i-1].FieldType.IsRecord then
Values[i] := FMember[i].GetValue(Values[i-1].GetReferenceToRawData)
else
Values[i] := FMember[i].GetValue(Values[i-1].AsObject);
// We now know the instance to use for the last element in the path
// so we can start calling SetValue.
if FMember[High(FMember)-1].FieldType.IsRecord then
FMember[High(FMember)].SetValue(Values[High(FMember)-1].GetReferenceToRawData, Value)
else
FMember[High(FMember)].SetValue(Values[High(FMember)-1].AsObject, Value);
// Any records along the way? Since we're dealing with classes or records, if
// something is not a record then it's a instance. If we reach a "instance" then
// we can stop processing.
i := High(FMember)-1;
while (i >= 0) and FMember[i].FieldType.IsRecord do
begin
if i = 0 then
FMember[0].SetValue(RootInstance, Values[0])
else
if FMember[i-1].FieldType.IsRecord then
FMember[i].SetValue(FMember[i-1].GetReferenceToRawData, Values[i])
else
FMember[i].SetValue(FMember[i-1].AsObject, Values[i]);
// Up one level (closer to the root):
Dec(i)
end;
end;
end;
... And this should be it. Now some warnings:
DON'T expect this to compile! I actually wrote every single bit of code in this post in the web browser. For technical reasons I had access to the Rtti.pas source file to look up method and field names, but I don't have access to an compiler.
I'd be VERY careful with this code, especially if PROPERTIES are involved. A property can be implemented without an backing field, the setter procedure might not do what you expect. You might run into circular references!
You seem to be misunderstanding the way an instance pointer works. You don't store a pointer to the field, you store a pointer to the class or the record that it's a field of. Object references are pointers already, so no casting is needed there. For records, you need to obtain a pointer to them with the # symbol.
Once you have your pointer, and a TRttiField object that refers to that field, you can call SetValue or GetValue on the TRttiField, and pass in your instance pointer, and it takes care of all the offset calculations for you.
In the specific case of arrays, GetValue it will give you a TValue that represents an array. You can test this by calling TValue.IsArray if you want. When you have a TValue that represents an array, you can get the length of the array with TValue.GetArrayLength and retrieve the individual elements with TValue.GetArrayElement.
EDIT: Here's how to deal with record members in a class.
Records are types too, and they have RTTI of their own. You can modify them without doing "GetValue, modify, SetValue" like this:
procedure ModifyPoint(example: TExampleClass; newXValue, newYValue: integer);
var
context: TRttiContext;
value: TValue;
field: TRttiField;
instance: pointer;
recordType: TRttiRecordType;
begin
field := context.GetType(TExampleClass).GetField('FPoint');
//TValue that references the TPoint
value := field.GetValue(example);
//Extract the instance pointer to the TPoint within your object
instance := value.GetReferenceToRawData;
//RTTI for the TPoint type
recordType := context.GetType(value.TypeInfo) as TRttiRecordType;
//Access the individual members of the TPoint
recordType.GetField('X').SetValue(instance, newXValue);
recordType.GetField('Y').SetValue(instance, newYValue);
end;
It looks like the part you didn't know about is TValue.GetReferenceToRawData. That will give you a pointer to the field, without you needing to worry about calculating offsets and casting pointers to integers.
I passed ref of interface from Visio Add-ins to MyCOMServer (Interface Marshalling in Delphi have to pass interface as pointer in internals method of MyCOMServer. I try to pass interface to internal method as pointer of interface, but after back cast when i try call method of interface I get exception. Simple example(Fisrt block execute without error, but At Second block I get Exception after addressed to property of IVApplication interface):
procedure TMyCOMServer.test(const Interface_:IDispatch); stdcall;
var
IMy:_IMyInterface;
V: Variant;
Str: String;
I: integer;
Vis: IVApplication;
begin
......
{First code Block}
Self.QuaryInterface(_IMyInterface,IMy);
str := IMy.ApplicationName;
V := Integer(IMy);
i := V;
Pointer(IMy) := Pointer(i);
str := IMy.SomeProperty; // normal completion
{Second code Block}
str := (Interface_ as IVApplication).Path;
V := Interface_;
I := V;
Pointer(Vis) := Pointer(i);
str := Vis.Path; // 'access violation at 0x76358e29: read of address 0xfeeefeee'
end;
Why I can't do like this?
When you have an object that implements multiple interfaces and you cast between them you will get different addresses. It has to do something with how to find the methods of those interfaces.
Let's say that you have two interfaces and a class that implements them, the methods show just a message with the methodname:
type
IMyIntfA = interface
['{21ADE2EF-55BB-4B78-A23F-9BB92BE55683}']
procedure A;
procedure X;
end;
IMyIntfB = interface
['{7E1B90CF-569B-4DD1-8E46-7E7255D2373A}']
procedure B;
end;
TMyObject = class(TInterfacedObject, IMyIntfA, IMyIntfB, IUnknown)
public
procedure A;
procedure X;
procedure B;
end;
When you tell the compiler to call A from IMyIntfA, it knows that A is located at the address of IMyIntfA plus an offset. The same applies to calling method B from IMyIntfB.
But what you are doing is putting the reference to IMyIntfB in a var of IMyIntfA and then call method A. The result is that the address of the method the compiler calculates is totally wrong.
var
lIntfA: IMyInterfaceA;
lIntfB: IMyInterfaceB;
begin
lIntfA := TMyObject.Create; //TMyObject implements IMyInterfA, IMyInterfB
lInfB := lIntfA as IMyInterfaceB;
if Integer(lIntfA) <> Integer(lIntfB) then
ShowMessage('I told you so');
Pointer(lIntfA) := Pointer(lIntfB);
lIntfA.A; //procedure B is called, because B is at "Offset 1", like A
lIntfA.X; //total mayhem, X is at "Offset 2", but there is nothing at IMyIntfB + offset 2
end;
PS: I'am not a guru and I don't know the technical details about how everything is implemented. This is only a rough explanation which should give you an idea of why your code goes wrong. If you want your code to succeed do this:
Vis := Interface_ as IVApplication;
Str := (Vis.Path);
I'm only guessing since I don't know much about COM, but casting an interface to an integer or pointer does mess up the internal reference counting. Your interface is likely to be released, which would explain the access violation.
EDIT: I wonder that Pointer(Vis) := Pointer(i) works anyway. Shouldn't the cast create a temporary object. Maybe that's why Vis does not get assigned?