unit dcDFMs;

interface

uses
  Classes, PEFile, MethodLists, Procs;

type
  { TdcDFM }

  TdcDFM = class(TCollectionItem)
  private
    FFormClass: TClassInfo;
    FResTypeIndex: Integer;
    FResIndex: Integer;
    procedure ClassesLoad(Sender: TmlneMethodList);
    procedure AssignUnits(Sender: TmlneMethodList);
    procedure PublishedMethodsLoad(Sender: TmlneMethodList);
  public
    constructor CreateDFM(ResTypeIndex, ResIndex: Integer; Collection: TCollection);
    destructor Destroy; override;
    procedure SaveToFile(const FileName: string);
    property FormClass: TClassInfo read FFormClass;
    property ResTypeIndex: Integer read FResTypeIndex;
    property ResIndex: Integer read FResIndex;
  end;

  { TdcDFMs }

  TdcDFMs = class(TCollection)
  private
    FPEFile: TPEFile;
    procedure LoadDFMs;
  public
    constructor CreateDFMs(PEFile: TPEFile);
  end;

implementation

uses
  Windows, SysUtils, PEFileClass, dcUnits, TypInfo, TypeInfoUtils, dcDecomps, peExports;
  
{ TdcDFM }

constructor TdcDFM.CreateDFM(ResTypeIndex, ResIndex: Integer; Collection: TCollection);
begin
  inherited Create(Collection);
  FResTypeIndex := ResTypeIndex;
  FResIndex := ResIndex;
  with TPEFileClass(TdcDFMs(Collection).FPEFile) do
  begin
    Classes.OnLoadClasses.Add(ClassesLoad);
    Units.OnAssignUnits.Add(AssignUnits);
    Procs.OnLoadPublishedMethods.Add(PublishedMethodsLoad);
  end;  
end;

destructor TdcDFM.Destroy;
begin
  with TPEFileClass(TdcDFMs(Collection).FPEFile).Classes do
    if OnLoadClasses <> nil then
      OnLoadClasses.Remove(ClassesLoad);
  with TPEFileClass(TdcDFMs(Collection).FPEFile).Units do
    if OnAssignUnits <> nil then
      OnAssignUnits.Remove(Self.AssignUnits);
  inherited Destroy;
end;

procedure TdcDFM.ClassesLoad(Sender: TmlneMethodList);
var
  I: Integer;
begin
  // Load the units
  // Find the form class by compairing the name.
  with TPEFileClass(TdcDFMs(Collection).FPEFile) do
  begin
    for I := 0 to Classes.Count -1 do
      if AnsiCompareText(Classes[I].AClass.ClassName,
             Resources[FResTypeIndex].Entries[FResIndex].Name) = 0 then
        FFormClass := Classes[I];
  end;
  if FormClass <> nil then
    // The form must be in the interface section
    FFormClass.IntfImpl := iiInterface;
  // Call the next event handler.
  Sender.CallNext(ClassesLoad);
end;

procedure TdcDFM.AssignUnits(Sender: TmlneMethodList);
begin
  if FormClass <> nil then
    TUnit(FFormClass.AUnit).DFM := Self;
  // Call the next event handler.
  Sender.CallNext(AssignUnits);
end;

procedure TdcDFM.SaveToFile(const FileName: string);
var
  FileStream: TFileStream;
const
  Header1: PChar = #$FF#$0A#$00;
  Header2: PChar = #$00#$30#$10;
begin
  FileStream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
  try
    with TPEFileClass(TdcDFMs(Collection).FPEFile).Resources[FResTypeIndex].Entries[FResIndex] do
    begin
      FileStream.Write(Header1^, 3);
      FileStream.Write(PChar(string(Name))^, Length(Name));
      FileStream.Write(Header2^, 3);
      FileStream.Write(LongInt(Entries[0].DataSize), SizeOf(LongInt));
      FileStream.Write(Entries[0].Data^, Entries[0].DataSize);
    end;
  finally
    FileStream.Free;
  end;
end;

procedure TdcDFM.PublishedMethodsLoad(Sender: TmlneMethodList);

  procedure AnaObjectBinary(Input: TStream);
  var
    SaveSeparator: Char;
    Reader: TReader;

    procedure ConvertObject;
    var
      AClassInfo: TClassInfo;

      procedure ConvertValue; forward;

      procedure ConvertHeader;
      var
        AClassName, ObjectName: string;
        Flags: TFilerFlags;
        Position: Integer;
        I: Integer;
      resourcestring
        SErrorClassNotFound = 'Class %s mentioned in DFM, not found.';
        SErrorClassHasNoTypeInfo = 'Error, class %s mentioned in DFM so must have TypeInfo';
      begin
        Reader.ReadPrefix(Flags, Position);
        AClassName := Reader.ReadStr;
        ObjectName := Reader.ReadStr;
        // Get the class.
        AClassInfo := TPEFileClass(TdcDFMs(Collection).FPEFile).Classes.FindClassByName(AClassName);
        if AClassInfo = nil then
          with TPEFileClass(TdcDFMs(Collection).FPEFile).DecompThread do
            for I := 0 to PEFileClassCount -1 do
            begin
              AClassInfo := TPEFileClass(PEFileClasses[I]).Classes.FindClassByName(AClassName);
              if AClassInfo <> nil then Break;
            end;

        if AClassInfo = nil then
          raise EDecompilerError.CreateFmt(SErrorClassNotFound, [AClassName]);
        if AClassInfo.AClass.ClassInfo = nil then
          raise EDecompilerError.CreateFmt(SErrorClassHasNoTypeInfo, [AClassName]);
      end;

      procedure ConvertBinary;
      const
        BytesPerLine = 32;
      var
        I: Integer;
        Count: Longint;
        Buffer: array[0..BytesPerLine - 1] of Char;
      begin
        Reader.ReadValue;
        Reader.Read(Count, SizeOf(Count));
        while Count > 0 do
        begin
          if Count >= 32 then I := 32 else I := Count;
          Reader.Read(Buffer, I);
          Dec(Count, I);
        end;
      end;

      procedure ConvertProperty; forward;

      procedure ConvertValue;
      const
        LineLength = 64;
      var
        S: string;
      begin
        case Reader.NextValue of
          vaList:
            begin
              Reader.ReadValue;
              while not Reader.EndOfList do
              begin
                ConvertValue;
              end;
              Reader.ReadListEnd;
            end;
          vaInt8, vaInt16, vaInt32:
            Reader.ReadInteger;
          vaExtended:
            Reader.ReadFloat;
          vaSingle:
            Reader.ReadSingle;
          vaCurrency:
            Reader.ReadCurrency;
          vaDate:
            Reader.ReadDate;
          vaWString:
            Reader.ReadWideString;
          vaString, vaLString:
            Reader.ReadString;
          vaIdent, vaFalse, vaTrue, vaNil, vaNull:
            Reader.ReadIdent;
          vaBinary:
            ConvertBinary;
          vaSet:
            begin
              Reader.ReadValue;
              while True do
              begin
                S := Reader.ReadStr;
                if S = '' then Break;
              end;
            end;
          vaCollection:
            begin
              Reader.ReadValue;
              while not Reader.EndOfList do
              begin
                if Reader.NextValue in [vaInt8, vaInt16, vaInt32] then
                  ConvertValue;
                if Reader.ReadValue <> vaList then
                  raise EDecompilerError.Create('Error reading the DFM property');
                while not Reader.EndOfList do ConvertProperty;
                Reader.ReadListEnd;
              end;
              Reader.ReadListEnd;
            end;
{$IFDEF VER130}
          vaInt64:
            Reader.ReadInt64;
{$ENDIF VER130}
        end;
      end;

      procedure ConvertProperty;
      var
        PropName: string;
        PropInfo: PPropInfo;
        S: string;
        Proc: TProc;
      const
        MethodPossProcTypes: array[TMethodKind] of TProcTypes =
             ([ptMethodProcedure], [ptMethodProcedure], [ptConstructor], [ptDestructor],
              [ptClassProcedure], [ptClassProcedure], [], []);
      begin
        PropName := Reader.ReadStr;
        if Pos('.', PropName) = 0 then
        begin
          PropInfo := GetPropInfo(AClassInfo.AClass.ClassInfo, PropName);
          if (PropInfo <> nil) and (PropInfo.PropType^.Kind = tkMethod) then
          begin
            // It's a method property, so read the procname and assign the
            // proptype to the proc.
            if (Reader.NextValue <> vaIdent) then
              raise EDecompilerError.Create('Next value should be a string');
            S := Reader.ReadIdent;
            Proc := FormClass.FindProc(S);
            if Proc = nil then
              raise EDecompilerError.CreateFmt('Proc referenced in DFM not found %s', [S]);
            Proc.PossProcTypes :=
                MethodPossProcTypes[GetTypeData(PropInfo.PropType^).MethodKind];
            Proc.Parameters.Parameters := GetMethodTypeParameters(PropInfo.PropType^);
            Proc.Parameters.FuncResult := GetMethodTypeResult(PropInfo.PropType^);
            Exit;
          end;
        end;
        ConvertValue;
      end;

    begin
      ConvertHeader;
      while not Reader.EndOfList do
        ConvertProperty;
      Reader.ReadListEnd;
      while not Reader.EndOfList do ConvertObject;
      Reader.ReadListEnd;
    end;

  begin
    Reader := TReader.Create(Input, 4096);
    SaveSeparator := DecimalSeparator;
    DecimalSeparator := '.';
    try
      Reader.ReadSignature;
      ConvertObject;
    finally
      DecimalSeparator := SaveSeparator;
      Reader.Free;
    end;
  end;

var
  Stream: TMemoryStream;
begin
  if FormClass = nil then
    Exit;
  // Analyze the DFM for methods.
  Stream := TMemoryStream.Create;
  try
    with TdcDFMs(Collection).FPEFile.Resources[FResTypeIndex].Entries[FResIndex].Entries[0] do
      Stream.WriteBuffer(Data^, DataSize);
    Stream.Position := 0;
    AnaObjectBinary(Stream);
  finally
    Stream.Free;
  end;
  // Call the next event handler
  Sender.CallNext(PublishedMethodsLoad);
end;

{ TdcDFMs }

constructor TdcDFMs.CreateDFMs(PEFile: TPEFile);
begin
  inherited Create(TdcDFM);
  FPEFile := PEFile;
  LoadDFMs;
end;

procedure TdcDFMs.LoadDFMs;
var
  I, J: Integer;
const
  FilerSignature: array[1..4] of Char = 'TPF0';
begin        
  // Search for RCDATA resources starting with TPF0 (they are dfms).
  with FPEFile do
    for I := 0 to High(Resources) do
      if (Resources[I].NameOrID = niID) and
         (Resources[I].ID = Integer(RT_RCDATA)) then
        for J := 0 to High(Resources[I].Entries) do
        begin
          if (Length(Resources[I].Entries[J].Entries) >= 1) and
             (Resources[I].Entries[J].Entries[0].DataSize > 4) and
             (PInteger(Resources[I].Entries[J].Entries[0].Data)^ = Integer(FilerSignature)) then
            TdcDFM.CreateDFM(I, J, Self);
        end;
end;

end.