dcurecs.pas

反汇编delphi的.dcu文件至汇编代码的工具的所有源代码, 用delphi/pascal实现, 反向工程borland delphi写的程序必备

  InstBaseRTTISz: TNDX; //Size of RTTI for the type, if available
  InstBaseSz: TNDX; //Size of corresponding variable
  InstBaseV: TNDX;
  VMCnt: TNDX;//number of virtual methods
  NdxFE: TNDX;//BFE: Byte
  Ndx00a: TNDX;//B00a: Byte
  B04: TNDX;
//%$IF Ver>2;
  ICnt: TNDX;
// DAdd: case @.B00b=0 of
  {DAddB0: Byte;
  DAddB1: Byte;}
  ITbl: PNDXTbl;
// endc
//$END
  constructor Create;
  destructor Destroy; override;
  function ShowValue(DP: Pointer; DS: Cardinal): integer {Size used}; override;
  procedure Show; override;
  function GetParentType: TNDX; override;
  function GetRefOfsQualifier(Ofs: integer): String; override;
  procedure ReadBeforeIntf; virtual;
end ;

TMetaClassDef = class(TClassDef)
  hCl: TNDX;
  procedure ReadBeforeIntf; override;
end ;

TInterfaceDef = class(TRecBaseDef)
  hParent: TNDX;
  VMCnt: TNDX;
  GUID: PGUID;
  B: Byte;
  constructor Create;
  procedure Show; override;
end ;

TVoidDef = class(TTypeDef)
  procedure Show; override;
end ;

{TStrConstTypeDef = class(TTypeDef)
  hBase: TNDX;
  constructor Create;
  procedure Show; override;
end ;}

const
  NoName: String[1]='?';

const
{Register, where register variable is located,
 I am not sure that it is valid for smaller than 4 bytes variables}
  RegName: array[0..6] of String[3] =
    ('EAX','EDX','ECX','EBX','ESI','EDI','EBP');
    
procedure FreeDCURecList(L: TDCURec);
function GetDCURecListEnd(L: TDCURec): PTDCURec;

implementation

uses
  DCU32, op;

procedure FreeDCURecList(L: TDCURec);
var
  Tmp: TDCURec;
begin
  while L<>Nil do begin
    Tmp := L;
    L := L.Next;
    Tmp.Free;
  end ;
end ;

function GetDCURecListEnd(L: TDCURec): PTDCURec;
begin
  Result := @L;
  while Result^<>Nil do
    Result := @Result^.Next;
end ;

{ TDCURec. }
function TDCURec.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
  Result := 0;
  DCUErrorFmt('Trying to set memory 0x%x[0x%x] to %s',[MOfs,MSz,Name^]);
end ;

function TDCURec.NameIsUnique: boolean;
begin
  Result := false;
end ;

{ TBaseDef. }
constructor TBaseDef.Create(AName: PName; ADef: PDef; AUnit: integer);
begin
  inherited Create;
  FName := AName;
  Def := ADef;
  hUnit := AUnit;
end ;

procedure TBaseDef.ShowName;
var
  U: PUnitImpRec;
  NP: PName;
begin
  NP := FName;
  if (NP=Nil)or(NP^[0]=#0) then
    NP := @NoName;
  if hUnit<0 then begin
    if NP^[0]<>#0 {Temp.} then
      PutS(GetDCURecStr(Self,-1{dummy - won't be used},false));
   end
  else if NameIsUnique then
    PutS(NP^)
  else begin
    U := CurUnit.UnitImpRec[hUnit];
    PutSFmt('%s.%s',[U^.Name^,NP^]);
  end ;
end ;

procedure TBaseDef.Show;
var
  NP: PName;
begin
  NP := FName;
  if (NP=Nil)or(NP^[0]=#0) then
    NP := @NoName;
  PutS(NP^);
//  PutS('?');
//  ShowName;
end ;

procedure TBaseDef.ShowNamed(N: PName);
begin
  if ((N<>Nil)and(N=FName)or(FName=Nil)or(FName^[0]=#0)or
      (not ShowDotTypes and(FName^[1]='.')and(Self is TTypeDef)))
    and CurUnit.RegTypeShow(Self)
    {if RegTypeShow fails the type name will be shown instead of its
     definition}
  then
    try
      Show;
    finally
      CurUnit.UnRegTypeShow(Self)
    end
  else
    ShowName;
end ;

function TBaseDef.GetName: PName;
begin
  Result := FName;
  if Result=Nil then
    Result := @NoName;
end ;

function TBaseDef.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
  Result := 0;
  DCUErrorFmt('Trying to set memory 0x%x[0x%x] to %s[0x%x]',[MOfs,MSz,Name^,
    PChar(Def)-CurUnit.MemPtr]);
end ;

{ TImpDef. }
constructor TImpDef.Create(AIK: TImpKind; AName: PName; AnInf: integer;
  ADef: PDef; AUnit: integer);
begin
  inherited Create(AName,ADef,AUnit);
  Inf := AnInf;
  ik := AIK;
end ;

procedure TImpDef.Show;
begin
  PutSFmt('%s:',[ik]);
  inherited Show;
end ;

function TImpDef.NameIsUnique: boolean;
begin
  Result := FNameIsUnique;
end ;

{ TDLLImpRec. }
constructor TDLLImpRec.Create(AName: PName; ANDX: integer; ADef: PDef; AUnit: integer);
begin
  inherited Create({'A',}AName,ADef,AUnit);
  NDX := ANDX;
end ;

procedure TDLLImpRec.Show;
var
  NoName: boolean;
begin
  NoName := (FName=Nil)or(FName^[0]=#0);
  if not NoName then
    PutSFmt('name ''%s''',[FName^]);
  if NoName or(NDX<>0) then
    PutSFmt('index $%x',[NDX])
end ;

{ TImpTypeDefRec. }
constructor TImpTypeDefRec.Create(AName: PName; AnInf: integer;
  ARTTISz: Cardinal{AL: Byte}; ADef: PDef; AUnit: integer);
begin
  inherited Create('T',AName,AnInf,ADef,AUnit);
//  L := AL;
  RTTISz := ARTTISz;
  RTTIOfs := Cardinal(-1);
  hImpUnit := hUnit;
  hUnit := -1;
  ImpName := FName;
  FName := Nil {Will be named later in the corresponding TTypeDecl};
end ;

procedure TImpTypeDefRec.Show;
var
  U: PUnitImpRec;
begin
  PutS('type'+cSoftNL);
//  ShowName;
  if hImpUnit>=0 then begin
    U := CurUnit.UnitImpRec[hImpUnit];
    PutS(U^.Name^);
    PutS('.');
  end ;
  PutS(ImpName^);
//  PutSFmt('[%d]',[L]);
  if RTTISz>0 then begin
    Inc(AuxLevel);
    PutS('{ RTTI: ');
    Inc(NLOfs,2);
    NL;
    CurUnit.ShowDataBl(0,RTTIOfs,RTTISz);
    Dec(NLOfs,2);
    PutS('}');
    Dec(AuxLevel);
  end ;
end ;

function TImpTypeDefRec.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
  Result := 0;
  if RTTIOfs<>Cardinal(-1) then
    DCUErrorFmt('Trying to change ImpRTTI(%s) memory to 0x%x[0x%x]',
      [Name^,MOfs,MSz]);
  if RTTISz<>MSz then
    DCUErrorFmt('ImpRTTI %s: memory size mismatch (.[0x%x]<>0x%x[0x%x])',
      [Name^,RTTISz,MOfs,MSz]);
  RTTIOfs := MOfs;
end ;

{**************************************************}
{ TNameDecl. }
constructor TNameDecl.Create0;
begin
  inherited Create;
  hDecl := CurUnit.AddAddrDef(Self);
end ;

constructor TNameDecl.Create;
var
  N: PName;
begin
  Create0;
  Def := DefStart;
  N := ReadName;
end ;

destructor TNameDecl.Destroy;
begin
  CurUnit.ClearAddrDef(Self);
  inherited Destroy;
end ;

function TNameDecl.GetTag: TDCURecTag;
begin
  Result := CurUnit.FixTag(Def^.Tag);
end ;

procedure TNameDecl.ShowName;
begin
  PutS(GetDCURecStr(Self,hDecl,false));
end ;
{var
  N: PName;
begin
  N := Name;
  if (N^[0]<>#0) then
    PutS(N^)
  else
    PutSFmt('_N_%x',[hDecl])
end ;
}

procedure TNameDecl.Show;
begin
  ShowName;
end ;

procedure TNameDecl.ShowDef(All: boolean);
begin
  Show;
end ;

function TNameDecl.GetName: PName;
begin
  if Def=Nil then
    Result := @NoName
  else
    Result := @Def^.Name;
end ;

function TNameDecl.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
  Result := 0;
  DCUErrorFmt('Trying to set memory 0x%x[0x%x] to %s[0x%x]',[MOfs,MSz,Name^,
    PChar(Def)-CurUnit.MemPtr]);
end ;

function TNameDecl.GetSecKind: TDeclSecKind;
begin
  Result := skNone;
end ;

function TNameDecl.IsVisible(LK: TDeclListKind): boolean;
begin
  Result := true;
end ;

{ TNameFDecl.}
constructor TNameFDecl.Create(NoInf: boolean);
var
  F1,F3: integer;
begin
  inherited Create;
  F := ReadUIndex;
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then begin
    F1 := ReadUIndex;
  end ;
  {if F and $1<>0 then
    raise Exception.CreateFmt('Flag 1 found: 0x%x',[F]);}
  if not NoInf and(F and $40<>0) then
    Inf := ReadULong;
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then begin
    if F1 and $80<>0 then begin//Could be valid for MSIL only
      B2 := ReadUIndex;
      if (CurUnit.Ver=verD8)and(F and $08<>0) then
        F3 := ReadUIndex;
    end ;
  end ;
end ;

procedure TNameFDecl.Show;
begin
  inherited Show;
  Inc(AuxLevel);
  PutSFmt('{%x,%x}',[F,Inf]);
  Dec(AuxLevel);
end ;

function TNameFDecl.IsVisible(LK: TDeclListKind): boolean;
begin
  case LK of
    dlMain: Result := (F and $40<>0);
    dlMainImpl: Result := (F and $40=0);
  else
    Result := true;
  end ;
end ;

{ TTypeDecl. }
constructor TTypeDecl.Create;
begin
  inherited Create(false{NoInf});
  hDef := ReadUIndex;
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1)and(B2<>0) then
    hDef := B2;
  CurUnit.AddTypeName(hDef,{hDecl,}@Def^.Name);
//  CurUnit.AddAddrDef(Self); moved to TNameDecl
end ;

function TTypeDecl.IsVisible(LK: TDeclListKind): boolean;
var
  RefName: PName;
begin
  Result := inherited IsVisible(LK);
  if not Result then
    Exit;
  if ShowDotTypes or(Def=Nil) then
    Exit;
  RefName := @Def^.Name;
  Result := not((RefName^[0]>#0)and(RefName^[1]='.'));
end ;

procedure TTypeDecl.Show;
var
  RefName: PName;
begin
  inherited Show;
  if (Def=Nil) then
    RefName := Nil
  else
    RefName := @Def^.Name;
 (*
  RefName := CurUnit.GetTypeName(hDef);
  if (Def=Nil)or(RefName=@Def^.Name) then
    RefName := Nil;
  if RefName<>Nil then
    PutSFmt('=%s{#%d}',[RefName^,hDef])
  else
    PutSFmt('=#%d',[hDef]);
  *)
  PutS('=');
  {  PutS('type'+cSoftNL);}
  CurUnit.ShowTypeDef(hDef,RefName);
//  PutSFmt('{#%x}',[hDef])
end ;

function TTypeDecl.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
var
  D: TTypeDef;
begin
  Result := 0;
  D := CurUnit.GetTypeDef(hDef);
  if D=Nil then
    Exit;
  Result := D.SetMem(MOfs,MSz);
end ;

function TTypeDecl.GetSecKind: TDeclSecKind;
begin
  Result := skType;
end ;

{ TTypePDecl. }

constructor TTypePDecl.Create;
begin
  inherited Create(false);
//  B1 := ReadByte;
end ;

procedure TTypePDecl.Show;
begin
//  PutS('VMT of ');
  inherited Show;
//  PutSFmt('{B1:%x}',[B1]);
  PutS(',VMT');
end ;

function TTypePDecl.IsVisible(LK: TDeclListKind): boolean;
begin
  Result := ShowVMT;
end ;

{ TVarDecl. }
constructor TVarDecl.Create;
begin
  inherited Create(false{NoInf});
  hDT := ReadUIndex;
  Ofs := ReadUIndex;
//  CurUnit.AddAddrDef(Self);
end ;

procedure TVarDecl.Show;
{var
  RefName: PName;}
begin
//  PutS('var ');
  inherited Show;
 (* RefName := CurUnit.GetTypeName(hDT);
  if RefName<>Nil then
    PutSFmt(':%s{#%d @%x}',[RefName^,hDT,Ofs])
  else
    PutSFmt(':{#%d @%x}',[hDT,Ofs]);
  *)
  PutS(': ');
  CurUnit.ShowTypeDef(hDT,Nil);
//  PutSFmt('{#%x @%x}',[hDT,Ofs]);
  Inc(AuxLevel);
  PutSFmt('{Ofs:0x%x}',[Ofs]);
  Dec(AuxLevel);
end ;

function TVarDecl.GetSecKind: TDeclSecKind;
begin
  Result := skVar;
end ;

{ TVarCDecl. }
constructor TVarCDecl.Create(OfsValid: boolean);
begin
  inherited Create;
  Sz := Cardinal(-1);
  OfsR := Ofs;
  if not OfsValid then
    Ofs := Cardinal(-1);
end ;

procedure TVarCDecl.Show;
var
  DP: Pointer;
  {SzShown: integer;}
  DS: Cardinal;
var
  Fix0: integer;
  MS: TFixupMemState;
begin
  inherited Show;
  Inc(NLOfs,2);
  PutS(' ='+cSoftNL);
  if Sz=Cardinal(-1) then
    PutS(' ?')
  else begin
    DP := Nil;
    if ResolveConsts then begin
      DP := CurUnit.GetBlockMem(Ofs,Sz,DS);
      if DP<>Nil then begin
        SaveFixupMemState(MS);
        SetCodeRange(CurUnit.DataBlPtr,DP,DS);
        Fix0 := CurUnit.GetStartFixup(Ofs);
        CurUnit.SetStartFixupInfo(Fix0);
      end ;
    end ;
    CurUnit.ShowGlobalTypeValue(hDT,DP,DS,true,false);
    if DP<>Nil then
      RestoreFixupMemState(MS);
   {
    SzShown := 0;
    if DP<>Nil then begin
      SzShown := CurUnit.ShowGlobalTypeValue(hDT,DP,Sz,true);
      if SzShown<0 then
        SzShown := 0;
    end ;
    if SzShown<Sz then
      CurUnit.ShowDataBl(SzShown,Ofs,Sz);}
  end ;
  Dec(NLOfs,2);
end ;

function TVarCDecl.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
  Result := 0;
  if Sz=Cardinal(-1) then
    Sz := MSz
  else if Sz<>MSz then //Changed for StrConstRec
    DCUErrorFmt('Trying to change typed const %s memory to 0x%x[0x%x]',
      [Name^,MOfs,MSz]);
  if Ofs=Cardinal(-1) then
    Ofs := MOfs