dedeoffsinf.pas

dede 的源代码 3.10b

        OffsInfList.Add(OffsInf);
      end; {i:=0 to classes_count-1}

    if bLoadParentsData then
      For i:=0 to classes_count-1 Do
        begin
          OffsInf:=TOffsInfStruct(OffsInfList[i]);
          // Adding data from parents
          For j:=0 to OffsInf.FHierarchyList.Count-1 Do
            OffsInf.AddClassData(GetOffsInfoByClassName(OffsInf.FHierarchyList[j]));
        end;
  
  Finally
    TmpStream.Free;
  End;
end;

procedure TOffsInfArchive.FreeOffsInfData;
var i : Integer;
begin
  For i:=OffsInfList.Count-1 downto 0 Do
   TOffsInfStruct(OffsInfList[i]).Free;
end;


(*
   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
     d_ -> Dynamic Method (in this case offset is the Dynamic Method index)
*)
function TOffsInfArchive.GetOffsInfoByClassName(s: String): TOffsInfStruct;
var i : Integer;
begin
   Result:=nil;
   for i:=0 to OffsInfList.Count-1 Do
     if TOffsInfStruct(OffsInfList[i]).FsClassName=s
       then begin
         Result:=TOffsInfStruct(OffsInfList[i]);
         break;
       end;
end;

function TOffsInfArchive.GetReference(sClassName: String; dwOffset: DWORD;
  RefType: TRefOffsInfType; var sReference, sNewClass: String): Boolean;
var i, iPos : Integer;
    OffsInf : TOffsInfStruct;
    sn : String;

    function CheckPrefix(s : String; RefType : TRefOffsInfType) : Boolean;
    begin
      Case RefType Of
        rtMOV     : Result:=(Pos('p_',s)<>0) or (Pos('e_',s)<>0);
        rtCALL    : Result:=Pos('m_',s)<>0;
        rtDynCall : Result:=Pos('d_',s)<>0;
        else Result:=False;
      End;
    end;


    function MakeReference(sClass, sName : String; RefType : TRefOffsInfType) : String;
    var s : String;
    begin
      Case RefType Of
        rtMOV     : s:='property';
        rtCALL    : s:='method';
        rtDynCall : s:='dynamic method';
      end;

      Result:=sREF_TEXT_REF_TO+' '+s+' '+sClass+'.'+Trim(Copy(sName,3,Length(sName)-2));
      if (RefType<>rtMOV) and (Copy(Result,Length(Result),1)<>')') then Result:=Result+'()';
    end;

begin
   Result:=False;
   sReference:='';

   OffsInf:=Self.GetOffsInfoByClassName(sClassName);
   if OffsInf=nil then Exit;

   For i:=0 to OffsInf.FNameList.Count-1 Do
       if ((DWORD(OffsInf.FOffsetList[i]) and $00FFFFFF)=dwOffset)
          and CheckPrefix(OffsInf.FNameList[i],RefType) then
            begin
              sn:=OffsInf.FNameList[i];
              iPos:=Pos(':',sn);
              if iPos<>0
                 then begin
                   sNewClass:=Copy(sn,iPos+1,Length(sn)-iPos);
                   sn:=Copy(sn,1,iPos-1);
                   sn:=Trim(sn);
                 end
                 else sNewClass:='';

              sReference:=MakeReference(sClassName,sn,RefType);
              Result:=True;
              Exit;
            end;
end;

function TOffsInfArchive.GetReferenceEx(sClassName: String; dwOffset: DWORD;
  RefType: TRefOffsInfType; var sReference, sNewClass: String): Boolean;
var i, iPos : Integer;
    OffsInf : TOffsInfStruct;
    sn : String;

    function CheckPrefix(s : String; RefType : TRefOffsInfType) : Boolean;
    begin
      Case RefType Of
        rtMOV     : Result:=(Pos('p_',s)<>0) or (Pos('e_',s)<>0);
        rtCALL    : Result:=Pos('m_',s)<>0;
        rtDynCall : Result:=Pos('d_',s)<>0;
        else Result:=False;
      End;
    end;
begin
   Result:=False;
   sReference:='';

   OffsInf:=Self.GetOffsInfoByClassName(sClassName);
   if OffsInf=nil then Exit;

   For i:=0 to OffsInf.FNameList.Count-1 Do
       if ((DWORD(OffsInf.FOffsetList[i]) and $00FFFFFF)=dwOffset)
          and CheckPrefix(OffsInf.FNameList[i],RefType) then
            begin
              sn:=OffsInf.FNameList[i];
              iPos:=Pos(':',sn);
              if iPos<>0
                 then begin
                   sNewClass:=Copy(sn,iPos+1,Length(sn)-iPos);
                   sNewClass:=Trim(sNewClass);
                   sn:=Copy(sn,1,iPos-1);
                   sn:=Trim(sn);
                 end
                 else sNewClass:='';

              sReference:=Copy(sn,3,Length(sn)-2);
              Result:=True;
              Exit;
            end;
end;

class procedure TOffsInfArchive.LoadOffsInfsFromIniFile(AsFileName: String;
  List: TList);
var IniFile : TIniFile;
    Sects, Sect : TStringList;
    OffsInf : TOffsInfStruct;
    i, j : Integer;
    s : String;
    dw, dw1 : DWORD;
//    b : Byte;

    Procedure DecodeName(var s : String; var b : Byte);
    var pref : String;
    begin
      b:=$FF;
      pref:=copy(s,1,2);
      //0=property, 1=method, 2=event, 3=dynamic
      if pref='p_' then b:=0;
      if pref='m_' then b:=1;
      if pref='e_' then b:=2;
      if pref='d_' then b:=3;
      s:=Copy(s,3,Length(s)-2);
    end;

begin
  IniFile:=TIniFile.Create(AsFileName);
  Sect:=TStringList.Create;
  Sects:=TStringList.Create;
  Try
    // Read all sections
    IniFile.ReadSections(Sects);

    // Loops the sections
    For i:=0 to Sects.Count-1 Do
      begin
        // Read Section Data
        IniFile.ReadSection(Sects[i],Sect);
        OffsInf:=TOffsInfStruct.Create;
        OffsInf.FsClassName:=Sects[i];

        // Reads Inheritance Data
        dw:=IniFile.ReadInteger(Sects[i],'Inherits',0);
        for j:=1 to dw do
          begin
            s:=IniFile.ReadString(Sects[i],Sect[j],'');
            OffsInf.FHierarchyList.Add(s);
          end;

        // Read Properties
        For j:=dw+1 to Sect.Count-1 do
          begin
            s:=Sect[j];
            //DecodeName(s,b);
            if OffsInf.FNameList.IndexOf(s)=-1 then
              begin
                OffsInf.FNameList.Add(s);
                s:=IniFile.ReadString(Sects[i],s,'');
                dw1:={(b shl 24) or }HEX2DWORD(UpperCase(s));
                if Pos('-',s)<>0 then dw1:=not dw1;
                OffsInf.FOffsetList.Add(TObject(dw1));
              end;  
          end;

        List.Add(OffsInf);
      end;
  Finally
    IniFile.Free;
    Sect.Free;
    Sects.Free;
  End;
end;

procedure TOffsInfArchive.RemoveOffsInfo(sClassName: String);
var i : Integer;
begin
 for i:=0 to OffsInfList.Count-1 Do
   if TOffsInfStruct(OffsInfList[i]).FsClassName=sClassName
     then begin
       TOffsInfStruct(OffsInfList[i]).Free;
       OffsInfList.Delete(i);
       NamesList.Delete(i);
       Dec(classes_count);
       break;
     end;
end;

procedure TOffsInfArchive.Save(AsFileName: String);
var s : String;
    TmpStream : TMemoryStream;
    i,j : Integer;
    b : Byte;
    sz : Word;
    dw : DWORD;
    OffsInf : TOffsInfStruct;
    Zip : TVCLZip;
begin
  TmpStream:=TMemoryStream.Create;
  FStream.Clear;
  Try
    // Write Magic
    s:='DOI!';
    FStream.WriteBuffer(s[1],4);
    // Write Flags
    FStream.WriteBuffer(mode,1);
    FStream.WriteBuffer(reserved,1);
    // Write Classes Count
    FStream.WriteBuffer(classes_count,2);

    For i:=0 to classes_count-1 Do
      begin
        // ClassName - Pascal String
        OffsInf:=TOffsInfStruct(OffsInfList[i]);
        b:=Length(OffsInf.FsClassName);
        FStream.WriteBuffer(b,1);
        FStream.WriteBuffer(OffsInf.FsClassName[1],b);

        // WORD - RawDataSize
        sz:=OffsInf.FNameList.Count;
        FStream.WriteBuffer(sz,2);

        // Hierarchy Count
        sz:=OffsInf.FHierarchyList.Count;
        FStream.WriteBuffer(sz,2);

        // Inherit Classes
        For j:=0 to sz-1 Do
          begin
            s:=OffsInf.FHierarchyList[j];
            b:=Length(s);
            FStream.WriteBuffer(b,1);
            FStream.WriteBuffer(s[1],b);
          end;

        For j:=0 to OffsInf.FNameList.Count-1 Do
          begin
            b:=Length(OffsInf.FNameList[j]);
            FStream.WriteBuffer(b,1);
            FStream.WriteBuffer(OffsInf.FNameList[j][1],b);

            dw:=DWORD(OffsInf.FOffsetList[j]);
            b:=dw shr 24;
            FStream.WriteBuffer(b,1);
            dw:=(dw and $00FFFFFF);
            FStream.WriteBuffer(dw,4);
         end;
      end;

  Finally
    TmpStream.Free;
  End;

  Zip:=TVCLZip.Create(nil);
  Try
   Zip.ZipName:=AsFileName;
   Zip.ZipFromStream(FStream,AsFileName);
  Finally
   Zip.Free;
  End;
end;

end.