dedeclassemulator.pas

dede 的源代码 3.10b

unit DeDeClassEmulator;
//////////////////////////
// Last Change: 8.II.2001
//////////////////////////

interface

uses Classes, DeDeBSS, MainUnit, DeDeOffsInf;

Type DWORD = LongWord;

Var EAX, EBX, ECX, EDX, ESI, EDI, EBP : String;
Var dwEAX, dwEBX, dwECX, dwEDX, dwESI, dwEDI, dwEBP : DWORD;
var ESP, Loc_Names, Loc_StrVals : TStringList;
Var dwESP, Loc_Vars : TList;
Var OffsInfArchive : TOffsInfArchive;


Procedure InitNewEmulation(_eax, _ebx, _ecx, _edx : String);
Procedure InitNewEmulationEx(_eax, _ebx, _ecx, _edx, _ExpireCount : String);
procedure SetRegisters(_eax, _ebx, _ecx, _edx, _esi, _edi : String);
procedure SetEmulationSettings(_eax, _ebx, _ecx, _edx, _esi, _edi, _ttl : String);
Procedure EmulateInstruction(Instruction : String; size : Integer; sIns, sOp : String);
Procedure LoadOffsetInfos(FsFileName : String);

Type TRegister = (rgEAX, rgEBX, rgECX, rgEDX, rgESI, rgEDI, rgEBP, rgESP);

const registers_ : Array [TRegister] of String =
                 ('eax','ebx','ecx','edx','esi','edi','ebp','esp');

const REGISTERS__ : Array [TRegister] of String =
                 ('EAX','EBX','ECX','EDX','ESI','EDI','EBP','ESP');

function GetRegVal(reg : TRegister) : String;
function Str2TRegister(sReg : String) : TRegister;
procedure SetRegVal(reg : TRegister; sVal : String); overload;
procedure SetRegVal(reg : TRegister; sVal : dword); overload;
procedure ClearRegister(reg : TRegister);

Type GetPropertyFunction = function (sObjectClass : String) : String;

Var GetProperty : GetPropertyFunction;

    ClsDmp : TClassesDumper;

    bReference : Boolean;

    sReference : String;
    sNewClass  : String;

    DELTA_VMT : Byte;

var ExpireCount : Integer = 100;
var ExpireCounter : Array [TRegister] of Integer;

    bAddOffsRef : Boolean;
    regAddOffsRef : TRegister;
    sAddOffsRef : String;
    
function IsInSection(dwOffset : DWORD; sSectName : String) : Boolean;
procedure ClearStack;

implementation

uses DeDeClasses, HEXTools, DeDeDisAsm, DeDeConstants, DeDeREG, DeDeExpressions;

var bEBPStack : Boolean;

procedure AddGlobVar(sExpr : String; bPRT : Boolean = false);
begin
  if bPRT then AddNewExpression(0,'[$'+sExpr+']','')
          else AddNewExpression(0,'$'+sExpr,'');
end;

function Str2TRegister(sReg : String) : TRegister;
begin
  if sReg='eax' then Result:=rgEAX;
  if sReg='ebx' then Result:=rgEBX;
  if sReg='ecx' then Result:=rgECX;
  if sReg='edx' then Result:=rgEDX;
  if sReg='esi' then Result:=rgESI;
  if sReg='edi' then Result:=rgEDI;
  if sReg='ebp' then Result:=rgEBP;
  if sReg='esp' then Result:=rgESP;
end;

Procedure LoadOffsetInfos(FsFileName : String);
begin
  OffsInfArchive.Extract(FsFileName);
end;

procedure SetRegVal(reg : TRegister; sVal : String); overload;
begin
  case reg of
   rgEAX: EAX:=sVal;
   rgEBX: EBX:=sVal;
   rgECX: ECX:=sVal;
   rgEDX: EDX:=sVal;
   rgESI: ESI:=sVal;
   rgEDI: EDI:=sVal;
   rgEBP: EBP:=sVal;
  end;

 ExpireCounter[reg]:=ExpireCount;
end;

procedure ClearRegister(reg : TRegister);
begin
  case reg of
   rgEAX: EAX:='';
   rgEBX: EBX:='';
   rgECX: ECX:='';
   rgEDX: EDX:='';
   rgESI: ESI:='';
   rgEDI: EDI:='';
   rgEBP: EBP:='';
  end;
end;


function GetRegVal(reg : TRegister) : String;
begin
  case reg of
   rgEAX: Result:=EAX;
   rgEBX: Result:=EBX;
   rgECX: Result:=ECX;
   rgEDX: Result:=EDX;
   rgESI: Result:=ESI;
   rgEDI: Result:=EDI;
   rgEBP: Result:=EBP;
  end;
end;


procedure SetRegVal(reg : TRegister; sVal : DWORD); overload;
begin
  case reg of
   rgEAX: dwEAX:=sVal;
   rgEBX: dwEBX:=sVal;
   rgECX: dwECX:=sVal;
   rgEDX: dwEDX:=sVal;
   rgESI: dwESI:=sVal;
   rgEDI: dwEDI:=sVal;
   rgEBP: dwEBP:=sVal;
  end;
end;

function GetRegValDW(reg : TRegister) : DWORD;
begin
  case reg of
   rgEAX: Result:=dwEAX;
   rgEBX: Result:=dwEBX;
   rgECX: Result:=dwECX;
   rgEDX: Result:=dwEDX;
   rgESI: Result:=dwESI;
   rgEDI: Result:=dwEDI;
   rgEBP: Result:=dwEBP;
  end;
end;

function IsInSection(dwOffset : DWORD; sSectName : String) : Boolean;
var idx : Integer;
begin
  result:=false;
  idx:=PEHEader.GetSectionIndexEx(sSectName);
  if idx=-1 then exit;
  result:=     (dwOffset>=PEHeader.IMAGE_BASE+PEHeader.Objects[idx].RVA)
           and (dwOffset<=PEHeader.IMAGE_BASE+PEHeader.Objects[idx].RVA+PEHEader.Objects[idx].VIRTUAL_SIZE);
end;

function IsBSSOffset(dw : DWORD) : boolean;
begin
  Result:=IsInSection(dw,'BSS');
end;

function IsDATAOffset(dw : DWORD) : boolean;
begin
  Result:=IsInSection(dw,'DATA');
end;

function IsCODEOffset(dw : DWORD) : boolean;
begin
  Result:=IsInSection(dw,'CODE');
end;


procedure SetRegisters(_eax, _ebx, _ecx, _edx, _esi, _edi : String);
var boza : TClassDumper;
begin
  EAX:=_eax;
  EBX:=_ebx;
  ECX:=_ecx;
  EDX:=_edx;
  ESI:=_esi;
  EDI:=_edi;
  EBP:='';

  dwEAX:=0;
  dwEBX:=0;
  dwECX:=0;
  dwEDX:=0;
  dwESI:=0;
  dwEDI:=0;

  if _eax<>'' then
    begin
     boza:=ClsDmp.GetClass(_eax);
     if boza.FdwBSSOffset.Count>1
       then dwEAX:=DWORD(ClsDmp.GetClass(_eax).FdwBSSOffset[1]);
    end;
  if _ebx<>'' then
    if ClsDmp.GetClass(_ebx).FdwBSSOffset.Count>1 then  dwEBX:=DWORD(ClsDmp.GetClass(_ebx).FdwBSSOffset[1]);
  if _ecx<>'' then
    if ClsDmp.GetClass(_ecx).FdwBSSOffset.Count>1 then  dwECX:=DWORD(ClsDmp.GetClass(_ecx).FdwBSSOffset[1]);
  if _edx<>'' then
    if ClsDmp.GetClass(_edx).FdwBSSOffset.Count>1 then  dwEDX:=DWORD(ClsDmp.GetClass(_edx).FdwBSSOffset[1]);
  if _edi<>'' then
    if ClsDmp.GetClass(_edi).FdwBSSOffset.Count>1 then  dwECX:=DWORD(ClsDmp.GetClass(_edi).FdwBSSOffset[1]);
  if _esi<>'' then
    if ClsDmp.GetClass(_esi).FdwBSSOffset.Count>1 then  dwEDX:=DWORD(ClsDmp.GetClass(_esi).FdwBSSOffset[1]);

  dwEBP:=0;
end;

procedure SetEmulationSettings(_eax, _ebx, _ecx, _edx, _esi, _edi, _ttl : String);
begin
  if EAX='' then
    begin
       EAX:=_eax;
       dwEAX:=0;
       if _eax<>'' then
         if ClsDmp.GetClass(_eax).FdwBSSOffset.Count>1 then dwEAX:=DWORD(ClsDmp.GetClass(_eax).FdwBSSOffset[1]);
    end;

  if EBX='' then
    begin
       EBX:=_ebx;
       dwEBX:=0;
       if _ebx<>'' then
         if ClsDmp.GetClass(_ebx).FdwBSSOffset.Count>1 then dwEBX:=DWORD(ClsDmp.GetClass(_ebx).FdwBSSOffset[1]);
    end;

  if ECX='' then
    begin
       ECX:=_ecx;
       dwECX:=0;
       if _ecx<>'' then
         if ClsDmp.GetClass(_ecx).FdwBSSOffset.Count>1 then dwECX:=DWORD(ClsDmp.GetClass(_ecx).FdwBSSOffset[1]);
    end;

  if EDX='' then
    begin
       EDX:=_edx;
       dwEDX:=0;
       if _edx<>'' then
         if ClsDmp.GetClass(_edx).FdwBSSOffset.Count>1 then dwEDX:=DWORD(ClsDmp.GetClass(_edx).FdwBSSOffset[1]);
    end;

  if ESI='' then
    begin
       ESI:=_esi;
       dwESI:=0;
       if _esi<>'' then
         if ClsDmp.GetClass(_esi).FdwBSSOffset.Count>1 then dwESI:=DWORD(ClsDmp.GetClass(_esi).FdwBSSOffset[1]);
    end;

  if EDI='' then
    begin
       EDI:=_edi;
       dwEDI:=0;
       if _edi<>'' then
         if ClsDmp.GetClass(_edi).FdwBSSOffset.Count>1 then dwEDI:=DWORD(ClsDmp.GetClass(_edi).FdwBSSOffset[1]);
    end;


  EBP:='';
  dwEBP:=0;

  ExpireCount:=HEX2DWORD(_ttl);
end;


Procedure InitNewEmulation(_eax, _ebx, _ecx, _edx : String);
var RegIdx : TRegister;
begin
  ClsDmp:=DeDeMainForm.ClassesDumper;
  SetRegisters(_eax, _ebx, _ecx, _edx, '', '');

  ClearStack;

  bEBPStack:=False;

  DELTA_VMT:=76;
  If DelphiVersion='D3' Then DELTA_VMT:=64;
  If DelphiVersion='D2' Then DELTA_VMT:=44;

  For RegIdx:=rgEAX to rgESP do ExpireCounter[RegIdx]:=$100;
  
  bAddOffsRef:=False;
end;

procedure ClearStack;
begin
  ESP.Clear;
  dwESP.Clear;
  Loc_Names.Clear;
  Loc_Vars.Clear;
  Loc_StrVals.Clear;
end;

Procedure InitNewEmulationEx(_eax, _ebx, _ecx, _edx, _ExpireCount : String);
begin
  ClsDmp:=DeDeMainForm.ClassesDumper;
  SetRegisters(_eax, _ebx, _ecx, _edx, '', '');

  ClearStack;

  bEBPStack:=False;

  ExpireCount:=HEX2DWORD(_ExpireCount);

  DELTA_VMT:=76;
  If DelphiVersion='D3' Then DELTA_VMT:=64;
  If DelphiVersion='D2' Then DELTA_VMT:=44;

  bAddOffsRef:=False;
end;


procedure movRegister_Register(reg1,reg2 : TRegister);
begin
  if reg1=reg2 then exit;
  SetRegVal(reg1,GetRegVal(reg2));
  SetRegVal(reg1,GetRegValDW(reg2));
end;

procedure xchgRegister_Register(reg1,reg2 : TRegister);
var sVal : String;
    dwVal : DWORD;
begin
  if reg1=reg2 then exit;
  sVal:=GetRegVal(reg2);
  dwVal:=GetRegValDW(reg2);
  SetRegVal(reg2,GetRegVal(reg1));
  SetRegVal(reg2,GetRegValDW(reg1));
  SetRegVal(reg1,sVal);
  SetRegVal(reg1,dwVal);
end;


procedure movRegister_ptrRegister(reg1,reg2 : TRegister);
var dw : DWORD;
    i,j : Integer;
begin
  // mov reg1, [reg2]
  SetRegVal(reg1,GetRegVal(reg2));

  // No support for now !
  exit;


  dw:=GetRegValDW(reg2);
  if dw<>0 then
    begin
      if IsDATAOffset(dw) then
         begin
           for i:=0 to ClsDmp.Classes.Count-1 do
            for j:=0 to TClassDumper(ClsDmp.Classes[i]).FdwDATAPrt.Count-1 do
             if DWORD(TClassDumper(ClsDmp.Classes[i]).FdwDATAPrt[j])=dw
              then begin
                SetRegVal(reg1,TClassDumper(ClsDmp.Classes[i]).FsClassName);
                SetRegVal(reg1,DWORD(TClassDumper(ClsDmp.Classes[i]).FdwBSSOffset[j]));
                bReference:=True;
                sReference:=sREF_TEXT_POSSIBLE_TO+' '+GetRegVal(reg1);
                break;
              end;
         end;

      if IsBSSOffset(dw) then
         begin
           for i:=0 to ClsDmp.Classes.Count-1 do
            for j:=0 to TClassDumper(ClsDmp.Classes[i]).FdwBSSOffset.Count-1 do
             if DWORD(TClassDumper(ClsDmp.Classes[i]).FdwBSSOffset[j])=dw
             then begin
               SetRegVal(reg1,Copy(TClassDumper(ClsDmp.Classes[i]).FsClassName,2,Length(TClassDumper(ClsDmp.Classes[i]).FsClassName)-1));
               SetRegVal(reg1,DWORD(TClassDumper(ClsDmp.Classes[i]).FdwHeapPtr[j]));
               bReference:=True;