mainunit.pas

dede 的源代码 3.10b

     if DeDeMainForm.UnitList.IndexOf(inst.FsUnitName)=-1 then DeDeMainForm.UnitList.Add(inst.FsUnitName);

  If ClassExists(inst.FsClassName) Then
   begin
     inst1:=GetClassByName(inst.FsClassName);
     If (inst1.FdwDFMOffset<>0) and (inst.FdwDFMOffset<>0)
       then
         Case MessageDlg(
             Format(err_classes_same_name
             ,[inst.FsClassName,inst1.FsUnitName,inst.FsUnitName]),
             mtWarning,[mbOK,mbCancel],0) of
           mrOK     : begin
                        inst1.FdwDFMOffset:=0;
                      end;
           mrCancel : begin
                        inst.FdwDFMOffset:=0;
                      end;
         End
       else begin
          inst1.FieldData.Count:=0;
          inst1.MethodData.Count:=0;

          // Remove duplicates
          if inst.FbClassFlag=$07 then
            begin
              Classes.Remove(inst1);
              inst1.Free;
            end;
       end;
   end;
   Classes.Add(inst);
   DeDeMainForm.CustomPB.Position:=300+Trunc(700*(Classes.IndexOf(inst)-FiZeroCount)/GlobClassesCount);
   Application.ProcessMessages;
end;

procedure TClassesDumper.AddClass_D2(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);

    // Init FdwBSSOffset for non class objects not in [$07,$0E]
    // with its selfpointer. This trick is neseccary for approprite
    // emulation when custom register value is specified
    inst.FdwBSSOffset.Add(Pointer(dwSelfPtrPos));
    inst.FdwDATAPrt.Add(Pointer(dwSelfPtrPos));
    inst.FdwHeapPtr.Add(Pointer(dwSelfPtrPos));
  Except
    Exit;
  End;

  // Add unit name in Unit list in the case of Delphi2 and CBuilder
  If DeDeMainForm.UnitList.IndexOf(inst.FsUnitName)=-1 then DeDeMainForm.UnitList.Add(inst.FsUnitName);

  Classes.Add(inst);
  DeDeMainForm.CustomPB.Position:=300+Trunc(700*(Classes.IndexOf(inst)-FiZeroCount)/GlobClassesCount);
  Application.ProcessMessages;
end;

procedure TClassesDumper.AddObject(dwSelfPtrPos: DWORD);
var inst : 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;
  inst.DumpObject(dwSelfPtrPos);
  if Not ClassExists(inst.FsClassName) then
    begin
      Classes.Add(inst);
      DeDeMainForm.CustomPB.Position:=300+Trunc(700*(Classes.IndexOf(inst)-FiZeroCount)/GlobClassesCount);
      Application.ProcessMessages;
    end
    else inst.Free;      
end;

procedure TClassesDumper.AddObjectEx(dwSelfPtrPos: DWORD; btType : Byte);
var inst : TClassDumper;
    b : Byte;
    s : String;
begin
  if btType<>0 then
    begin
      PEFile.PEStream.Seek(dwSelfPtrPos+5,soFromBeginning);
      PEFile.PEStream.ReadBuffer(b,1);
      SetLength(s,b);
      PEFile.PEStream.ReadBuffer(s[1],b);
    end
    else s:='unknown type';     
  DeDeMainForm.DumpStatusLbl.Caption:=msg_processing+s+'...';
  Application.ProcessMessages;
  inst:=TClassDumper.Create;
  //inst.PEHeader:=PEHeader;
  try
   inst.DumpObjectEx(dwSelfPtrPos,btType);

   // Init FdwBSSOffset for non class objects not in [$07,$0E]
   // with its selfpointer. This trick is neseccary for approprite
   // emulation when custom register value is specified
   inst.FdwBSSOffset.Add(Pointer(dwSelfPtrPos));
   inst.FdwDATAPrt.Add(Pointer(dwSelfPtrPos));
   inst.FdwHeapPtr.Add(Pointer(dwSelfPtrPos));
  except
   exit;
  end;

  // Must add if class with such name is still
  // not added
  if GetClassByName(inst.FsClassName)=nil then
  //if Not ClassExists(inst.FsClassName) then
    begin
      Classes.Add(inst);
      if btType=0
        then Inc(FiZeroCount)
        else DeDeMainForm.CustomPB.Position:=300+Trunc(700*(Classes.IndexOf(inst)-FiZeroCount)/GlobClassesCount);
      Application.ProcessMessages;
   end
   else inst.Free;
end;

procedure TClassesDumper.LoadDFMTXTDATA;
var i, len : Integer;
    inst : TStringList;
    Input : TMemoryStream;
begin
  ClearDFMTXTDATA;
  len:=DeDeMainForm.DFMList.Items.Count;
  if len=0 then exit;

  SetLength(DFMTXTDATA_Names,len);
  For i:=0 To len-1 Do
    Begin
        DeDeMainForm.FbLoadDFMInMemo:=False;
        Try
          DeDeMainForm.DFMList.Selected:=DeDeMainForm.DFMList.Items[i];
        Finally
          DeDeMainForm.FbLoadDFMInMemo:=True;
        End;

        Input:=DeDeMainForm.PrepareDFM;
        try
          try
           DeDePAS.Convert(Input,'');
          except
            inst:=TStringList.Create;
            DFMTXTDATA_Names[i]:=DeDeMainForm.DFMList.Items[i].Caption;
            DFMTXTDATA.Add(inst);
            Input.SaveToFile(ExtractFileDir(Application.ExeName)+'\debug.dat');
            continue;
          end;
          inst:=TStringList.Create;
          inst.LoadFromFile(FsTEMPDir+'dfm.$$$');
          DeleteFile(FsTEMPDir+'dfm.$$$');
          DFMTXTDATA_Names[i]:=DeDeMainForm.DFMList.Items[i].Caption;
          DFMTXTDATA.Add(inst);
          Application.ProcessMessages;
        finally
         If Input<>nil Then Input.Free;
         DeDeMainForm.FbLoadDFMInMemo:=True;
        end;
    End;

  If FileExists(FsTEMPDir+'dfm.$$$') then DeleteFile(FsTEMPDir+'dfm.$$$');
end;



procedure TClassesDumper.ClearClasses;
var i : Integer;
begin
  For i:=Classes.Count-1 DownTo 0 Do
    TClassDumper(Classes[i]).Free;
end;

procedure TClassesDumper.ClearDFMTXTDATA;
var i : Integer;
begin
  For i:=DFMTXTDATA.Count-1 DownTo 0 Do
    TStringList(DFMTXTDATA[i]).Free;
end;

constructor TClassesDumper.Create;
begin
  Inherited Create;

  Classes:=TList.Create;
  DFMTXTDATA:=TList.Create;
  DFMOffsets:=TStringList.Create;
  BSS:=TBSS.Create;
  PackageInfoTable:=TPackageInfoTable.Create;
end;

destructor TClassesDumper.Destroy;
var i : Integer;
begin
  PackageInfoTable.Free;
  BSS.Free;
  DFMOffsets.Free;

  // Removing custom DOI form data
  For i:=0 To Classes.Count-1 Do
    If (TClassDumper(Classes[i]).FdwDFMOffset<>0)
      Then DeDeClassEmulator.OffsInfArchive.RemoveOffsInfo(TClassDumper(Classes[i]).FsClassName);

  ClearClasses;
  Classes.Free;
  ClearDFMTXTDATA;
  DFMTXTDATA.Free;

  Inherited Destroy;
end;

procedure TClassesDumper.Dump;
var dw, dw1, dw2, code_size,delta,bkup, EndSerchFuncOffs : DWORD;
    b, len : byte;
    i, j, k{, D2_idx} : Integer;
    buff, patt : Array of Byte;
    s : String;
    bFound : Boolean;

    Procedure DumpD2;
    var D2_idx, j : Integer;
        _code_size : dword;
        _bt : Byte;
    begin
      With DeDeMainForm Do
        begin
          GlobClassesCount:=DFMFormList.Count;
          CustomPB.Position:=300;

          // Copy the class name list because of delphi compiler bug !!!
          SetLength(TmpArr,DFMFormList.Count);
          For D2_idx:=0 to DFMFormList.Count-1 do TmpArr[d2_idx]:=DFMFormList[d2_idx];
        end;

      _code_size:=PEHeader.Objects[1].PHYSICAL_OFFSET+PEHeader.Objects[1].PHYSICAL_SIZE;
      // Search for $07+FormNameAsPascalString got from DFM resource list
      // patt[] is the array containing what is going to be serached
      For D2_idx:=0 to High(TmpArr) do
        Begin
          s:=TmpArr[d2_idx];
          len:=Length(s);
          SetLength(patt,len);
          patt[0]:=$07; patt[1]:=len;
          for j:=1 to len do patt[j+1]:=ORD(s[j]);

          {BOZA DeDeClasses.}PEStream.Seek(PEHeader.Objects[1].PHYSICAL_OFFSET,soFromBeginning);
          bFound:=False;

          // Read byte if it equals $07 then reads buff[] and
          // compares with patt[] else move one byte forward
          Repeat
            bkup:={BOZA DeDeClasses.}PEStream.Position;

            {BOZA DeDeClasses.}PEStream.ReadBuffer(_bt,1);
            if _bt=$07 then
              begin
                SetLength(buff,len);
                {BOZA DeDeClasses.}PEStream.ReadBuffer(buff[0],len);

                // Doesn't compare buff[0] with patt[0] because patt[0]=$07
                if CompareMem(@buff[0],@patt[1],len) then
                  begin
                    AddClass_D2(bkup-4);
                    bFound:=True;
                  end;

                {BOZA DeDeClasses.}PEStream.Seek(bkup+1,soFromBeginning);
              end;

            If {BOZA DeDeClasses.}PEStream.Position mod 200 = 0 then Application.ProcessMessages;

          Until (bFound) or ({BOZA DeDeClasses.}PEStream.Position>=_code_size);
        End;
    end; {DumpD2}

begin
  // No BSS dump if BCB
  if GlobCBuilder then  bBSS:=False;

  // If BSS option is enabled dump the BSS section
  if bBSS Then
   begin
      DeDeMainForm.DumpStatusLbl.Caption:=msg_loadingtarget;
      DeDeMainForm.DumpStatusLbl.Update;
      If FileExists(DeDeMainForm.FsFileName)
        then begin
          BSS.Free;
          BSS:=TBSS.Create;
          BSS.Dump(DeDeMainForm.FsFileName);
        end;
   end;

  // Dump DFM Offsets
  DeDeMainForm.DumpStatusLbl.Caption:=msg_dumpingdsfdata;
  DeDeMainForm.DumpStatusLbl.Update;

  Application.ProcessMessages;
  DeDeMainForm.DumpDFMNames;

  delta:=PEHeader.IMAGE_BASE+(PEHeader.Objects[1].RVA)-PEHeader.Objects[1].PHYSICAL_OFFSET;
  code_size:=PEHeader.Objects[1].PHYSICAL_OFFSET+PEHeader.Objects[1].PHYSICAL_SIZE;

  // Dump Classes
  DeDeMainForm.DumpStatusLbl.Caption:=msg_dumpingclasses;
  DeDeMainForm.DumpStatusLbl.Update;

  GlobClassesCount:=0;
  {BOZA DeDeClasses.}PEStream.Seek(PEHeader.Objects[1].PHYSICAL_OFFSET,soFromBeginning);
  ///////////////////////////////////////
  // Find and Dump Classes Self Pointers
  //      <> Delphi 2 (no self pointers)
  ///////////////////////////////////////
  If not GlobDelphi2 then
    Begin
      Repeat
        {BOZA DeDeClasses.}PEStream.ReadBuffer(dw,4);
        // If a self-pointer is found
        If dw-delta={BOZA DeDeClasses.}PEStream.Position Then
          Begin
            bkup:={BOZA DeDeClasses.}PEStream.Position;
            {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
            if b<$11 Then Inc(GlobClassesCount);
            {BOZA DeDeClasses.}PEStream.Seek(bkup,soFromBeginning);
          End;

        If {BOZA DeDeClasses.}PEStream.Position mod 200 =0 then
         begin
           DeDeMainForm.CustomPB.Position:=200+Trunc(100*({BOZA DeDeClasses.}PEStream.Position)/code_size);
           Application.ProcessMessages;
         end;
      Until ({BOZA DeDeClasses.}PEStream.Position>=code_size);


      DeDeMainForm.CustomPB.Position:=300;
      If GlobClassesCount=0 Then Exit;
      FiZeroCount:=0;
      {BOZA DeDeClasses.}PEStream.Seek(PEHeader.Objects[1].PHYSICAL_OFFSET,soFromBeginning);

      Repeat
        {BOZA DeDeClasses.}PEStream.ReadBuffer(dw,4);
        bkup:={BOZA DeDeClasses.}PEStream.Position;

        // If a self-pointer is found
        If dw-delta={BOZA DeDeClasses.}PEStream.Position Then
          Begin
            {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
            case b of
               $00     : ;// Nothing
               $07     : // Classes with specified UnitName
                         AddClass(bkup-4);

               else If (b<=$11) Then AddObjectEx(bkup-4,b);
            end;

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


          // Check for Classes directly inherited from TObject
          {BOZA DeDeClasses.}PEStream.ReadBuffer(dw1,4);
          dw2:=PEStream.Position-10*4;
          {BOZA DeDeClasses.}PEStream.Seek(dw2,soFromBeginning);
          {BOZA DeDeClasses.}PEStream.ReadBuffer(dw2,4);
          {BOZA DeDeClasses.}PEStream.Seek(bkup+4,soFromBeginning);

          if ((dw-dw1*4+12)=({BOZA DeDeClasses.}PEStream.Position+delta))
                 then if (IsInCodeSection(dw)) then AddObjectEx(dw,0)
                                               else
             else if
               (IsInCodeSection(dw))
               and (IsInCodeSection(dw2))
               and (dw-dw2>0)