获取D7...D2010任何版本的编译后的程序

//可以获取D7...D2010任何版本的编译后的程序,其他版本有待考证,
//本过程在D7...D2010编译使用没发现异常
//For Win32 , XP , Vista , Win7
Function GetDelphiWinControlProp_Name(HProcess , TID , H : THandle; var Name : String) : Boolean; overload;
var
  D , Module , PID : DWORD;
  Msg : DWORD;
  MsgName : String;
  Addr : Pointer;
begin
  Result := False;
  Module := 0;
  if (not EnumProcessModules(HProcess , @Module , 4 , D)) or (Module=0) then exit;
  MsgName := Format('ControlOfs%.8X%.8X', [Module, TID]);
  MSG := RegisterWindowMessage(Pointer(MsgName));
  Addr := Pointer(SendMessage(H, Msg, 0, 0));
  if Addr=NIL then exit;
  PID := 8;//PID := GetDelphiOneVersionComponentPropPos;
  if Integer(PID)<=4 then exit;
  if not ReadProcessMemory(HProcess ,
                           Ptr(DWORD(Addr) + PID),
                           @TID ,
                           4,
                           D) then exit;
  if not ReadProcessMemory(HProcess ,
                           Ptr(TID - 4),
                           @PID ,
                           4,
                           D) then exit;
  //假设控件的名称最大长度200,这个值 值得商榷
  if (Integer(PID)<=0) or (Integer(PID)>200) then exit;
  MSG := 0;
  if not ReadProcessMemory(HProcess ,
                           Ptr(TID),
                           @Msg ,
                           2,
                           D) then exit;
  if MSG and $FF00 =0 then PID := PID * 2;
  GetMem(Addr , PID+2);
  ZeroMemory(Addr , PID+2);
  if not ReadProcessMemory(HProcess ,
                           Ptr(TID),
                           Addr ,
                           PID,
                           D) then begin FreeMem(Addr); exit; end;
  if MSG and $FF00 = 0 then
    Name := PWideChar(Addr)
  else
    Name := PAnsiChar(Addr);
  Result := True;
end;

//可以获取D7...D2010任何版本的编译后的程序,其他版本有待考证,
//本过程实用于D7...D2010版本
//For Win32 , XP , Vista , Win7
Function GetDelphiWinControlProp_Name(H : THandle; var Name : String) : Boolean;overload;
var
  PID , TID : DWORD;
  HProcess : THandle;
begin
  Result := False;
  TID := GetWindowThreadProcessID(H, PID);
  if (TID=0) or (PID=0) then exit;
  HProcess := OpenProcess(PROCESS_VM_READ    or PROCESS_QUERY_INFORMATION , False , PID);
  if HProcess<>0 then begin
    Result := GetDelphiWinControlProp_Name(HProcess , TID , H , Name);
    CloseHandle(HProcess);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  S : String;
  H : THandle;
begin
  H := Windows.FindWindow(NIL , 'xxxxxx');
  if H<>0 then begin
    GetDelphiWinControlProp_Name(Handle , S);
    Caption := Caption + '  ' + S;
  end;
end;