dcurecs.pas

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

  if NDXB<>-1 then
    PutSFmt(' NDXB:%x',[NDXB]);
  PutS('}');
  Dec(AuxLevel);
  if NDXB<>-1 then begin
    case NDXB and $6 of
      $2: PutS(cSoftNL+'readonly');
      $4: PutS(cSoftNL+'writeonly');
    end ;
  end ;
  PutsFmt(cSoftNL+'dispid $%x',[integer(NDX)]);
  Dec(NLOfs,2);
end ;

{ TConstDeclBase. }
constructor TConstDeclBase.Create;
begin
  inherited Create(false{NoInf});
//  CurUnit.AddAddrDef(Self);
end ;

procedure TConstDeclBase.ReadConstVal;
begin
  ValSz := ReadUIndex;
  if ValSz=0 then begin
    ValPtr := Nil;
    Val := ReadIndex;
    ValSz := NDXHi;
   end
  else begin
    ValPtr := ScSt.CurPos;
    SkipBlock(ValSz);
    Val := 0;
  end ;
end ;

procedure TConstDeclBase.ShowValue;
var
  DP: Pointer;
  DS: Cardinal;
  V: TInt64Rec;
  MemVal: boolean;
begin
  if ValPtr=Nil then begin
    V.Hi := ValSz;
    V.Lo := Val;
    DP := @V;
    DS := 8;
   end
  else begin
    DP := ValPtr;
    DS := ValSz;
  end ;
  MemVal := ValPtr<>Nil;
  if (CurUnit.ShowGlobalTypeValue(hDT,DP,DS,MemVal,true)<0)and not MemVal then begin
    CurUnit.ShowTypeName(hDT);
    NDXHi := V.Hi;
    PutSFmt('(%s)',[NDXToStr(V.Lo)]);
  end ;
end ;

procedure TConstDeclBase.Show;
var
  RefName: PName;
  TypeNamed: boolean;
begin
  inherited Show;
 (*
  RefName := CurUnit.GetTypeName(hDT);
  if RefName<>Nil then
    PutSFmt('=%s{#%d}(',[RefName^,hDT])
  else
    PutSFmt('={#%d}',[hDT]);
  if ValPtr=Nil then begin
    if ValSz<>0 then
      PutSFmt('$%x%8:8x',[ValSz,Val])
    else
      PutSFmt('$%x',[Val]);
  end ;
  if RefName<>Nil then
    PutS(')');
  *)
  Inc(NLOfs,2);
  PutS(' ');
  Inc(AuxLevel);
  if AuxLevel<=0 then begin
    PutS('{:'+cSoftNL);
    CurUnit.ShowTypeName(hDT);
    PutS('}'+cSoftNL)
  end ;
  Dec(AuxLevel);
  PutS('='+cSoftNL);
  Inc(AuxLevel);
  if (CurUnit.Ver>verD4)and(hX<>0{It is almost always=0}) then
    PutSFmt('{X:#%x}',[hX]);
  Dec(AuxLevel);
  ShowValue;
  Dec(NLOfs,2);
 (*
  TypeNamed := CurUnit.ShowTypeName(hDT);
  if TypeNamed then
    PutS('(');
  if ValPtr=Nil then begin
    NDXHi := ValSz;
    PutS(NDXToStr(Val));
   end
  else begin
    Inc(NLOfs,2);
    NL;
    ShowDump(ValPtr,0,ValSz,0,0,0,0,Nil,false);
    Dec(NLOfs,2);
  end ;
  if TypeNamed then
    PutS(')');
  *)
end ;

function TConstDeclBase.GetSecKind: TDeclSecKind;
begin
  Result := skConst;
end ;

{ TConstDecl. }
constructor TConstDecl.Create;
begin
  inherited Create;
  hDT := ReadUIndex;
  if CurUnit.Ver>verD4 then
    hX := ReadUIndex;
  ReadConstVal;
end ;

{ TResStrDef. }
constructor TResStrDef.Create;
begin
  inherited Create(false);
  OfsR := Ofs;
  Ofs := Cardinal(-1);
end ;

procedure TResStrDef.Show;
begin
  inherited Show; //The reference to HInstance will be shown
  Inc(NLOfs,2);
  SoftNL;
  CurUnit.ShowGlobalConstValue(hDecl+1);
  Dec(NLOfs,2);
end ;

function TResStrDef.GetSecKind: TDeclSecKind;
begin
  Result := skResStr;
end ;

{
procedure TResStrDef.Show;
begin
  PutS('res');
  inherited Show;
end ;
}
(*
constructor TResStrDef.Create;
begin
  inherited Create;
  hDT := ReadUIndex;
  NDX := ReadIndex;
  NDX1 := ReadIndex;
  B1 := ReadByte;
  B2 := ReadByte;
  V := ReadIndex;
  ReadConstVal;
  RefOfs := Cardinal(-1);
end ;

procedure TResStrDef.Show;
begin
  inherited Show;
  PutSFmt('{NDX:%x,NDX1:%x,B1:%x,B2:%x,V:%x}',[NDX,NDX1,B1,B2,V]);
  NL;
  if RefOfs<>Cardinal(-1) then begin
    PutS('{');
    CurUnit.ShowDataBl(RefOfs,RefSz);
    PutS('}');
  // NL;
  end ;
end ;

procedure TResStrDef.SetMem(MOfs,MSz: Cardinal);
begin
  if RefOfs<>Cardinal(-1) then
    DCUErrorFmt('Trying to change resourcestring memory %s',[Name^]);
  RefOfs := MOfs;
  RefSz := MSz;
end ;
*)

{ TSetDeftInfo. }
constructor TSetDeftInfo.Create;
begin
//  inherited Create;
  Def := DefStart;
  hDecl := -1;
  hConst := ReadUIndex;
  hArg := ReadUIndex;
end ;

procedure TSetDeftInfo.Show;
begin
  Inc(NLOfs,2);
  PutSFmt('Let %s :='+cSoftNL,[CurUnit.GetAddrStr(hArg,false)]);
  CurUnit.ShowGlobalConstValue(hConst);
  Dec(NLOfs,2);
end ;

{ TCopyDecl. }
constructor TCopyDecl.Create;
{
This kind of records was observed in DRIntf.dcu of D2006 where the
unit has several records of the same structure:
  TID         = record Reserved: array[$1..$6] of Byte; end;
  TDatabaseID = record Reserved: array[$1..$6] of Byte; end;
  TTableID    = --//--
  TFieldID    = --//--
  TAttrID     = --//--
Now they use drCopyDecl to point to the 1st Reserved declaration
instead of duplicating it
}
var
  SrcDef: TDCURec;
begin
  inherited Create0;
  hBase := ReadUIndex; //index of the address to copy from
  SrcDef := CurUnit.GetAddrDef(hBase);
  if SrcDef=Nil then
    DCUErrorFmt('CopyDecl index #%x not found',[hBase]);
  if not(SrcDef is TNameDecl) then
    DCUErrorFmt('CopyDecl index #%x(%s) is not a TNameDecl',[hBase,SrcDef.Name^]);
  Base := TNameDecl(SrcDef);
  Def := Base.Def;
end ;

procedure TCopyDecl.Show;
begin
  Base.Show;
  Inc(AuxLevel);
  PutSFmt('{Copy of:#%x}',[hBase]);
  Dec(AuxLevel);
end ;

function TCopyDecl.GetSecKind: TDeclSecKind;
begin
  Result := Base.GetSecKind;
end ;

(*
{ TProcDeclBase. }
constructor TProcDeclBase.Create;
begin
  inherited Create;
  CodeOfs := Cardinal(-1);
//  CurUnit.AddAddrDef(Self);
end ;

function TProcDeclBase.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
  if CodeOfs<>Cardinal(-1) then
    DCUErrorFmt('Trying to change procedure %s memory to 0x%x[0x%x]',
      [Name^,MOfs,MSz]);
  if Sz>MSz then
    DCUErrorFmt('Procedure %s: memory size mismatch (.[0x%x]>0x%x[0x%x])',
      [Name^,Sz,MOfs,MSz]);
  CodeOfs := MOfs;
  Result := MSz-Sz {it can happen for ($L file) with several procedures};
end ;

function TProcDeclBase.GetSecKind: TDeclSecKind;
begin
  Result := skProc;
end ;
*)

{ TProcDecl. }

function ReadCallKind: TProcCallKind;
begin
  Result := pcRegister;
  if (Tag>=Low(TProcCallTag))and(Tag<=High(TProcCallTag)) then begin
    Result := TProcCallKind(Ord(Tag)-Ord(Low(TProcCallTag))+1);
    Tag := ReadTag;
  end ;
end ;

constructor TProcDecl.Create(AnEmbedded: TNameDecl; NoInf: boolean);
var
  NoName: boolean;
  ArgP: ^TNameDecl;
  Loc: TNameDecl;
begin
  inherited Create(NoInf);
  CodeOfs := Cardinal(-1);
 {---}
  Embedded := AnEmbedded;
  NoName := IsUnnamed;
  MethodKind := mkProc;
  Locals := Nil;
  B0 := ReadUIndex{ReadByte};
  Sz := ReadUIndex;
  if not NoName then begin
    if CurUnit.Ver>verD2 then
      VProc := ReadIndex;
    hDTRes := ReadUIndex;
    if (CurUnit.Ver>verD7)and(CurUnit.Ver<verK1) then
      ReadUIndex;
    Tag := ReadTag;
    CallKind := ReadCallKind;
    try
      CurUnit.ReadDeclList(dlArgs,Args);
    except
      on E: Exception do begin
        E.Message := Format('%s in proc %s',[E.Message,Name^]);
        raise;
      end ;
    end ;
    if Tag<>drStop1 then
      TagError('Stop Tag');
    ArgP := @Args;
    while ArgP^<>Nil do begin
      Loc := ArgP^;
      if not(Loc.GetTag in [arVal,arVar]) then
        Break;
      ArgP := @Loc.Next;
    end ;
    Locals := ArgP^;
    ArgP^ := Nil;
    //Tag := ReadTag;
  end ;
//  CodeOfs := CurUnit.RegDataBl(Sz);
end ;

destructor TProcDecl.Destroy;
begin
  FreeDCURecList(Locals);
  FreeDCURecList(Args);
  FreeDCURecList(Embedded);
  inherited Destroy;
end ;

function TProcDecl.IsUnnamed: boolean;
begin
  Result := (Def^.Name[0]=#0)or(Def^.Name='.')
    or(CurUnit.Ver>=verD6)and(CurUnit.Ver<verK1)and(Def^.Name='..')
    or((CurUnit.Ver>=verK1)or(CurUnit.Ver>=verD8))
      and(Def^.Name[1]='.'){and(Def^.Name[Length(Def^.Name)]='.')};
   //In Kylix are used the names of the kind '.<X>.'
   //In Delphi 6 were noticed only names '..'
   //In Delphi 9 were noticed names of the kind '.<X>'
end ;

function TProcDecl.SetMem(MOfs,MSz: Cardinal): Cardinal {Rest};
begin
  if CodeOfs<>Cardinal(-1) then
    DCUErrorFmt('Trying to change procedure %s memory to 0x%x[0x%x]',
      [Name^,MOfs,MSz]);
  if Sz>MSz then
    DCUErrorFmt('Procedure %s: memory size mismatch (.[0x%x]>0x%x[0x%x])',
      [Name^,Sz,MOfs,MSz]);
  CodeOfs := MOfs;
  Result := MSz-Sz {it can happen for ($L file) with several procedures};
end ;

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

const
  CallKindName: array[TProcCallKind] of String =
    ('register','cdecl','pascal','stdcall','safecall');

function TProcDecl.IsProc: boolean;
begin
  Result := CurUnit.TypeIsVoid(hDTRes);
end ;

procedure TProcDecl.ShowArgs;
var
  NoName: boolean;
  Ofs0: Cardinal;
  ArgL: TNameDecl;
begin
  NoName := IsUnnamed;
  Inc(AuxLevel);
  PutSFmt('{B0:%x,Sz:%x',[B0,Sz]);
  if not NoName then begin
    if CurUnit.Ver>verD2 then
      PutSFmt(',VProc:%x',[VProc]);
  end ;
  PutS('}');
  Dec(AuxLevel);
  Ofs0 := NLOfs;
  Inc(NLOfs,2);
  ArgL := Args;
  if (not ShowSelf)and(MethodKind<>mkProc) then begin
    if (ArgL<>Nil)and(ArgL.Name^='Self') then begin
      ArgL := TNameDecl(ArgL.Next);
      if (ArgL<>Nil)and(MethodKind<>mkMethod){Constructor or Destructor - skip the 2nd call flag}
        and(ArgL.Name^='.')
      then
        ArgL := TNameDecl(ArgL.Next);
    end ;
  end ;
  if ArgL<>Nil then
    PutS(cSoftNL+'(');
  CurUnit.ShowDeclList(dlArgs,ArgL,Ofs0,2,[{dsComma,}dsNoFirst,dsSoftNL],
    ProcSecKinds,skNone);
  NLOfs := Ofs0+2;
  if ArgL<>Nil then
    PutS(')');
  if not IsProc then begin
    PutS(':'+cSoftNL);
    CurUnit.ShowTypeDef(hDTRes,Nil);
  end ;
  if CallKind<>pcRegister then begin
    PutS(';'+cSoftNL);
    PutS(CallKindName[CallKind]);
  end ;
  if (CurUnit.Ver>verD3)and(VProc and $1000 <> 0) then begin
    PutS(';'+cSoftNL);
    PutS('overload');
  end ;
  NLOfs := Ofs0;
end ;

function GetNameAtOfs(L,LBest: TDCURec; Frame: integer; var DBest: integer): TDCURec;
var
  D: integer;
begin
  Result := LBest;
  while L<>Nil do begin
    if (L is TLocalDecl)and(TLocalDecl(L).GetTag<>arFld)
      and(TLocalDecl(L).LocFlags and $8=0 {not a register})
    then begin
      D := Frame-TLocalDecl(L).Ndx;
      if (D>=0)and(D<DBest) then begin
        Result := L;
        DBest := D;
        if D=0 then
          Exit;
      end ;
    end ;
    L := L.Next;
  end ;
end ;

function TProcDecl.GetRegDebugInfo(ProcOfs: integer; hReg: THBMName; Ofs: integer): String;
const
  RegId: array[0..6+12] of THBMName =
    (hnEAX,hnEDX,hnECX,hnEBX,hnESI,hnEDI,hnEBP,
    //Register parts:
     hnAL,hnDL,hnCL,hnBL, hnAH,hnDH,hnCH,hnBH, hnAX,hnDX,hnCX,hnBX);
var
  i,id,hDef: integer;
  {Res: TLocalDecl;}
  D: TDCURec;
  TD: TTypeDef;
  U: TUnit;
  DOfs,Sz: integer;
  LVP: PLocVarRec;
  Tag: TDCURecTag;
  InReg,IsVar: boolean;
begin
  Result := '';
  id := -1;
  hReg := hReg or nf;
  for i:=Low(RegId) to High(RegId) do
   if RegId[i]=hReg then begin
     id := i;
     break;
   end ;
  if id<0 then begin
    if hReg<>hnESP then
      Exit;
    //For ESP-based procedures. I can't understand how
    //we can distinguish the two kinds by some flags
    id := -2; //-1 denotes symbol scope end
  end ;
  if id>6 then
    id := (id-7)and $3; //Register part
  LVP := @(FProcLocVarTbl^[2]);
  hDef := -1;
  for i:=2 to FProcLocVarCnt-1 do begin
    if LVP^.Ofs>ProcOfs then
      break;
    if LVP^.frame=id then
      hDef := LVP^.Sym
    else if (LVP^.frame=-1)and(LVP^.Sym=hDef) then
      hDef := -1;
    Inc(LVP);
  end ;
  TD := Nil;
  IsVar := false;
  if hDef>=0 then begin
    InReg := true;
    D := CurUnit.GetAddrDef(hDef);
    if D=Nil then begin
      Result := Format('Def #%x=Nil',[hDef]);
      Exit; //Silent error
    end ;
    Sz := 4;
    //TD := CurUnit.GetGlobalTypeDef(TLocalDecl(D).hDT,U);
    case TLocalDecl(D).GetTag of
     arVar: IsVar := true;
     //arVal,drVar{local},arResult:;
    end ;
   end
  else begin
    if (id<>6{EBP})and(hReg<>hnESP{It can also be used as frame base}){or(Ofs=0)}
      //But it's difficult to follow the ESP changes due to arg PUSHes
    then
      Exit;
    {Seek EBP+Ofs variables}
    InReg := false;
    DOfs := MaxInt;
    D := GetNameAtOfs(Args,Nil,Ofs,DOfs);
    if DOfs<>0 then begin
      D := GetNameAtOfs(Locals,D,Ofs,DOfs);
      if DOfs<>0 then begin
        D := GetNameAtOfs(Embedded,D,Ofs,DOfs);
        if D=Nil then
          Exit;
      end ;
    end ;
    Sz := 1;
    case TLocalDecl(D).GetTag of
     arVar: begin
       Sz := 4;
       IsVar := true;
      end ;
     arVal,drVar{local},arResult: begin
       TD := CurUnit.GetGlobalTypeDef(TLocalDecl(D).hDT,U);
       if TD<>Nil then
         Sz := TD.Sz
     end ;
    end ;
    if DOfs>=Sz then
      Exit;
    hDef := TLocalDecl(D).hDecl;
    Ofs := DOfs;
  end ;
  Result := GetDCURecStr(D, hDef,false);
  if Ofs<0 then begin
    Result := Format('%s%d',[Result,Ofs]);
    Exit;
  end ;