bplunit.pas

dede 的源代码 3.10b

unit BPLUnit;
//////////////////////////
// Last Change: 28.VIII.2001
//////////////////////////

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Mask, ToolEdit, ComCtrls, ExtCtrls, ImgList, Spin, Buttons,
  DeDeConstants;

type
  TBPL = class(TForm)
    StatusBar: TStatusBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label2: TLabel;
    FileEdit: TFilenameEdit;
    Button1: TButton;
    Panel1: TPanel;
    Label5: TLabel;
    Label4: TLabel;
    statusLbl: TLabel;
    DVGB: TGroupBox;
    d3cb: TCheckBox;
    d4cb: TCheckBox;
    d5cb: TCheckBox;
    GroupBox1: TGroupBox;
    FixCB: TCheckBox;
    ParamCB: TCheckBox;
    IncPCB: TCheckBox;
    LogMemo: TMemo;
    PB: TProgressBar;
    CommentEdit: TEdit;
    SymFile: TFilenameEdit;
    Panel2: TPanel;
    Label1: TLabel;
    DCUFileEdit: TFilenameEdit;
    Button2: TButton;
    Panel3: TPanel;
    Label3: TLabel;
    Label6: TLabel;
    DCUstatuLbl: TLabel;
    DCUDVGB: TGroupBox;
    dcud3cb: TCheckBox;
    dcud4cb: TCheckBox;
    dcud5cb: TCheckBox;
    DCULogMemo: TMemo;
    DCUPB: TProgressBar;
    DCUCommentEdit: TEdit;
    DCUSymFile: TFilenameEdit;
    GroupBox2: TGroupBox;
    DCUParamCB: TCheckBox;
    DCUExcludeCB: TCheckBox;
    dcud2cb: TCheckBox;
    DetailsPanel: TPanel;
    CDCUPB: TProgressBar;
    Label7: TLabel;
    CurrDCULbl: TLabel;
    d6cb: TCheckBox;
    dcud6cb: TCheckBox;
    procedure SymFileBeforeDialog(Sender: TObject; var Name: String;
      var Action: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FileEditBeforeDialog(Sender: TObject; var Name: String;
      var Action: Boolean);
    procedure FileEditChange(Sender: TObject);
    procedure Panel2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DCUFileEditChange(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    ClassesList : TStringList;
    Procedure CutUnitName(Var AsData : String; isD3 : Boolean);
    function GetSymMode : Byte;
    function DCUGetSymMode : Byte;
    procedure ParseFunctionName(var s : String);
    procedure AddNewDCU_DSF(sProcDecl : String; buffer : TSymBuffer; size : Integer;  Progress : Byte; bAddIT : Boolean);
  public
    { Public declarations }
  end;

var
  BPL: TBPL;

implementation

{$R *.DFM}
Uses DeDeClasses, DisASM, HEXTools, DeDeBPL, DeDeDCUDumper,
     DeDePFiles, DeDeRES, DeDeSym, MainUnit;

// Used with DCU DSF file generation because of parsing OnNewProcEvent()     
var DataB, DataS : TMemoryStream;
    GlobiRecNum, iFakeCount, GlobiFakeCount : Integer;

procedure TBPL.SymFileBeforeDialog(Sender: TObject; var Name: String;
  var Action: Boolean);
begin
   SymFile.InitialDir:=ExtractFileDir(Application.ExeName)+'\DSF';
end;

procedure TBPL.Button1Click(Sender: TObject);
Var MemData, DataB, DataS : TMemoryStream;
    ExportList, SymbolList : TStringList;
    RVAList : TList;
    HM : HModule;
    PEFile : ThePeFile;
    //PEHeader : TPEHeader;
    PEExports : TPEExports;
    i,j,iRecNum,iCount : Integer;
    s,sym : String;
    p : Pointer;
    sz : Cardinal;
    buff : TSymBuffer;
    DASM : TDisAsm;
    bIsDCL : Boolean;
begin
 If DeDeMainForm.FbProcessed then
   If MessageDlg('This operation will affect the currently processed target! Do you want ot continue?',mtWarning,[mbYes,mbNo],0)=mrNo then Exit;

 If SymFile.FileName='' Then
    Begin
      ShowMessage(err_select_dsf_name);
      Exit;
    End;

 If FileExists(SymFile.FileName) Then
   Begin
    If MessageDlg(Format(wrn_fileexists,[SymFile.FileName]),mtWarning,[mbYes,mbNo],0)=mrNo Then Exit;
    DeleteFile(SymFile.FileName);
   End;
     
 LogMemo.Clear;
 ClassesList.Clear;
 ClassesList.Add('Dumped Classes:');
 ClassesList.Add('');
 ExportList:=TStringList.Create;
 SymbolList:=TStringList.Create;
 DASM:=TDisAsm.Create;
 LogMemo.Lines.Add(msg_load_exp_names);

 Screen.Cursor:=crHourGlass;
 MemData:=TMemoryStream.Create;
 DataB:=TMemoryStream.Create;
 DataS:=TMemoryStream.Create;
 RVAList:=TList.Create;
 PEFile:=ThePeFile.Create(FileEdit.FileName);
 Try
   DeDeClasses.PEFile:=PEFile;
   //PEHeader is used for PE files only
   PEHeader.Dump(PEFile);

   DeDeSym.BPLPEHeader:=PEHeader;
   i:=PEHeader.GetSectionIndex('.edata');
   if i=-1 Then Raise Exception.Create(err_no_exports);
   PEExports.Process(PEHeader.Objects[i].PHYSICAL_OFFSET,PEHeader.Objects[i].RVA);
   For i:=0 To PEExports.Number_of_Name_Pointers Do
     Begin
       s:=PEExports.FUNC_DATA[i].Name;
       ExportList.Add(s);
     End;
   LogMemo.Lines[0]:=LogMemo.Lines[0]+msg_done1;

   LogMemo.Lines.Add(msg_load_package);
   HM:=LoadPackage(FileEdit.FileName);
   LogMemo.Lines[1]:=LogMemo.Lines[1]+msg_done1;
   LogMemo.Lines.Add(msg_load_exp_sym);
   PB.Max:=2*(ExportList.Count-1);
   PB.Position:=0;

   // For Delphi3 DCL Procedure Name Correction Compability
   bIsDCL:=UpperCase(Copy(FileEdit.FileName,Length(FileEdit.FileName)-2,3))='DPL';

   Try
     For i:=0 To ExportList.Count-1 Do
      Begin
       s:=ExportList[i];
       If Copy(s,1,5)='@$xp$' Then Continue;
       If s='' Then Continue;
       //StatusLbl.Caption:=s;
       //StatusLbl.Update;
       PB.Position:=i;
       PB.Update;
       p:=GetProcAddress(HM,PChar(s));
       If Not ReadProcessMemory(GetCurrentProcess,p,@buff[1],_PatternSize,sz)
          Then LogMemo.Lines.Add('!error! reading '+s+' address')
          Else Begin
            CutUnitName(s, bIsDCL);
            If s='' Then Continue;
            SymbolList.Add(s);
            RVAList.Add(p);

            sym:='';
            For j:=0 to _PatternSize do sym:=sym+IntToHex(buff[j],2);

            MemData.WriteBuffer(buff,_PatternSize);
          End;
      End;
   Finally
     LogMemo.Lines[2]:=LogMemo.Lines[2]+msg_done1;
     LogMemo.Lines.Add(msg_unload_package);
     UnloadPackage(HM);
     LogMemo.Lines[3]:=LogMemo.Lines[3]+msg_done1;
   End;

   LogMemo.Lines.Add(format(msg_dasm_exp,[IntToStr(SymbolList.Count)]));
   MemData.Seek(0,soFromBeginning);

   iRecNum:=0;
   iCount:=SymbolList.Count-1;

   Glob_B5:=0;Glob_B6:=0;Glob_B7:=0;Glob_B10:=0;
   // Tova beshe bozata !!!
   i:=-1;
   Repeat
     Inc(i);
     StatusLbl.Caption:=SymbolList[i];
     StatusLbl.Update;
     PB.Position:=PB.Position+1;
     PB.Update;

     MemData.ReadBuffer(buff,_PatternSize);
     If UnlinkCalls(buff,0,DWORD(RVAList[i])) Then
       Begin
       // Saves Symbols
        DataB.WriteBuffer(buff,_PatternSize);
        sym:=SymbolList[i];
        If( not bisDCL) and (FixCB.Checked) Then ParseFunctionName(sym);
        j:=Length(sym);
        DataS.WriteBuffer(j,1);
        DataS.WriteBuffer(sym[1],j);
        inc(iRecNum);
        // End of save symbols
       End;
   Until i>=iCount;

   PB.Position:=2*ExportList.Count;
   PB.Update;
   StatusLbl.Caption:='';
   StatusLbl.Update;
   LogMemo.Lines[4]:=LogMemo.Lines[4]+msg_done1;
   LogMemo.Update;


   LogMemo.Lines.Add(msg_saveing_file);
   if iRecNum<>0
       then SaveBPLSymbolFile(DataB,DataS,SymFile.FileName,GetSymMode,_PatternSize,iRecNum,CommentEdit.Text)
       else ShowMessage('No DSF patterns to save!');
   //SaveBPLSymbolFile(DataB,DataS,SymFile.FileName,GetSymMode,_PatternSize,iRecNum,CommentEdit.Text);
   LogMemo.Lines[5]:=LogMemo.Lines[5]+msg_done1;
   LogMemo.Update;
   j:=DataB.Size+DataS.Size;
   ShowMessage(msg_dsf_success);
   LogMemo.Clear;
 Finally
   ExportList.Free;
   SymbolList.Free;
   RVAList.Free;
   PEFile.Free;
   DASM.Free;
   Screen.Cursor:=crDefault;
   DataB.Free;
   DataS.Free;
   MemData.Free;
   PB.Position:=0;
   StatusLbl.Caption:='';
 End;

end;

procedure TBPL.CutUnitName(Var AsData: String; isD3 : Boolean);
//var i : Integer;
begin
  If (not isD3) and (Pos('$',AsData)=0) Then AsData:='';
  If AsData='' Then Exit;
  If AsData[1]='@' Then AsData:=Copy(AsData,2,Length(AsData)-1);