Test if a Pointer is a TObject instance - delphi

I'm trying to write some generic debug code using the Delphi RTTI. The problem I have come across is that I'm examining the contents of a TList which only holds Pointers. Now I know from my code that these Pointers are in fact TObject references (or some descendant).
So my question is this: given a valid Pointer is there a safe way to determine if it is in fact a TObject reference?

There is no safe way to determine whether valid pointer is TObject reference
You can only tell with certainty that pointer is not an object reference.
Having said that, for debugging purposes there is a way to detect that pointer might be an object reference, but you may also get false positives - memory content we are inspecting may satisfy the check by pure chance.
Every object instance also holds a pointer to its class virtual method table - VMT. It also has a pointer pointing to start of its data - offset of that pointer is defined by vmtSelfPtr constant declared in System unit.
Class references in vmtSelfPtr differ from objects as they hold reference back to self.
Above facts will tells us we are not looking at a class reference first, and then we will check whether possible object's VMT points to possible class reference.
Besides that for each pointer we will first check that it belongs to valid address space.
You can find more information about VMT here Internal Data Formats - Class Types
The code that detects whether pointer is possible object is taken from
Spring4D library:
uses
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF }
TypInfo;
function IsValidObject(p: PPointer): Boolean;
{$IFDEF MSWINDOWS}
var
memInfo: TMemoryBasicInformation;
{$ENDIF}
function IsValidAddress(address: Pointer): Boolean;
begin
// Must be above 64k and 4 byte aligned
if (UIntPtr(address) > $FFFF) and (UIntPtr(address) and 3 = 0) then
begin
{$IFDEF MSWINDOWS}
// do we need to recheck the virtual memory?
if (UIntPtr(memInfo.BaseAddress) > UIntPtr(address))
or ((UIntPtr(memInfo.BaseAddress) + memInfo.RegionSize) < (UIntPtr(address) + SizeOf(Pointer))) then
begin
// retrieve the status for the pointer
memInfo.RegionSize := 0;
VirtualQuery(address, memInfo, SizeOf(memInfo));
end;
// check the readability of the memory address
if (memInfo.RegionSize >= SizeOf(Pointer))
and (memInfo.State = MEM_COMMIT)
and (memInfo.Protect and (PAGE_READONLY or PAGE_READWRITE
or PAGE_WRITECOPY or PAGE_EXECUTE or PAGE_EXECUTE_READ
or PAGE_EXECUTE_READWRITE or PAGE_EXECUTE_WRITECOPY) <> 0)
and (memInfo.Protect and PAGE_GUARD = 0) then
{$ENDIF}
Exit(True);
end;
Result := False;
end;
begin
Result := False;
if Assigned(p) then
try
{$IFDEF MSWINDOWS}
memInfo.RegionSize := 0;
{$ENDIF}
if IsValidAddress(p)
// not a class pointer - they point to themselves in the vmtSelfPtr slot
and not (IsValidAddress(PByte(p) + vmtSelfPtr)
and (p = PPointer(PByte(p) + vmtSelfPtr)^)) then
if IsValidAddress(p^) and IsValidAddress(PByte(p^) + vmtSelfPtr)
// looks to be an object, it points to a valid class pointer
and (p^ = PPointer(PByte(p^) + vmtSelfPtr)^) then
Result := True;
except
end; //FI:W501
end;
And we can use that function like:
var
o: TObject;
p: Pointer;
i: NativeInt;
begin
i := 5;
p := #i;
o := TObject.Create;
Writeln(IsValidObject(Pointer(o))); // TRUE
Writeln(IsValidObject(p)); // FALSE
end.
Note: IsValidObject should only be used on valid pointers - meaning pointers that point to valid allocated memory. You cannot detect whether object instance behind the pointer has been released or not.
If you have following code, you will still get TRUE as the result of the IsValidObject call.
o := TObject.Create;
o.Free;
Writeln(IsValidObject(Pointer(o))); // TRUE
Note: Besides for debugging purposes, IsValidObject can be safely called in release mode on any pointer you know it is either nil, class reference, or object reference. In other words you can safely use it to distinguish between class and object references.

Related

Delphi 7 refcount error when copying a record to dynamically allocated memory

I faced a strange behavior in Delphi when assigning a record type variable with a managed string field to a dynamically allocated buffer. What's wrong with it and how could be corrected?
type
PRec = ^TRec;
TRec = packed record
Foo: integer;
Bar: string;
end;
procedure Error;
var
P, Q: PRec;
R, T: TRec;
begin
R.Foo := 1;
R.Bar := 'Bar';
T := R; // Ready
Q := #T;
Q^ := R; // Ready
GetMem(P, SizeOf(TRec));
P^ := R; // Access violation in _LStrAsg at
// "MOV ECX,[EDX-skew].StrRec.refCnt"
R := P^; // Just to keep reference while debugging
end;
Your record is a managed record. As such, it needs to be initialized. Your code uses GetMem which does not initialize the record. Instead you should use New. Replace
GetMem(P, SizeOf(TRec));
with
New(P);
Likewise when you need to deallocate, you must finalize the record. Use Dispose rather than FreeMem.
It is possible to initialize and finalize manually if, for some reason, you need to do that. That would look like this:
// allocate and initialize
GetMem(P, SizeOf(P^));
Initialize(P^);
// finalize and deallocate
Finalize(P^);
FreeMem(P);

Which one should I use to free the COM object?

I have a COM class, which looks something like this:
TRadioTracer = class(TAutoObject, IRadioTracer)
Now, I can do
var
obj: TRadioTracer;
begin
obj := TRadioTracer.Create;
// some other code
obj.Free;
obj.CleanupInstance;
obj.FreeInstance;
end;
These are from System.pas
procedure TObject.FreeInstance;
begin
CleanupInstance;
_FreeMem(Pointer(Self));
end;
procedure TObject.CleanupInstance;
{$IFDEF PUREPASCAL}
var
ClassPtr: TClass;
InitTable: Pointer;
begin
{$IFDEF WEAKREF}
_CleanupInstance(Self);
{$ENDIF}
ClassPtr := ClassType;
repeat
InitTable := PPointer(PByte(ClassPtr) + vmtInitTable)^;
if InitTable <> nil then
_FinalizeRecord(Self, InitTable);
ClassPtr := ClassPtr.ClassParent;
until ClassPtr = nil;
TMonitor.Destroy(Self);
end;
{$ELSE !PUREPASCAL}
// some other code
procedure TObject.Free;
begin
// under ARC, this method isn't actually called since the compiler translates
// the call to be a mere nil assignment to the instance variable, which then calls _InstClear
{$IFNDEF AUTOREFCOUNT}
if Self <> nil then
Destroy;
{$ENDIF}
end;
Which one should I use to free the COM object?
Use the interface type to store a reference to the object. It will be destroyed as soon as there is no reference to it left:
var
obj: IRadioTracer;
begin
obj := TRadioTracer.Create;
obj.DoThings;
end; // obj will be freed here automatically
When you use the COM-Object in a different application or via a TAutoObjectFactory then you will only know the interface type. You have no access then to the concrete class type. That's an additional reason why to prefer the interface type here over the class type.
In case you are using the class type to reference the object you need to call Free to destroy it.

Delphi - Maintaining Self References to an Object

I've looked at many questions and resources which deal with the "Self" variable in an Object, but everyone says something different.
For example, in this question: Delphi Self-Pointer usage
the highest rated answer to the question appears to be wrong. Pointer(Self) does not point to the object which contains it, and cannot be used to pass references from inside the object.
I've tried doing this:
Type
myobject = class
PSelf: Pointer;
End;
Var
Obj: myobject;
Procedure RunProgram;
Begin
Obj := myobject.create;
Obj.PSelf := #Obj;
//Run the rest of the program
.
.
.
and for the most part, this has worked just fine.
My question is: is this a good coding practice? Can the "PSelf" variable be expected to point to the object for the duration of the program's execution?
I recently came across a bug where "PSelf" had stopped pointing to it's containing object, and I'm wondering if objects ever get shuffled around in the heap, or whether the memory had been corrupted.
Edit:
There is some instance in which using the "Self" variable didn't work for me, and now I cannot duplicate it. So this whole question is pointless, as is my technique of using a 'PSelf' variable. Sorry about that.
And as Ken pointed out, the link above has a correct answer :)
I think you're misunderstanding what Self is, and how object references work in Delphi.
A variable containing an instance of a class is already a pointer to that object instance. The Delphi compiler just allows you to leave out the dereference operator (^) as a convenience.
var
MyObject: TMyObject;
begin
MyObject := TMyObject.Create; // MyObject is now a pointer to an instance of TMyObject
...
Delphi also allows the shorthand of not using the dereference operator when accessing members or properties of the object instance. Again, the following code is actually equivalent:
MyObj.SomeProperty := SomeValue;
MyObj^.SomeProperty := SomeValue;
From the Delphi documentation:
A variable of a class type is actually a pointer that references an object. Hence more than one variable can refer to the same object. Like other pointers, class-type variables can hold the value nil. But you don't have to explicitly dereference a class-type variable to access the object it points to. For example, SomeObject.Size := 100 assigns the value 100 to the Size property of the object referenced by SomeObject; you would not write this as SomeObject^.Size := 100.
Self is an automatically declared property that points to the current instance of the object. In other words, it's automatically available inside the code that implements that class to reference the current instance of the object. This allows you to have multiple instances of the same object:
type
TMyObject=class(TObject)
private
FMyInteger: Integer;
function GetMyInteger: Integer;
procedure SetMyInteger(Value: Integer);
published
property MyInteger: Integer read GetMyInteger write SetMyInteger;
end;
...
function TMyObject.GetMyInteger: Integer;
begin
Result := Self.FMyInteger;
// Self is implied, so the above line can more simply be written as
// Result := FMyInteger;
end;
procedure TMyObject.SetMyInteger(Value: Integer);
begin
if (Value <> Self.FMyInteger) then // Self is again implied here
Self.FMyInteger := Value;
end;
var
MyObjOne, MyObjTwo: TMyObject;
i, j: Integer;
begin
MyObjOne := TMyObject;
// Here, the code inside TMyObject.SetInteger that
// uses `Self` would refer to `MyObjOne`
MyObjOne.MyInteger := 1;
MyObjTwo := TMyObject;
// Here, the code in TMyObject.SetInteger would be
// using the memory in `MyObjTwo` when using `Self`
MyObjTwo.MyInteger := 2;
end;
Note that Self is only valid in the code that implements the class. It's available and valid in TMyObject.GetMyInteger and TMyObject.SetMyInteger above (the only implemented code in my example), and always refers to the current instance.
There's no need to keep track of the addresses of Self, as the variable referencing that object instance is Self inside methods of that object instance. It's only valid inside that instance of the object, and always refers to that object instance. So in your code example, PSelf is just wasted space - myobject already contains a pointer to itself, and that pointer is automatically available in methods of myobject:
type
myobject = class; // Now automatically contains a `Self` pointer
// available in methods of the class once an
// instance is created
var
myobj: myobject;
begin
myobj := myobject.Create; // myobj.Self now is valid in methods of
// `myobject`
Here's my resolution to the problem. I'm still wondering why the second example doesn't work.
This works (but is the wrong way to do it):
Type
myobject1 = class(TObject)
PSelf: Pointer;
Number: Integer;
Function GiveReference: Pointer;
End;
pmyobject1: ^myobject1;
myobject2 = class(TObject)
p: pmyobject1;
End;
Var
Obj1: myobject1;
Obj2: myobject2;
Function myobject1.GiveReference: Pointer;
Begin
Result := PSelf;
End;
Procedure RunProgram;
Var
i: Integer;
Begin
Obj1 := myobject1.create;
Obj1.PSelf := #Obj1;
Obj2 := myobject2.create;
Obj2.P := Obj.GiveReference;
//to access 'number', this works
i := Obj2.P^.Number;
//Run the rest of the program
.
.
.
This does not work, but in my mind is exactly the same. This is what caused me to distrust the 'self' variable (even though yes, I was making a pointer to a pointer).
Type
myobject1 = class(TObject)
Number: Integer;
Function GiveReference: Pointer;
End;
pmyobject1: ^myobject1;
myobject2 = class(TObject)
p: pmyobject1;
End;
Var
Obj1: myobject1;
Obj2: myobject2;
Function myobject1.GiveReference: Pointer;
Begin
Result := #Self;
End;
Procedure RunProgram;
Var
i: Integer;
Begin
Obj1 := myobject1.create;
Obj2 := myobject2.create;
Obj2.P := Obj.GiveReference;
//This will fail, some of the time, but not all of the time.
//The pointer was valid while 'GiveReference' was being called, but
//afterwards, it is not valid.
i := Obj2.P^.Number;
//Run the rest of the program
.
.
.
And finally, this is what I should have been doing all along:
Type
myobject1 = class(TObject)
Number: Integer;
Function GiveReference: Pointer;
End;
myobject2 = class(TObject)
p: myobject1;
End;
Var
Obj1: myobject1;
Obj2: myobject2;
Function myobject1.GiveReference: Pointer;
Begin
Result := Self;
End;
Procedure RunProgram;
Var
i: Integer;
Begin
Obj1 := myobject1.create;
Obj2 := myobject2.create;
Obj2.P := Obj.GiveReference;
//No problems with this, although I would generally check if P was assigned prior to
//reading from it.
i := Obj2.P.Number;
//Run the rest of the program
Obj1.Free;
Obj2.P := nil;
I hadn't done this in the first place, because I was concerned that by not using a pointer, that I might actually be duplicating the entire object.

Why can't pass Marshaled interface as integer(or pointer)

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?

Delphi call method based on RTTI information

Hey all, first sorry for my bad english.
Consider the following (not actual code):
IMyInterface = Interface(IInterfce)
procedure Go();
end;
MyClass = class(IMyInterface)
procedure Go();
end;
MyOtherClass = class
published
property name: string;
property data: MyClass;
end;
I'm setting "MyOtherClass" properties using RTTI. For the string property it's easy, but my question is:
How can I get a reference to the "data" (MyClass) property so I can call the Go() method?
I want to do something like this (pseudo-code):
for i:= 0 to class.Properties.Count
if (propertyType is IMyInterface) then
IMyInterface(class.properties[i]).Go()
(if only this was C# :( )
PS.: this is in delphi 7 (i know, even worse)
If the string property is easy, as you say, then I assume you're calling GetStrProp and SetStrProp from the TypInfo unit. Class-type properties can be equally easy with GetObjectProp and SetObjectProp.
if Supports(GetObjectProp(Obj, 'data'), IMyInterface, Intf) then
Intf.Go;
If you don't really need the interface, and you know that the data property has type TMyClass, then you can go a little more directly:
(GetObjectProp(Obj, 'data') as TMyClass).Go;
That requires the property to have a non-null value.
If you don't know the name of the property you want, then you can use some other things in TypInfo to search for it. For example, here is a function that will find all the published properties of an object that have values that implement IMyInterface; it calls Go on each of them in no particular order.
procedure GoAllProperties(Other: TObject);
var
Properties: PPropList;
nProperties: Integer;
Info: PPropInfo;
Obj: TObject;
Intf: IMyInterface;
Unk: IUnknown;
begin
// Get a list of all the object's published properties
nProperties := GetPropList(Other.ClassInfo, Properties);
if nProperties > 0 then try
// Optional: sort the list
SortPropList(Properties, nProperties);
for i := 0 to Pred(nProperties) do begin
Info := Properties^[i];
// Skip write-only properties
if not Assigned(Info.GetProc) then
continue;
// Check what type the property holds
case Info.PropType^^.Kind of
tkClass: begin
// Get the object reference from the property
Obj := GetObjectProp(Other, Info);
// Check whether it implements IMyInterface
if Supports(Obj, IMyInterface, Intf) then
Intf.Go;
end;
tkInterface: begin
// Get the interface reference from the property
Unk := GetInterfaceProp(Obj, Info);
// Check whether it implements IMyInterface
if Supports(Unk, IMyInterface, Intf) then
Intf.Go;
end;
end;
end;
finally
FreeMem(Properties);
end;
end;
You can get an array of all published propertied by calling GetPropInfos(MyClass.ClassInfo). This is an array of PPropInfo pointers. And you can get at type-specific data from a PPropInfo by calling GetTypeData on it, which returns a PTypeData. The record it points to will have the information you're looking for about the class reference.

Resources