★★★如果区分一个变量指向的是TObject还是一个record

Question

type
  
  //一个结构体
  PSomeRecord =^TSomeRecord;
  TSomeRecord = record
     a:string;
  end;  //一个类
  TSomeObject = class(TObject)
     destructor destroy;override;
  end;var
  aValue:TObject;//存储指针的变量//执行以下代码
begin
//一种情况－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  //如果给aValue赋值一个TObject的派生类
  aValue := TSomeObject.Create;
  //我就需要这样释放,正确调用了destroy方法
  aValue.Free;
//另一种情况－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  //给aValue赋值一个结构体变量
  tmp := new(PSomeRecord);
  tmp^.a := 'llllll';  aValue := Pointer(tmp);
  //就需要这样来释放aValue
  Dispose(Pointer(aValue));
   
end.我怎样才能在不知道aValue存储的指针指向的是TObject或是Struct的情况先，用统一的方式来释放aValue呢？不够分可以再加

Answer 1

或者说能能够判断也行阿
例如
if isObject(aValue)之类的aValue is TObject 无法判断
是否可以通过vmtCreateObject之类的偏移来判断呢？
如果可以代码该如何写阿

Answer 2

不知这样是否可以
看看aValue.a是否是字符串，......

Answer 3

//可以利用对象指针的特性来判断～～
//所有对象指针的前4个字节都用来保存该对象的类地址～～type
  PSomeRecord =^TSomeRecord;
  TSomeRecord = record
     a:string;
  end;  TSomeObject = class(TObject)
  end;procedure FreeValue(mValue: TObject);
begin
  if mValue = nil then Exit;
  if PPointer(mValue)^ = TSomeObject then //mValue为TSomeObject对象
    TSomeObject(mValue).Free
  else Dispose(PSomeRecord(mValue));
end;procedure TForm1.Button1Click(Sender: TObject);
var
  aValue: TObject;
begin
  aValue := TSomeObject.Create;
  FreeValue(aValue);
  New(PSomeRecord(aValue));
  PSomeRecord(aValue)^.a := 'llllll';
  FreeValue(aValue);
end;

Answer 4

function IsObject(p:Pointer):Boolean;
var s:string;
begin
  try
    result:=TObject(p).ClassName<>'';
  except
    result:=false;
  end;
end;

Answer 5

Eastunfail(龍子龍孫)　
的答案要异常，如果P指向一个结构体的化
zswang(伴水清清)(专家门诊清洁工)：
你的答案我能够理解，但是还不是我想要的，我的意思是对于调用者并不知道存入的具体类型是什么，只能确定存入的不是TObject就是Struct，而跟具体的TSomeObject无关，
因为，我完全可以使用TObject(aValue).Free来释放aValue(如果是TObject的化）或者Dispose(Pointer(aValue))来释放record指针，而没有内存泄漏，因此答案还未得到的说。
我在TypInfo中找到了一些仿佛有用的东西
可以使用pTypeInfo(TypeInfo(TSomeObject)).Kind来得到类型的信息
  TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);
但是遗憾的是必须传入的参数是类型信息，而不能传入一个变量进去，继续期待ing...

Answer 6

國外的borland專欄, 就是用強制轉為 TObject ,訪問, 用try except 來分辨, 簡單但不完美!aimigoo 以前也專門寫了篇文章來解決, 要分析是不是有 vmt 表, 對應結構是否合理!Eastunfail(龍子龍孫)的可能簡單點, 不保證一定可以的

Answer 7

如果一个RECORD第一个字段是指向一个实例的指针，那么我的IsObject就没效果了

Answer 8

说错了。如果第一个字段是一个TClass类型，那么我的IsObject就没有效果了。

Answer 9

和前面一样，无法处理指向某个结构（第一个字段指向一个参考类）。但是没有用异常function IsObject(p:Pointer):Boolean;
var vmt:Pointer;
  NameAddress:Integer;
begin
  Result:=false;
  if(IsBadReadPtr(p,4))then exit;
  vmt:=PPointer(p)^;
  if(IsBadReadPtr(vmt,4))then exit;
  NameAddress:=Integer(vmt) + vmtClassName;
  if(IsBadReadPtr(Pointer(NameAddress),4))then exit;
  Result:=lstrlen(PPointer(NameAddress)^)<>0;
end;

Answer 10

//前提要早说哦，改改Eastunfail的代码，如下 ：）～～type
  PSomeRecord =^TSomeRecord;
  TSomeRecord = record
     a:string;
  end;function IsClass(mPointer: Pointer): Boolean;
var
  vClassName: PShortString;
begin
  Result := False;
  if IsBadReadPtr(mPointer, 4)then exit;
  vClassName := PPointer(Integer(mPointer) + vmtClassName)^;
  if IsBadReadPtr(vClassName, 4) then Exit;
  Result := IsValidIdent(vClassName^);
end;function IsObject(mPointer: Pointer): Boolean;
begin
  Result := IsClass(PPointer(mPointer)^);
end;procedure FreeValue(mValue: TObject);
begin
  if mValue = nil then Exit;
  if IsObject(mValue) then //mValue为TObject对象
    TObject(mValue).Free
  else Dispose(PSomeRecord(mValue));
end;procedure TForm1.Button1Click(Sender: TObject);
var
  aValue: TObject;
begin
  aValue := TObject.Create;
  FreeValue(aValue);
  New(PSomeRecord(aValue));
  PSomeRecord(aValue)^.a := 'llllll';
  FreeValue(aValue);
end;

Answer 11

测试成功，最后一个问题procedure FreeValue(mValue: TObject);
begin
  if mValue = nil then Exit;
  if IsObject(mValue) then //mValue为TObject对象
    TObject(mValue).Free
  else Dispose(PSomeRecord(mValue));
end;
的最后一句改成
  else Dispose(Pointer(mValue));
能正确释放吗？

Answer 12

//调试如下代码～～
procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  P: Pointer;
begin
  for I := 0 to 1024 * 1024 do
  begin
    New(PString(P));
    PString(P)^ := '我爱北京天安门！';
//    Dispose(PString(P)); //没有内存泄漏
    Dispose(P); //大量内存泄漏
  end;
end;//结论是不能正确释放～～
//理所当然不同的数据指针开辟的内存大小就不同，New和Dispose会区分指针的类型～～var
  P: Pointer;
begin
  New(P);
  asm ret end;
  Dispose(P);
  asm ret end;
  New(PString(P));
  asm ret end;
  Dispose(PString(P));
  asm ret end;
asm0047E098 push ebx           
0047E099 xor eax,eax        
0047E09B call @GetMem       
0047E0A0 mov ebx,eax        
0047E0A2 ret                -----------------------------------
0047E0A3 xor edx,edx        
0047E0A5 mov eax,ebx        
0047E0A7 call @FreeMem      
0047E0AC ret                -----------------------------------
0047E0AD mov edx,[$00401080]
0047E0B3 mov eax,$00000004  
0047E0B8 call @New          
0047E0BD mov ebx,eax        
0047E0BF ret                -----------------------------------
0047E0C0 mov edx,[$00401080]
0047E0C6 mov eax,ebx        
0047E0C8 call @Dispose      
0047E0CD ret                -----------------------------------

Answer 13

//参考如下代码，说明New和Dispose会根据指针的大小分配空间～～
var
  P: Pointer;
begin
  New(PInteger(P));
  asm ret end;
  Dispose(PInteger(P));
  asm ret end;
  New(PInt64);
  asm ret end;
  Dispose(PInt64(P));
  asm ret end;
end;0047E068 push ebx           
0047E069 mov eax,$00000004  //分配４个字节 //SizeOf(Integer)=4
0047E06E call @GetMem       
0047E073 mov ebx,eax        
0047E075 ret                -----------------------------------
0047E076 mov edx,$00000004  //释放４个字节
0047E07B mov eax,ebx        
0047E07D call @FreeMem      
0047E082 ret                -----------------------------------
0047E083 mov eax,$00000008  //分配８个字节//SizeOf(Int64)=8
0047E088 call @GetMem       
0047E08D ret                -----------------------------------
0047E08E mov edx,$00000008  //释放８个字节
0047E093 mov eax,ebx        
0047E095 call @FreeMem      
0047E09A ret                -----------------------------------

Answer 14

那这样应该可以吧
    Freemem(a,sizeof(a^));
如果确定a是一个结构体指针的化

Answer 15

-_-!!!!!!
var
  A: Pointer;
begin
  Caption := IntToStr(SizeOf(A^)); //0
end;

Answer 16

试一下这个
procedure TForm1.Button1Click(Sender: TObject);
var
  P: Pointer;
  size1, size2: Integer;
begin
  size1 := AllocMemSize;
  New(PInteger(P));
  Dispose(PInteger(P));
  New(PInt64);
  Dispose(PInt64(P));
  size2 := AllocMemSize;  Memo1.Lines.Add(IntToStr(size1) + ' ' + IntToStr(size2));
end;procedure TForm1.Button2Click(Sender: TObject);
var
  P: Pointer;
  size1, size2: Integer;
begin
  size1 := AllocMemSize;
  New(PInteger(P));
  Dispose(P);
  New(PInt64);
  Dispose(P);
  size2 := AllocMemSize;  Memo1.Lines.Add(IntToStr(size1) + ' ' + IntToStr(size2));
end;看源码_FreeMem会调用SysFreeMem
SysFreeMem可以通过传过来的p: Pointer找到一个 TUsed的记录
 TUsed = packed record
    sizeFlags: Integer;
  end;
这个TUsed在GetMem时会保留一个sizeof(TUsed)的大小记录实际分配的内存大小,Dispose(PInt64(P));和
Dispose(P)一个效果,编译器没有用到那个大小信息
而对于PString,记录这种类型则必须
Dispose(PString(P))
因为编译器需要使用这个类型信息来释放内存