dedeoffsinf.pas

dede 的源代码 3.10b

unit DeDeOffsInf;

interface

(*
 DOI!    - Magic
 BYTE    - Flag (bit-mask 0 = Delphi3, 1=Delphi4, 2=Delphi5, 3,4,5,6,7 - Reserved)
 BYTE    - DOI version
 WORD    - Classes Count
 CLASS DATA

   Class Data format:

   ClassName  - Pascal String
   WORD       - Properties Count
   WORD       - Hierarchy inheritance classes num
   Class1Name - Pascal String
   Class2Name - Pascal String
   ....
   ClassNName - Pascal Stirng
   ROW DATA

      Row Data format:

      Name  - Pascal String
      BYTE  - Type (0=property, 1=method, 2=event, 3=dynamic index)
      DWORD - Offset

*)


(*
   INI File Data Format

   [ClassName]
   Inherits=word (number of classes the current class inherits from)
   class_1=ClassName_1
   class_2=ClassName_2
   .....
   class_n=ClassName_n

   PropertyName=Offset

   Property Names prefix:

     m_ -> Method
     p_ -> Property
     e_ -> Event
     d_ -> Dynamic Method (in this case offset is the Dynamic Method index)

   Property class types:

   if in property name there is ':' then all after that is the class name
   for example:

   p_Items:TStringList
*)

uses Classes, iniFiles;

Type DWORD = LongWord;

Type TOffsInfStruct = class (TPersistent)
      protected
      public
        FsClassName : String;
        FHierarchyList : TStringList;
        FNameList : TStringList;
        FOffsetList : TList;
        constructor Create;
        destructor Destroy; override;
        Procedure AddClassData(Source : TOffsInfStruct);
        Procedure CollectGrabbage;
        Procedure Assign(Source : TOffsInfStruct);
     end;


Type TRefOffsInfType = (rtMOV, rtCALL, rtDynCall);

Type TOffsInfArchive = class
      protected
        FStream : TMemoryStream;
        procedure FreeOffsInfData;
      public
        mode, reserved : Byte;
        classes_count : word;
        OffsInfList : TList;
        NamesList : TStringList;
        Constructor Create;
        Destructor Destroy; override;
        Procedure ClearAllData;
        Procedure Extract(AsFileName : String; bLoadParentsData : Boolean = True);
        Procedure Save(AsFileName : String);
        Procedure AddOffsInfo(AOfssInfStruct : TOffsInfStruct);
        Procedure RemoveOffsInfo(sClassName :  String);
        Function GetOffsInfoByClassName(s : String) : TOffsInfStruct;
        Function GetReference(sClassName : String; dwOffset : DWORD; RefType : TRefOffsInfType; var sReference, sNewClass : String) : Boolean;
        Function GetReferenceEx(sClassName : String; dwOffset : DWORD; RefType : TRefOffsInfType; var sReference, sNewClass : String) : Boolean;
        Function DeleteRecord(sClassName, sName : String) : boolean;
        class Procedure LoadOffsInfsFromIniFile(AsFileName : String; List : TList);
     end;

Function GetType(dw : DWORD) : Byte;

implementation

uses VCLUnZip, VCLZip, SysUtils, Dialogs, HEXTools, DeDeConstants;

Function GetType(dw : DWORD) : Byte;
begin
  Result:=dw shr 24;
end;


{ TOffsInfStruct }

procedure TOffsInfStruct.AddClassData(Source: TOffsInfStruct);
var i : Integer;
begin
  if Source=nil then Exit;
  for i:=0 to Source.FNameList.Count-1 Do
    begin
      if FNameList.IndexOf(Source.FNameList[i])=-1
        then begin
          FNameList.Add(Source.FNameList[i]);
          FOffsetList.Add(Source.FOffsetList[i]);
        end;
    end;
end;

procedure TOffsInfStruct.Assign(Source: TOffsInfStruct);
var i : Integer;
begin
  FsClassName:=Source.FsClassName;
  FHierarchyList.Assign(Source.FHierarchyList);
  FNameList.Assign(Source.FNameList);
  For i:=0 To Source.FOffsetList.Count-1
    Do FOffsetList.Add(Source.FOffsetList[i]);

end;

procedure TOffsInfStruct.CollectGrabbage;
var i : Integer;
begin
   For i:=FNameList.Count-1 downto 0 Do
     begin
       
     end;
end;

constructor TOffsInfStruct.Create;
begin
  inherited Create;

  FNameList:=TStringList.Create;
  FHierarchyList:=TStringList.Create;
  FOffsetList:=TList.Create;
end;

destructor TOffsInfStruct.Destroy;
begin
  FNameList.Free;
  FOffsetList.Free;
  FHierarchyList.Free;

  inherited Destroy;
end;

{ TOffsInfArchive }

procedure TOffsInfArchive.AddOffsInfo(AOfssInfStruct: TOffsInfStruct);
var idx, j : Integer;
    OffsInf : TOffsInfStruct;
begin
  idx:=NamesList.IndexOf(AOfssInfStruct.FsClassName);
  If idx=-1 then
    begin
     OffsInfList.Add(AOfssInfStruct);
     NamesList.Add(AOfssInfStruct.FsClassName);
     Inc(classes_count);
    end
    else begin
      OffsInf:=TOffsInfStruct(OffsInfList[idx]);
      For j:=0 to AOfssInfStruct.FNameList.Count-1 Do
        //Add if the name do not exists then add it
        if OffsInf.FNameList.IndexOf(AOfssInfStruct.FNameList[j])=-1
          then begin
            OffsInf.FNameList.Add(AOfssInfStruct.FNameList[j]);
            OffsInf.FOffsetList.Add(AOfssInfStruct.FOffsetList[j]);
          end;
    end;
end;

procedure TOffsInfArchive.ClearAllData;
begin
  FStream.Free;
  FreeOffsInfData;
  OffsInfList.Free;
  NamesList.Free;
end;

constructor TOffsInfArchive.Create;
begin
  inherited Create;

  FStream:=TMemoryStream.Create;
  OffsInfList:=TList.Create;
  NamesList:=TStringList.Create;
end;

function TOffsInfArchive.DeleteRecord(sClassName, sName: String): boolean;
var i : Integer;
    OffsInf : TOffsInfStruct;
begin
   Result:=False;
   OffsInf:=GetOffsInfoByClassName(sClassName);
   If OffsInf=nil then exit;
   i:=OffsInf.FNameList.IndexOf(sName);
   If i=-1 then exit;
   OffsInf.FNameList.Delete(i);
   OffsInf.FOffsetList.Delete(i);
   Result:=True;
end;

destructor TOffsInfArchive.Destroy;
begin
  ClearAllData;

  inherited Destroy;
end;

procedure TOffsInfArchive.Extract(AsFileName: String; bLoadParentsData : Boolean = True);
var s : String;
    TmpStream : TMemoryStream;
    i,j : Integer;
    b : Byte;
    sz,w : Word;
    dw : DWORD;
    OffsInf : TOffsInfStruct;
    UnZip : TVCLUnZip;
begin
  UnZip:=TVCLUnZip.Create(nil);
  Try
   UnZip.ZipName:=AsFileName;
   FStream.Clear;
   UnZip.UnZipToStream(FStream,ExtractFileName(AsFileName));
   FStream.Seek(0,soFromBeginning);
  Finally
   UnZip.Free;
  End;

//  ClearAllData;

  TmpStream:=TMemoryStream.Create;
  Try
    // Read Magic
    SetLength(s,4);
    FStream.ReadBuffer(s[1],4);
    If s<>'DOI!' Then Exit;
    // Read Flags
    FStream.ReadBuffer(mode,1);
    // Read Version
    FStream.ReadBuffer(reserved,1);
    // Read Classes Count
    FStream.ReadBuffer(classes_count,2);

    OffsInfList.Clear;
    NamesList.Clear;

    For i:=0 to classes_count-1 Do
      begin
        // ClassName - Pascal String
        FStream.ReadBuffer(b,1);

        OffsInf:=TOffsInfStruct.Create;

        SetLength(OffsInf.FsClassName,b);
        FStream.ReadBuffer(OffsInf.FsClassName[1],b);

        If NamesList.IndexOf(OffsInf.FsClassName)<>-1 then
           begin
             MessageDlg(Format('Class named %s already exist and will not be added!',[OffsInf.FsClassName]),mtError,[mbOk],0);
             OffsInf.Free;
             Continue;
           end;

        NamesList.Add(OffsInf.FsClassName);

        // WORD - Properties Count
        FStream.ReadBuffer(sz,2);

        // Hierarchy names count
        FStream.ReadBuffer(w,2);

        // Read Hierarchy
        For j:=1 to w Do
          begin
            FStream.ReadBuffer(b,1);
            SetLength(s,b);
            FStream.ReadBuffer(s[1],b);
            OffsInf.FHierarchyList.Add(s);
          end;


        // Read Properties
        For j:=1 to sz Do
          begin
            FStream.ReadBuffer(b,1);
            SetLength(s,b);
            FStream.ReadBuffer(s[1],b);
            OffsInf.FNameList.Add(s);
            FStream.ReadBuffer(b,1);
            FStream.ReadBuffer(dw,4);
            OffsInf.FOffsetList.Add(TObject((b shl 24) or dw));
          end;