dcurecs.pas

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

  else if Ofs<>MOfs then
    DCUErrorFmt('typed const %s: memory ofs mismatch (0x%x<>0x%x)',
      [Name^,Ofs,MOfs]);
end ;

function TVarCDecl.GetSecKind: TDeclSecKind;
begin
  if GenVarCAsVars then
    Result := skVar
  else
    Result := skConst;
end ;

{ TAbsVarDecl. }
procedure TAbsVarDecl.Show;
begin
  inherited Show;
  PutSFmt(' absolute %s',[CurUnit.GetAddrStr(integer(Ofs),false)]);
end ;

{ TThreadVarDecl. }
function TThreadVarDecl.GetSecKind: TDeclSecKind;
begin
  Result := skThreadVar;
end ;

{ TStrConstDecl. }
constructor TStrConstDecl.Create;
var
  Tag: TDCURecTag;
begin
  inherited Create(false{NoInf});
//  if CurUnit.Ver<verD10 then
    Sz := ReadUIndex;
  hDT := ReadUIndex;
{  if CurUnit.Ver>=verD10 then begin   Wrong code - to mix with UnitAddInfo
    Tag := ReadTag;
    if Tag<>drStop1 then
      DCUError('unexplored StrConstDecl found, please report to the author.');
  end ;}
  if Sz=0 then
    Sz := Cardinal(-1);
  Ofs := Cardinal(-1);
//  if (CurUnit.Ver>=verD10)and(CurUnit.Ver)
end ;

procedure TStrConstDecl.Show;
var
  DP: Pointer;
  {SzShown: integer;}
  DS: Cardinal;
var
  Fix0: integer;
  MS: TFixupMemState;
begin
  inherited Show;
  PutS(': ');
  CurUnit.ShowTypeDef(hDT,Nil);
//  PutSFmt('{#%x @%x}',[hDT,Ofs]);
  Inc(AuxLevel);
  PutSFmt('{Ofs:0x%x}',[Ofs]);
  Dec(AuxLevel);
//  CurUnit.ShowTypeName(hDT);
  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);
  end ;
  Dec(NLOfs,2);
end ;

function TStrConstDecl.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
  else if Ofs<>MOfs then
    DCUErrorFmt('typed const %s: memory ofs mismatch (0x%x<>0x%x)',
      [Name^,Ofs,MOfs]);
end ;

function TStrConstDecl.GetSecKind: TDeclSecKind;
begin
  if GenVarCAsVars then
    Result := skVar
  else
    Result := skConst;
end ;

{ TLabelDecl. }
constructor TLabelDecl.Create;
begin
  inherited Create;
  Ofs := ReadUIndex;
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
    ReadUIndex; //=0

//  CurUnit.AddAddrDef(Self);
end ;

procedure TLabelDecl.Show;
begin
//  PutS('label ');
  inherited Show;
  PutSFmt('{at $%x}',[Ofs]);
end ;

function TLabelDecl.GetSecKind: TDeclSecKind;
begin
  Result := skLabel;
end ;

//Labels can appear in the global decl. list when declared for unit init./fin.
function TLabelDecl.IsVisible(LK: TDeclListKind): boolean;
begin
  {case LK of
    dlMain: Result := false;
    dlMainImpl: Result := true;
  else
    Result := true;
  end ;}
  Result := LK<>dlMain;
end ;

{ TExportDecl. }
constructor TExportDecl.Create;
begin
  inherited Create;
  hSym := ReadUIndex;
  Index := ReadUIndex;
end ;

procedure TExportDecl.Show;
var
  D: TDCURec;
  N: PName;
begin
  D := CurUnit.GetAddrDef(hSym);
  N := Nil;
  if D=Nil then
    PutS('?')
  else begin
    D.ShowName;
    N := D.Name;
  end ;
  Inc(NLOfs,2);
  if (N<>Nil)and(Name<>Nil)and(N^<>Name^) then begin
    PutS(cSoftNL+'name'+cSoftNL);
    ShowName;
  end ;
  if Index<>0 then
    PutSFmt(cSoftNL+'index $%x',[Index]);
  Dec(NLOfs,2);
end ;

function TExportDecl.GetSecKind: TDeclSecKind;
begin
  Result := skExport;
end ;

{ TLocalDecl. }
constructor TLocalDecl.Create(LK: TDeclListKind);
var
  M,M2: boolean;
begin
  inherited Create;
  M := GetTag in [arMethod,arConstr,arDestr];
  M2 := (CurUnit.Ver=verD2)and M;
  LocFlags := ReadUIndex;
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
    ReadUIndex; //Not shure that it's right place
  if not M2 then
    hDT := ReadUIndex
  else if M then
    Ndx := ReadUIndex
  else
    Ndx := ReadIndex;
  if LK in [dlInterface,dlDispInterface] then
    NDXB := ReadUIndex
  else
    NDXB := -1;
//    B := ReadByte;
  if not M2 then begin
    if M then
      Ndx := ReadUIndex
    else
      Ndx := ReadIndex;
   end
  else
    hDT := ReadUIndex;
  {if LK=dlArgsT then
    Exit;}
  if not(LK in [dlClass,dlInterface,dlDispInterface,dlFields]) then
  case GetTag of
    arFld:  Exit ;
    arMethod,
    arConstr,
    arDestr: (*if not((LK in [dlClass,dlInterface])and(NDX1<>0{virtual?})) then*) Exit ;
  end ;
//  CurUnit.AddAddrDef(Self);
end ;

procedure TLocalDecl.Show;
var
  RefName: PName;
  MS: String;
begin
  MS := '';
  if ShowAuxValues then
   case GetTag of
     arVal: MS := 'val ';
     arVar: MS := 'var ';
     drVar: MS := 'local ';
     arResult: MS := 'result ';
     arAbsLocVar: MS := 'local absolute ';
     arFld: MS := 'field ';
     {arMethod: MS := 'method';
     arConstr: MS := 'constructor';
     arDestr: MS := 'destructor';}
   end
  else
   case GetTag of
//     arVar,drVar,arAbsLocVar: MS := 'var ';
     arVar: MS := 'var ';
     arResult: MS := 'result ';
   end ;
  if MS<>'' then
    PutS(MS);
  inherited Show;
 (* RefName := CurUnit.GetTypeName(hDT);
  if RefName<>Nil then
    PutSFmt(':%s{#%d #1:%x #2:%x}',[RefName^,hDT,Ndx1,Ndx])
  else
    PutSFmt(':{#%d #1:%x #2:%x}',[hDT,Ndx1,Ndx]);
  *)
  PutS(': ');
  CurUnit.ShowTypeDef(hDT,Nil);
//  PutSFmt('{#%x #1:%x #2:%x}',[hDT,Ndx1,Ndx]);
  Inc(AuxLevel);
  PutSFmt('{F:%x Ofs:%d',[LocFlags,integer(Ndx)]);
  if (LocFlags and $8<>0 {register})and(GetTag<>arFld) then begin
    if (Ndx>=Low(RegName))and(Ndx<=High(RegName)) then
      PutSFmt('=%s',[RegName[Ndx]])
    else
      PutS('=?')
  end ;
  if NDXB<>-1 then
    PutSFmt(' NDXB:%x',[NDXB]);
  PutS('}');
  Dec(AuxLevel);
  if GetTag=arAbsLocVar then
    PutSFmt(' absolute %s',[CurUnit.GetAddrStr(integer(Ndx),false)]);
end ;

function TLocalDecl.GetLocFlagsSecKind: TDeclSecKind;
begin
  case LocFlags and lfScope of
    lfPrivate: Result := skPrivate;
    lfProtected: Result := skProtected;
    lfPublic: Result := skPublic;
    lfPublished: Result := skPublished;
  else
    Result := skNone{Temp};
  end
end ;

function TLocalDecl.GetSecKind: TDeclSecKind;
begin
  if GetTag in [arFld, arMethod, arConstr, arDestr, arProperty, arClassVar] then
    Result := GetLocFlagsSecKind
  else if GetTag in [arResult,drVar,arAbsLocVar] then
    Result := skVar
  else
    Result := skNone;
end ;

{ TMethodDecl. }
constructor TMethodDecl.Create(LK: TDeclListKind);
begin
  inherited Create(LK);
  InIntrf := LK in [dlInterface,dlDispInterface];
  { if Name^[0]=#0 then
      hImport := ReadUIndex; //then hDT seems to be valid index in the
        //parent class unit}
  if not InIntrf then begin
    if CurUnit.IsMSIL and(NDX<>0) then begin
      ReadByteIfEQ(1);//I was unable to find something less perverse to skip this byte
    end ;
    if (CurUnit.Ver>=verD7)and(CurUnit.Ver<verK1)or(Name^[0]=#0)
    then begin
      hImport := ReadUIndex; //then hDT seems to be valid index in the
        //parent class unit
    end ;
  end ;
  //VMTNDX := MaxInt;
end ;

procedure TMethodDecl.Show;
var
  MS: String;
  D: TDCURec;
  MK: TMethodKind;
  PD: TProcDecl absolute D;

  procedure ShowFlags;
  begin
    Inc(AuxLevel);
    PutSFmt('{F:#%x hDT:%x} ',[LocFlags,hDT]);
    if (Name^[0]=#0)and(hImport<>0) then
      PutSFmt('{hImp: #%x} ',[hImport]);
    Dec(AuxLevel);
  end ;

begin
  if LocFlags and lfClass<>0 then
    PutS('class ');
  PD := Nil;
  if ResolveMethods then begin
    if not((NDX=0)and CurUnit.IsMSIL) then begin
      D := CurUnit.GetAddrDef(NDX);
      if (D<>Nil)and not(D is TProcDecl) then
        D := Nil;
      if D<>Nil then begin
        MK := mkProc;
        case GetTag of
          arMethod: MK := mkMethod;
          arConstr: MK := mkConstructor;
          arDestr: MK := mkDestructor;
        end ;
        TProcDecl(D).MethodKind := MK;
      end ;
    end ;
  end ;
  MS := '';
  case GetTag of
    arMethod: begin
      if PD=Nil then
        MS := 'method '
      else if PD.IsProc then
        MS := 'procedure '
      else
        MS := 'function ';
    end ;
    arConstr: MS := 'constructor ';
    arDestr: MS := 'destructor ';
  end ;
  if (not InIntrf)and not((NDX=0)and CurUnit.IsMSIL) then begin
    if MS<>'' then
      PutS(MS);
    {if (Name^[0]=#0)and(hImport<>0) then
      PutS(CurUnit.GetAddrStr(integer(hImport),true))
    else}
      ShowName;
    if PD=Nil then
      PutS(': ');
    ShowFlags;
    if PD<>Nil then begin
      Inc(AuxLevel);
      PutSFmt('{%x=>%s}',[Ndx,PD.Name^]);
      Dec(AuxLevel);
      PD.ShowArgs;
     end
    else
      PutS(CurUnit.GetAddrStr(Ndx,true));
    Inc(NLOfs,2);
    if LocFlags and lfOverride<>0 then
      PutS(';'+cSoftNL+'override{');
    if LocFlags and lfVirtual<>0 then
      PutS(';'+cSoftNL+'virtual');
    if LocFlags and lfVirtual<>0 then begin
      if LocFlags and lfOverride=0 then
        PutSFmt('{@%d}',[hDT*4])
      else
        PutSFmt(' @%d',[hDT*4]);
    end ;
    if LocFlags and lfDynamic<>0 then
      PutS(';'+cSoftNL+'dynamic');
    if LocFlags and lfOverride<>0 then
      PutS('}');
    Dec(NLOfs,2);
   end
  else begin
    if MS<>'' then begin
      Inc(AuxLevel);
      PutS(MS);
      Dec(AuxLevel);
    end ;
    if (NDX=0)and CurUnit.IsMSIL then
      D := CurUnit.GetTypeDef(hImport) //this feature is used for copying method
        //definitions of TA into that of TB when TB is defined by  TB = type TA
    else
      D := CurUnit.GetTypeDef(NDX);
    if (D<>Nil)and(D is TProcTypeDef) then begin
      Inc(AuxLevel);
      PutSFmt('{T#%x}',[hDT]);
      Dec(AuxLevel);
      PutS(TProcTypeDef(D).ProcStr);
      PutS(' ');
      ShowName;
      SoftNL;
      TProcTypeDef(D).ShowDecl(Nil);
      ShowFlags;
     end
    else begin
      ShowName;
      PutS(': ');
      ShowFlags;
      CurUnit.ShowTypeDef(Ndx,Name);
    end ;
  end ;
end ;

{ TClassVarDecl. }
procedure TClassVarDecl.Show;
begin
  PutS('class var'+cSoftNL);
  inherited Show;
end ;

function TClassVarDecl.GetSecKind: TDeclSecKind;
begin
  Result := GetLocFlagsSecKind;
end ;

{ TPropDecl. }
constructor TPropDecl.Create;
var
  X,X1,X2,X3,Flags1: integer;
begin
  inherited Create;
  LocFlags := ReadIndex;
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
    Flags1 := ReadUIndex;
  hDT := ReadUIndex;
  NDX := ReadIndex;
  hIndex := ReadIndex;
  hRead := ReadUIndex;
  hWrite := ReadUIndex;
  hStored := ReadUIndex;
//  CurUnit.AddAddrDef(Self);
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then begin
    X := ReadUIndex;
    X1 := ReadUIndex;
    if CurUnit.IsMSIL then begin
      X2 := ReadUIndex;
      X3 := ReadUIndex;
    end ;
  end ;
  hDeft := ReadIndex;
end ;

procedure TPropDecl.Show;

  procedure PutOp(Name: String; hOp: TNDX);
  var
    V: String;
  begin
    if hOp=0 then
      Exit;
    V := CurUnit.GetAddrStr(hOp,true);
    PutSFmt(cSoftNL+'%s %s',[Name,V])
  end ;

var
  D: TBaseDef;
  hDT0: TDefNDX;
  U: TUnit;
begin
  PutS('property ');
  inherited Show;
  Inc(NLOfs,2);
  if hDT<>0 then begin
   {hDT=0 => inherited and something overrided}
    D := CurUnit.GetTypeDef(hDT);
    if (D<>Nil)and(D is TProcTypeDef)and(D.FName=Nil) then begin
      {array property}
      Inc(AuxLevel);
      PutSFmt('{T#%x}',[hDT]);
      Dec(AuxLevel);
      //SoftNL;
      Dec(NLOfs,2);
      TProcTypeDef(D).ShowDecl('[]');
      Inc(NLOfs,2);
     end
    else begin
      PutS(':');
    //  PutSFmt(':{#%x}',[hDT]);
      CurUnit.ShowTypeDef(hDT,Nil);
    end
  end ;
  if hIndex<>TNDX($80000000) then
    PutSFmt(cSoftNL+'index $%x',[hIndex]);
  PutOp('read',hRead);
  PutOp('write',hWrite);
  PutOp('stored',hStored);
  if hDeft<>TNDX($80000000) then begin
    hDT0 := hDT;
    U := CurUnit;
    {if hDT0=0 then //ToDo: get property type in the parent class
      hDT0 := GetPropType(U);}
    PutS(cSoftNL+'default ');
    if (U=Nil)or(U.ShowGlobalTypeValue(hDT0,@hDeft,SizeOf(hDeft),false{AndRest},true{IsConst})<0)
    then
      PutSFmt('$%x',[hDeft]);
  end ;
  Inc(AuxLevel);
  SoftNL;
  PutSFmt('{F:#%x,NDX:#%x}',[LocFlags,NDX]);
  Dec(AuxLevel);
  if LocFlags and lfDeftProp<>0 then
    PutS('; default');
  Dec(NLOfs,2);
end ;

function TPropDecl.GetSecKind: TDeclSecKind;
begin
  case LocFlags and lfScope of
    lfPrivate: Result := skPrivate;
    lfProtected: Result := skProtected;
    lfPublic: Result := skPublic;
    lfPublished: Result := skPublished;
  else
    Result := skNone{Temp};
  end;
end ;

{ TDispPropDecl. }
procedure TDispPropDecl.Show;
begin
  PutS('property ');
  ShowName;
  Inc(NLOfs,2);
  PutS(':'+cSoftNL);
  CurUnit.ShowTypeDef(hDT,Nil);
  Inc(AuxLevel);
  PutSFmt('{F:%x',[LocFlags]);