dcurecs.pas

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

  if not(IsVar and not InReg {it doesn't make sense}) then begin
    if IsVar or not InReg then
      Result := Result+CurUnit.GetOfsQualifier(TLocalDecl(D).hDT,Ofs)
    else {not IsVar and InReg} begin
      if Ofs=0 then
        Exit;
     //Try to interpret the value as a pointer:
      Result := Format('@%s%s',[Result,CurUnit.GetRefOfsQualifier(TLocalDecl(D).hDT,Ofs)]);
    end ;
    Exit;
  end ;
  if Ofs=0 then
    Exit;
  Result := Format('%s+%d',[Result,Ofs])
end ;

procedure TProcDecl.ShowDef(All: boolean);
var
  Ofs0: Cardinal;
begin
  if IsProc then begin
    case MethodKind of
      mkConstructor: PutS('constructor ');
      mkDestructor: PutS('destructor ');
    else
      PutS('procedure ');
    end ;
   end
  else
    PutS('function ');
  inherited Show;
  if Def^.Name[0]=#0 then
    PutS('?');
  ShowArgs;
  if All then begin
    if FProcLocVarCnt>=2 then begin
      Inc(AuxLevel);
      PutSFmt('{LVFlags: %x,%x,%x,%x,%x}',[FProcLocVarTbl^[0].ofs,
        FProcLocVarTbl^[0].frame,FProcLocVarTbl^[1].sym,
        FProcLocVarTbl^[1].ofs,FProcLocVarTbl^[1].frame]);
      Dec(AuxLevel);
    end ;
    Ofs0 := NLOfs;
    PutS(';');
    if Locals<>Nil then
      CurUnit.ShowDeclList(dlEmbedded,Locals,Ofs0{+2},2,[dsLast,dsOfsProc],
        BlockSecKinds,skNone);
    if Embedded<>Nil then
      CurUnit.ShowDeclList(dlEmbedded,Embedded,Ofs0{+2},2,[dsLast,dsOfsProc],
        BlockSecKinds,skNone);
//    PutS('; ');
    NLOfs := Ofs0;
    NL;
    PutS('begin');
    NLOfs := Ofs0+2;
    GetRegVarInfo := GetRegDebugInfo;
    if not JustData then
      CurUnit.ShowCodeBl(AddrBase,CodeOfs,Sz)
    else begin
      NL;
      PutS('data ');
      CurUnit.ShowDataBl(AddrBase,CodeOfs,Sz);
    end ;
    GetRegVarInfo := Nil;
    NLOfs := Ofs0;
    NL;
    PutS('end');
  end ;
end ;

procedure TProcDecl.Show;
begin
  ShowDef(true);
end ;

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

{ TSysProcDecl. }
constructor TSysProcDecl.Create;
begin
  inherited Create;
  F := ReadUIndex;
  Ndx := ReadIndex;
//  CurUnit.AddAddrDef(Self);
//  CodeOfs := CurUnit.RegDataBl(Sz);
end ;

function TSysProcDecl.GetSecKind: TDeclSecKind;
begin
  Result := skProc;
end ;

procedure TSysProcDecl.Show;
begin
  PutS('sysproc ');
  inherited Show;
  PutSFmt('{#%x}',[F]);
//  PutSFmt('{%x,#%x}',[F,V]);
//  NL;

//  CurUnit.ShowDataBl(CodeOfs,Sz);
end ;

(*
{ TAtDecl. }
  //May be start of implementation?
constructor TAtDecl.Create;
begin
  inherited Create;
  NDX := ReadIndex;
  NDX1 := ReadIndex;
end ;

procedure TAtDecl.Show;
begin
  PutSFmt('implementation ?{NDX:%x,NDX:%x}',[NDX,NDX1]);
  inherited Show;
end ;
*)

{ TSysProc8Decl. }
constructor TSysProc8Decl.Create;
{var
  B80,H,B0,Sz: TNDX;}
begin
  {B80 := ReadUIndex;
  H := ReadUIndex;
  B0 := ReadUIndex;
  Sz := ReadUIndex;}
  inherited Create(Nil{AnEmbedded},true{NoInf});
end ;


{ TUnitAddInfo. }
constructor TUnitAddInfo.Create;
begin
  inherited Create(false{NoInf});
  B := ReadUIndex;
  Tag := ReadTag;
  CurUnit.ReadDeclList(dlUnitAddInfo,Sub);
end ;

destructor TUnitAddInfo.Destroy;
begin
  FreeDCURecList(Sub);
  inherited Destroy;
end ;

function TUnitAddInfo.IsVisible(LK: TDeclListKind): boolean;
begin
  Result := false;
end ;


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

(* It's StrConstRec
{ TAddInfo6. }
constructor TAddInfo6.Create;
begin
  inherited Create;
  V0 := ReadUIndex;
  V1 := ReadUIndex;
  V2 := ReadUIndex;
  V3 := ReadUIndex;
  Ofs := 0;
  Sz := 0;
end ;

procedure TAddInfo6.Show;
begin
  inherited Show;
  Puts('{AddInfo6}={'); NL;
  CurUnit.ShowDataBl(0,Ofs,Sz);
  Puts('}');
end ;

function TAddInfo6.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
  Result := 0;
  Sz := MSz;
  Ofs := MOfs;
end ;
*)

{--------------------------------------------------------------------}
{ TTypeDef. }
constructor TTypeDef.Create;
begin
  inherited Create(Nil,DefStart,-1);
  RTTISz := ReadUIndex;
  Sz := ReadIndex{ReadUIndex};
  V := ReadUIndex;
  if CurUnit.IsMSIL then begin
    ReadUIndex;
    ReadUIndex;
   end
  else if (CurUnit.Ver>=verD9)and(CurUnit.Ver<verK1) then
    ReadUIndex;
  CurUnit.AddTypeDef(Self);
  {if V<>0 then
    CurUnit.AddAddrDef(Self);}
  RTTIOfs := Cardinal(-1){CurUnit.RegDataBl(RTTISz)};
end ;

destructor TTypeDef.Destroy;
begin
  CurUnit.ClearLastTypeDef(Self);
  inherited Destroy;
end ;

procedure TTypeDef.ShowBase;
begin
  Inc(AuxLevel);
  PutSFmt('{Sz: %x, RTTISz: %x, V: %x}',[Sz,RTTISz,V]);
  Dec(AuxLevel);
//  PutSFmt('{Sz: %x, V: %x}',[Sz,V]);
  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 ;

procedure TTypeDef.Show;
begin
  ShowBase;
end ;

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

function TTypeDef.ShowValue(DP: Pointer; DS: Cardinal): integer {Size used};
begin
  if Sz>DS then begin
    Result := -1;
    Exit;
  end ;
  Result := Sz;
  NL;
  ShowDump(DP,Nil,0,0,Sz,0,0,0,0,Nil,false);
end ;

function TTypeDef.GetOfsQualifier(Ofs: integer): String;
begin
  if Ofs=0 then
    Result := ''
  else if Ofs<Sz then
    Result := Format('.byte[%d]',[Ofs])
  else
    Result := Format('.?%d',[Ofs]); //Error
end ;

function TTypeDef.GetRefOfsQualifier(Ofs: integer): String;
begin
  if Ofs=0 then
    Result := '^'
  else
    Result := Format('^?%d',[Ofs]); //Error
end ;

{ TRangeBaseDef. }

procedure TRangeBaseDef.GetRange(var Lo,Hi: TInt64Rec);
var
  CP0: TScanState;
begin
  ChangeScanState(CP0,LH,18);
  ReadIndex64(Lo);
  ReadIndex64(Hi);
  RestoreScanState(CP0);
end ;

function TRangeBaseDef.ShowValue(DP: Pointer; DS: Cardinal): integer {Size used};
var
  CP0: TScanState;
  Neg: boolean;
  Lo: TNDX;
  Tag: TDCURecTag;
begin
  if Sz>DS then begin
    Result := -1;
    Exit;
  end ;
  Result := Sz;
  if Def=Nil then
    Tag := drRangeDef{Just in case}
  else
    Tag := TDCURecTag(Def^);
  case Tag of
    drChRangeDef:
     if Sz=1 then begin
       PutS(CharStr(Char(DP^)));
       Exit;
     end ;
    drWCharRangeDef:
     if Sz=2 then begin
       PutS(WCharStr(WideChar(DP^)));
       Exit;
     end ;
    drBoolRangeDef: begin
      PutS(BoolStr(DP,Sz));
      Exit;
    end ;
  end ;
  ChangeScanState(CP0,LH,18);
  Lo := ReadIndex;
  Neg := NDXHi<0{Lo<0};
  RestoreScanState(CP0);
  PutS(IntLStr(DP,Sz,Neg));
end ;

procedure TRangeBaseDef.Show;
var
  Lo,Hi: TInt64Rec;
  U: TUnit;
  T: TTypeDef;

  procedure ShowVal(var V: TInt64Rec);
  begin
    if (T=Nil)or(U.ShowTypeValue(T,@V,8,true)<0) then begin
      NDXHi := V.Hi;
      PutS(NDXToStr(V.Lo));
    end ;
  end ;

begin
  inherited Show;
  Inc(AuxLevel);
  PutS('{');
//  CurUnit.ShowTypeDef(hDTBase,Nil);
  CurUnit.ShowTypeName(hDTBase);
//  PutSFmt(',#%x,B:%x}',[hDTBase,B]);
  PutSFmt(',B:%x}',[B]);
  Dec(AuxLevel);
  GetRange(Lo,Hi);
  T := CurUnit.GetGlobalTypeDef(hDTBase,U);
  ShowVal(Lo);
  PutS('..');
  ShowVal(Hi);
end ;

{ TRangeDef. }
constructor TRangeDef.Create;
var
  Lo: TNDX;
  Hi: TNDX;
begin
  inherited Create;
  hDTBase := ReadUIndex;
  LH := ScSt.CurPos;
  Lo := ReadIndex;
  Hi := ReadIndex;
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
    B := ReadUIndex
  else
    B := ReadByte; //It could be index too, but I'm not sure
end ;

{ TEnumDef. }
constructor TEnumDef.Create;
var
  Lo: TNDX;
  Hi: TNDX;
begin
  inherited Create;
  hDTBase := ReadUIndex;
  NDX := ReadIndex;
  LH := ScSt.CurPos;
  Lo := ReadIndex;
  Hi := ReadIndex;
  if (CurUnit.Ver>=verD8)and(CurUnit.Ver<verK1) then
    B := ReadUIndex
  else
    B := ReadByte; //It could be index too, but I'm not sure
end ;

destructor TEnumDef.Destroy;
begin
  if NameTbl<>Nil then begin
    if NameTbl.Count>0 then
      FreeDCURecList(NameTbl[0]);
    NameTbl.Free;
  end ;
  inherited Destroy;
end ;

function TEnumDef.ShowValue(DP: Pointer; DS: Cardinal): integer {Size used};
var
  V: Cardinal;
begin
  if Sz>DS then begin
    Result := -1;
    Exit;
  end ;
  Result := Sz;
  if not MemToUInt(DP,Sz,V)or(V<0)or(NameTbl=Nil)or(V>=NameTbl.Count) then begin
    ShowName;
    PutS('(');
    inherited ShowValue(DP,DS);
    PutS(')');
    Exit;
  end ;
  TConstDecl(NameTbl[V]).ShowName;
end ;

procedure TEnumDef.Show;
var
  EnumConst: TNameDecl;
  i: integer;
begin
  if NameTbl=Nil then begin
    inherited Show;
    Exit;
  end ;
  ShowBase;
  Inc(AuxLevel);
  PutS('{');
//  CurUnit.ShowTypeDef(hDTBase,Nil);
  CurUnit.ShowTypeName(hDTBase);
//  PutSFmt(',#%x,B:%x}',[hDTBase,B]);
  PutSFmt(',B:%x}',[B]);
  Dec(AuxLevel);
  Inc(NLOfs,1);
  SoftNL;
  PutS('(');
  Inc(NLOfs,1);
  for i:=0 to NameTbl.Count-1 do begin
    if i>0 then
      PutS(','+cSoftNL);
    EnumConst := NameTbl[i];
    PutS(EnumConst.Name^);
  end ;
  PutS(')');
  Dec(NLOfs,2);
end ;

{ TFloatDef. }
constructor TFloatDef.Create;
begin
  inherited Create;
  B := ReadByte;
end ;

function TFloatDef.ShowValue(DP: Pointer; DS: Cardinal): integer {Size used};
var
  E: Extended;
  N: PName;
  Ok: boolean;
begin
  if Sz>DS then begin
    Result := -1;
    Exit;
  end ;
  Result := Sz;
  Ok := true;
  case Sz of
    SizeOf(Single): E := Single(DP^);
    SizeOf(Double): begin {May be TypeInfo should be used here}
      N := Name;
      if N=Nil then
        Ok := false
      else begin
        if CompareText(N^,'Double')=0 then
          E := Double(DP^)
        else if CompareText(N^,'Currency')=0 then
          E := Currency(DP^)
        else if CompareText(N^,'Comp')=0 then
          E := Comp(DP^)
        else
          Ok := false;
      end ;
    end ;
    SizeOf(Extended): E := Extended(DP^);
    SizeOf(Real): E := Real(DP^);
  else
    Ok := false;
  end ;
  if Ok then begin
    PutsFmt('%g',[E]);
    Exit;
  end ;
  Result := inherited ShowValue(DP,Sz);
end ;

procedure TFloatDef.Show;
begin
  Inc(AuxLevel);
  PutS('float');
  Dec(AuxLevel);
  inherited Show;
  Inc(AuxLevel);
  PutSFmt('{B:%x}',[B]);
  Dec(AuxLevel);
end ;

{ TPtrDef. }
constructor TPtrDef.Create;
begin
  inherited Create;
  hRefDT := ReadUIndex;
end ;

type
  TShowPtrValProc = function(Ndx: TNDX; Ofs: Cardinal): boolean of object;

procedure ShowPointer(DP: Pointer; NilStr: String; ShowVal: TShowPtrValProc);
var
  V: Pointer;
  Fix: PFixupRec;
  VOk: boolean;
  FxName: PName;
begin
  V := Pointer(DP^);
  if GetFixupFor(DP,4,true,Fix)and(Fix<>Nil) then begin
    FxName := TUnit(FixUnit).AddrName[Fix^.Ndx];
    VOk := (FxName^[0]=#0) {To prevent from decoding named blocks}
      and Assigned(ShowVal)and ShowVal(Fix^.Ndx,Cardinal(V));
    if VOk then begin
      PutS(cSoftNL+'{');
    end ;
    PutS('@');
    if not ReportFixup(Fix,Cardinal(V),false{not VOk} {UseHAl}) then
     if V<>Nil then
       PutSFmt('+$%x',[Cardinal(V)]);
    if