mainunit.pas

dede 的源代码 3.10b

  {BOZA DeDeClasses.}PEStream.ReadBuffer(FieldData.Count,2);
  //If FieldData.Count>100 Then Exit;
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FieldData.Ptr,4);

    For i:=0 To FieldData.Count-1 Do
      Begin
       {BOZA DeDeClasses.}PEStream.ReadBuffer(dw,4);
       {BOZA DeDeClasses.}PEStream.ReadBuffer(w,2);
       {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
       SetLength(sName,b);
       {BOZA DeDeClasses.}PEStream.ReadBuffer(sName[1],b);
       FieldData.AddField(sName, dw, w);
    End;
  Except
    ShowMessageFmt(err_classdump,[FsClassName,FdwFieldDefTlbPos]);
  End;
end;

procedure TClassDumper.DumpMethods(dwEndRVA : DWORD; bDumpAdditional : Boolean = False);
var  dw,i, MinRVA, MaxRVA, dwLastPublishedMeth : DWORD;
     b : Byte;
     sName : String;
     w : Word;
     idx : Integer;
     bFound : Boolean;
     BegArr, EndArr : Array of DWORD;
begin
  //Get DFM Offset
  //ClassDumper.

  if not bDumpAdditional then
    begin
        If FdwMethodDefTlbPtr=0 Then Exit;
        If Not bELF then
        If Not IsInDataSection
           Then Begin If Not InCodeSection(FdwMethodDefTlbPtr) Then Exit End
           Else If Not InDataSection(FdwMethodDefTlbPtr) Then Exit;

        {BOZA DeDeClasses.}PEStream.Seek(FdwMethodDefTlbPos,soFromBeginning);
        {BOZA DeDeClasses.}PEStream.ReadBuffer(MethodData.Count,2);

        For i:=1 To MethodData.Count Do
         Begin
            {BOZA DeDeClasses.}PEStream.ReadBuffer(w,2);
            {BOZA DeDeClasses.}PEStream.ReadBuffer(dw,4);
            {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
            SetLength(sName,b);
            {BOZA DeDeClasses.}PEStream.ReadBuffer(sName[1],b);
            ProcRefOffsets.Add(IntToHex(dw,8));
            ProcRefNames.Add(FsClassName+'.'+sName);
            MethodData.AddMethod(sName, dw, w);
         End;

        {BOZA DeDeClasses.}PEStream.Seek(FdwVMTPos,soFromBeginning);
        Repeat
            {BOZA DeDeClasses.}PEStream.ReadBuffer(dw,4);
            If MethodData.MethodIndexByRVA(dw)=-1
              Then Begin
                ProcRefOffsets.Add(IntToHex(dw,8));
                If not InCodeSection(dw) then break;
                ProcRefNames.Add('virt proc '+FsUnitName+'.VIRT_PROC_'+IntToHex(dw,8));
              End;
        Until {BOZA DeDeClasses.}PEStream.Position>=FdwFieldDefTlbPos;

        // Only The 'Good' Classes should continue down
        If FieldData.Count=0 Then Exit;
        If FdwDFMOffset=0 Then Exit;
        If not bUserProcs Then Exit;
     end
     else begin
        // Gets User Defines Procedures
        DeDeDisASM.PEStream:={BOZA DeDeClasses.}PEStream;
        //DeDeDisASM.PEHeader:=DeDeClasses.PEHEader;
        DeDeDisASM.RVAConverter.ImageBase:=DeDeClasses.PEHEader.IMAGE_BASE;
        DeDeDisASM.RVAConverter.CodeRVA:=DeDeClasses.PEHEader.Objects[1].RVA;
        DeDeDisASM.RVAConverter.PhysOffset:=DeDeClasses.PEHEader.Objects[1].PHYSICAL_OFFSET;

        //Find last published method RVA
        dwLastPublishedMeth:=0;
        for idx:=0 to MethodData.Methods.Count-1 do
          if dwLastPublishedMeth<TMethodRec(MethodData.Methods[idx]).dwRVA
             then dwLastPublishedMeth:=TMethodRec(MethodData.Methods[idx]).dwRVA;

        //Prepare Begin and End rva arrays for knows published methods
        SetLength(BegArr,MethodData.Methods.Count);
        SetLength(EndArr,MethodData.Methods.Count);
        for idx:=0 to MethodData.Methods.Count-1 do
          begin
            dw:=TMethodRec(MethodData.Methods[idx]).dwRVA;
            BegArr[idx]:=dw;
            dw:=DeDeDisASM.GetNextProcRVA(dw, bFound, False);
            EndArr[idx]:=dw;
          end;

        //The real recognition follows here
        dw:=FdwFirstProcRVA;
        Repeat
          MinRVA:=DeDeDisASM.GetNextProcRVA(dw, bFound, False);
          DebugLog(DWORD2HEX(MinRVA));
          dw:=MinRVA;

          if dw>=dwEndRVA then break;

          if (not bFound) then
                if (dw>dwLastPublishedMeth) or (dw=0)
                     then break
                     else continue;
           
           
          if dw=0 then break;

          //Here can check if the found RVA is not in the other method RVA space
          //if so /wrong recognition/ then change next rva to the end of this method rva
          for idx:=Low(BegArr) to High(BegArr) do
            if (dw>BegArr[idx]) and (dw<EndArr[idx]) then
               begin
                 dw:=EndArr[idx];
                 continue;
               end;
          
          //If method is not in the method list then add it
          idx:=MethodData.MethodIndexByRVA(dw);
          If idx=-1 Then
             Begin
               Application.ProcessMessages;
               MethodData.AddMethod('_PROC_'+DWORD2HEX(dw),dw,$FFFF);
               Inc(MethodData.Count);
             End;
        Until False;
     end;
end;

procedure TClassDumper.DumpObject(dwSelfPtrPos: DWORD);
var b  : Byte;
    dw : DWORD;
begin
  FdwSelfPrtPos:=dwSelfPtrPos;

  {BOZA DeDeClasses.}PEStream.Seek(dwSelfPtrPos,soFromBeginning);

  // Reads SelfPtr
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwSelfPrt,4);

  // Reads ClassFlag
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FbClassFlag,1);

  If FbClassFlag=$0E Then
   Begin
    // Reads ClassName length
    {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
    SetLength(FsClassName,b);

    // Reads ClassName
    {BOZA DeDeClasses.}PEStream.ReadBuffer(FsClassName[1],b);
   End;
end;

procedure TClassDumper.DumpObjectEx(dwSelfPtrPos: DWORD; btType : Byte);
var b  : Byte;
    dw : DWORD;
begin
  if btType<>0 Then
    Begin
      FdwSelfPrtPos:=dwSelfPtrPos;

      {BOZA DeDeClasses.}PEStream.Seek(dwSelfPtrPos,soFromBeginning);

      // Reads SelfPtr
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwSelfPrt,4);

      // Reads ClassFlag
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FbClassFlag,1);

      // Reads ClassName length
      {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
      SetLength(FsClassName,b);

      // Reads ClassName
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FsClassName[1],b);

      Case btType Of
        $01,$02 :
           begin
             {.. Type: 01 or 02 (Integer, Byte, Char etc.)

              DWORD	SelfPointer
              BYTE	Type = 01 or 02
              STRPAS	ClassName
              BYTE	Size (in bytes)
              DWORD     Min Value
              DWORD	Max Value
             }
           end;

        $03     :
           begin
             { Enumeration Type 03

              DWORD	SelfPointer
              BYTE	Type = 03
              STRPAS	ClassName
              BYTE      ??
              DWORD     ??
              DWORD     Number of elements minus one
              DWORD     with value SelfPointer-4 is reached
              STRPAS	EnumName1
              STRPAS	EnumName2
             }

           end;

        $06     :
           begin
             {Set Type 06 (set of TBlahBlah)

              DWORD	SelfPointer
              BYTE	Type = 06
              BYTE	?? (Count)
              DWORD	Elements type: Pointer to (SelfPointer-4)
              }

           end;

        $08     :
           begin
              {Event Type 08

                DWORD	SelfPointer
                BYTE	Type = 08
                STRPAS	ClassName
                BYTE	Event type /00 = procedure, 01 = function/
                BYTE	Param count

                PARAM_DATA
                        BYTE	Prefix     /00 - normal, 01 - *VAR*, 08 - class instance, 10 - Record/
                        STRPAS	Param Name
                        STRPAS	Param Type

                RESULT_DATA (if function)
                        STRPAS	Result Type
              }
           end;

        $0A     :
           begin
             {String Type 0A}
           end;

        $0E     :
           begin
              {Record - Type 0E

                DWORD	SelfPointer
                BYTE	Type 0E - Record
                STRPAS	ClassName
                DWORD	field_1 type
                DWORD   field_2 type
                ..........
                       / note: If the type is class then the dword is the (SelfPointer-4)
              }
           end;

        $0F     :
           begin
              (*
                Interface (0F)

                DWORD	SelfPointer
                BYTE	Type (0E)
                PASSTR	InterfaceName
                DWORD   ParentPtr
                BYTE    ?? (GUID Count)
                GUID    {00000000-0000-0000-C000-000000000046}
                STRPAS	UnitName

              *)

              
           end;

      End;
    End
    Else Begin
      // Directly Inherited from TObject Class
      FbClassFlag:=btType;


      // Additive constant to RVA-Phys conversion for CODE section
      DELTA_PHYS:=  PEHeader.IMAGE_BASE
                   +PEHeader.Objects[1].RVA
                   -PEHeader.Objects[1].PHYSICAL_OFFSET;

      FdwSelfPrt:=({BOZA DeDeClasses.}PEStream.Position+DELTA_PHYS)-8*4;

      {BOZA DeDeClasses.}PEStream.Seek(dwSelfPtrPos-DELTA_PHYS,soFromBeginning);
      // Reads ClassName length
      Try
       {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
      except
       exit;
      end;
      if b=0 then exit;
      SetLength(FsClassName,b);
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FsClassName[1],b);

      {BOZA DeDeClasses.}PEStream.Seek(FdwSelfPrt-DELTA_PHYS,soFromBeginning);
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwVMTPtr,4);
    End;
end;

function TClassDumper.GetDFMOffset(AsClassName: String): DWORD;
var i: Integer;
begin
  Result:=0;
  i:=DeDeMainForm.DFMFormList.IndexOf(AsClassName);
  if i=-1 Then Exit;
  Result:=DWORD(DeDeMainForm.DFMFormList.Objects[i]);
end;

function TClassDumper.GetMethodRVA(sMethName: String): DWORD;
var i : Integer;
begin
  Result:=0;
  For i:=0 To MethodData.Methods.Count-1 Do
    If TMethodRec(MethodData.Methods[i]).sName=sMethName Then
       Begin
         Result:=TMethodRec(MethodData.Methods[i]).dwRVA;
         Exit;
       End;
end;

function TClassDumper.InCodeSection(RVA: DWORD): Boolean;
var idx : Integer;
begin
  idx:=PEHeader.GetSectionIndexEx('CODE');
  Result:=((RVA-DELTA_PHYS)>=PEHeader.Objects[idx].PHYSICAL_OFFSET)
      and ((RVA-DELTA_PHYS)<=PEHeader.Objects[idx].PHYSICAL_OFFSET+PEHeader.Objects[idx].PHYSICAL_SIZE)
end;

function TClassDumper.InDataSection(RVA: DWORD): Boolean;
var idx : Integer;
begin
  idx:=PEHeader.GetSectionIndexEx('DATA');
  Result:=((RVA-DELTA_PHYS)>=PEHeader.Objects[idx].PHYSICAL_OFFSET)
      and ((RVA-DELTA_PHYS)<=PEHeader.Objects[idx].PHYSICAL_OFFSET+PEHeader.Objects[idx].PHYSICAL_SIZE)
end;

function TClassDumper.IsBSSDATAClass(Index: Integer): Boolean;
begin
  IF Index>FdwDATAPrt.Count
    then result:=false
    else Result:=
           ((FdwDATAPrt[Index]<>nil) or (FdwDFMOffset<>0))
       and (FdwBSSOffset[Index]<>nil)
       and (FdwHeapPtr[Index]<>nil);
end;

Function TClassDumper.IsInData(RVA : DWORD) : Boolean;
var idx : Integer;
begin
  idx:=PEHeader.GetSectionIndexEx('DATA');
  Result:=((RVA-PEHeader.IMAGE_BASE)>=PEHeader.Objects[idx].RVA)
      and ((RVA-PEHeader.IMAGE_BASE)<=PEHeader.Objects[idx].RVA+PEHeader.Objects[idx].VIRTUAL_SIZE);
End;


{ TClassesDumper }

procedure TClassesDumper.AddClass(dwSelfPtrPos: DWORD);
var inst, inst1 : TClassDumper;
    b : Byte;
    s : String;
begin
  PEFile.PEStream.Seek(dwSelfPtrPos+5,soFromBeginning);
  PEFile.PEStream.ReadBuffer(b,1);
  SetLength(s,b);
  PEFile.PEStream.ReadBuffer(s[1],b);
  DeDeMainForm.DumpStatusLbl.Caption:=msg_processing+s+'...';
  Application.ProcessMessages;
  inst:=TClassDumper.Create;
  //inst.PEHeader:=PEHeader;
  Try
    inst.Dump(dwSelfPtrPos);
  Except
    Exit;
  End;

  // Add unit name in Unit list in the case of Delphi2 and CBuilder
  If (GlobCBuilder) or (GlobDelphi2) then