unitpefile.pas

灰鸽子VIP1.2经典源代码

        Inc (nameOffset, sizeof (TResourceDataEntry));
        Inc (deSize, sizeof (TResourceDataEntry));
        dataSize := (dataSize + DWORD (node.nodes [i].data.Size) + 3) div 4 * 4;
      end
    end
  end;

  //------------------------------------------------------------------
  // Save a node to section.fRawData (and save it's child nodes recursively)

  procedure SaveToSection (node : TResourceNode);
  var
    table : TResourceDirectoryTable;
    entry : TResourceDirectoryEntry;
    dataEntry : PResourceDataEntry;
    i, n : Integer;
    w : WideString;
    wl : word;

  //------------------------------------------------------------------
  // Save entry (i), and the child nodes

    procedure SaveNode (i : Integer);
    begin
      if node.nodes [i].intID then      // id is a simple integer
        entry.name := StrToInt (node.nodes [i].id)
      else
      begin                             // id is an offset to a name in the
                                        // name table.
        entry.name := nameOffset + namePos + $80000000;
        w := node.nodes [i].id;
        wl := Length (node.nodes [i].id);
        Move (wl, nameTable [namePos], sizeof (wl));
        Inc (namePos, sizeof (wl));
        Move (w [1], nameTable [namePos], wl * sizeof (WideChar));
        Inc (namePos, wl * sizeof (WideChar))
      end;

      if node.nodes [i].leaf then       // RVA points to a TResourceDataEntry in the
      begin                             // data entry table.
        entry.RVA := deOffset + dePos;
        dataEntry := PResourceDataEntry (deTable + dePos);
        dataEntry^.CodePage := node.nodes [i].CodePage;
        dataEntry^.Reserved := 0;
        dataEntry^.Size := node.nodes [i].data.Size;
        dataEntry^.OffsetToData := dataOffset + dataPos + section.fSectionHeader.VirtualAddress;

        Move (node.nodes [i].data.memory^, data [dataPos], dataEntry^.Size);

        Inc (dePos, sizeof (TResourceDataEntry));
        dataPos := (dataPos + dataEntry^.size + 3) div 4 * 4;
        section.fRawData.Write (entry, sizeof (entry));
      end
      else                              // RVA points to another table.
      begin
        entry.RVA := $80000000 + tableOffset;
        section.fRawData.Write (entry, sizeof (entry));
        n := section.fRawData.Position;
        SaveToSection (node.nodes [i].next);
        section.fRawData.Seek (n, soFromBeginning);
      end
    end;

  begin { SaveToSection }
    table.characteristics := 0;
    table.timeDateStamp := TimeStamp;
    table.versionMajor := versMajor;
    table.versionMinor := versMinor;
    table.cNameEntries := 0;
    table.cIDEntries := 0;

                                        // Calculate no of integer and string IDs
    for i := 0 to node.count - 1 do
      if node.nodes [i].intID then
        Inc (table.cIDEntries)
      else
        Inc (table.cNameEntries);

    section.fRawData.Seek (tableOffset, soFromBeginning);
    section.fRawData.Write (table, sizeof (table));

    tableOffset := tableOffset + sizeof (TResourceDirectoryTable) + DWORD (node.Count) * sizeof (TResourceDirectoryEntry);

                                        // The docs suggest that you save the nodes
                                        // with string entries first.  Goodness knows why,
                                        // but play along...
    for i := 0 to node.count - 1 do
      if not node.nodes [i].intID then
       SaveNode (i);

    for i := 0 to node.count - 1 do
      if node.nodes [i].intID then
       SaveNode (i);

    section.fRawData.Seek (0, soFromEnd);
  end;


begin { Encode }
  section := GetResourceSection;

                                        // Get the details in a tree structure
  root := Nil;
  data := Nil;
  deTable := Nil;
  zeros := Nil;

  try
    for i := 0 to fDetailList.Count - 1 do
    begin
      details := TResourceDetails (fDetailList.Items [i]);
      if root = Nil then
        root := TResourceNode.Create (details.ResourceType, details.ResourceName, details.ResourceLanguage, details.Data, details.CodePage)
      else
        root.Add (details.ResourceType, details.ResourceName, details.ResourceLanguage, details.Data, details.CodePage)
    end;

                                          // Save elements of their original EXE
    versMajor := PResourceDirectoryTable (section.fRawData.Memory)^.versionMajor;
    versMinor := PResourceDirectoryTable (section.fRawData.Memory)^.versionMinor;
    TimeStamp := PResourceDirectoryTable (section.fRawData.Memory)^.timeDateStamp;


    section.fRawData.Clear;               // Clear the data.  We're gonna recreate
                                          // it from our resource details.

    nameSize := 0; nameOffset := 0;
    deSize := 0; deOffset := 0;
    dataSize := 0;

    GetNameTableSize (root);              // Calculate sizes and offsets of the
                                          // name table, the data entry table and
                                          // the size of the data.

                                          // Calculate the data offset.  Must be aligned.
    dataOffset := (nameOffset + nameSize + 15) div 16 * 16;

                                          // Initialize globals...
    namePos := 0;                         //   Offset of next entry in the string table
    dePos := 0;                           //   Offset of next entry in the data entry table
    dataPos := 0;                         //   Offset of next data block.
    tableOffset := 0;                     //   Offset of next TResourceDirectoryTable


    GetMem (nameTable, nameSize);         // Allocate buffers for tables
    GetMem (data, dataSize);
    GetMem (deTable, deSize);

    SaveToSection (root);               // Do the work.

                                        // Save the tables
    section.fRawData.Write (deTable^, deSize);
    section.fRawData.Write (nameTable^, nameSize);

                                        // Add padding so the data goes on a
                                        // 16 byte boundary.
    if DWORD (section.fRawData.Position) < dataOffset then
    begin
      GetMem (zeros, dataOffset - DWORD (section.fRawData.Position));
      ZeroMemory (zeros, dataOffset - DWORD (section.fRawData.Position));
      section.fRawData.Write (zeros^, dataOffset - DWORD (section.fRawData.Position))
    end;

                                        // Write the data.
    section.fRawData.Write (data^, dataSize);

    inherited; // **** Must call inherited !

  finally       // Tidy up.
    ReallocMem (zeros, 0);
    FreeMem (nameTable);
    FreeMem (deTable);
    FreeMem (data);
    root.Free
  end
end;


{ TResourceNode }

procedure TResourceNode.Add(const AType, AName: string; ALang: Integer;
  aData: TMemoryStream; codePage : DWORD);
var
  i : Integer;

begin
  for i := 0 to count - 1 do
    if AType = nodes [i].id then
    begin
      nodes [i].next.AddName (AName, ALang, aData, codePage);
      exit
    end;

  Inc (count);
  SetLength (nodes, count);
  nodes [count - 1].id := AType;
  nodes [count - 1].intID := isID (count - 1);
  nodes [count - 1].leaf := False;
  nodes [count - 1].next := TResourceNode.CreateNameNode (AName, ALang, AData, codePage)
end;

procedure TResourceNode.AddLang(ALang: Integer; aData: TMemoryStream; codePage : DWORD);
var
  i : Integer;
begin
  for i := 0 to count - 1 do
    if IntToStr (ALang) = nodes [i].id then
    begin
      nodes [i].data := aData;
      exit
    end;

  Inc (count);
  SetLength (nodes, count);
  nodes [count - 1].id := IntToStr (ALang);
  nodes [count - 1].intId := True;
  nodes [count - 1].leaf := True;
  nodes [count - 1].data := aData;
  nodes [count - 1].CodePage := codePage;
end;

procedure TResourceNode.AddName(const AName: string; ALang: Integer;
  aData: TMemoryStream; codePage : DWORD);
var
  i : Integer;
begin
  for i := 0 to count - 1 do
    if AName = nodes [i].id then
    begin
      nodes [i].next.AddLang (ALang, aData, codePage);
      exit
    end;

  Inc (count);
  SetLength (nodes, count);
  nodes [count - 1].id := AName;
  nodes [count - 1].intID := isID (count - 1);
  nodes [count - 1].leaf := False;
  nodes [count - 1].next := TResourceNode.CreateLangNode (ALang, aData, codePage)
end;

constructor TResourceNode.Create(const AType, AName: string;
  ALang: Integer; aData: TMemoryStream; codePage : DWORD);
begin
  count := 1;
  SetLength (nodes, 1);
  nodes [0].id := AType;
  nodes [count - 1].intID := isID (count - 1);
  nodes [0].leaf := False;
  nodes [0].next := TResourceNode.CreateNameNode (AName, ALang, aData, codePage);
end;

constructor TResourceNode.CreateLangNode(ALang: Integer;
  aData: TMemoryStream; codePage : DWORD);
begin
  count := 1;
  SetLength (nodes, 1);
  nodes [0].id := IntToStr (ALang);
  nodes [count - 1].intID := True;
  nodes [0].leaf := True;
  nodes [0].data := aData;
  nodes [0].CodePage := codePage
end;

constructor TResourceNode.CreateNameNode(const AName: string;
  ALang: Integer; aData: TMemoryStream; codePage : DWORD);
begin
  count := 1;
  SetLength (nodes, 1);
  nodes [0].id := AName;
  nodes [count - 1].intID := isID (count - 1);

  nodes [0].leaf := False;
  nodes [0].next := TResourceNode.CreateLangNode (ALang, aData, codePage)
end;

destructor TResourceNode.Destroy;
var
  i : Integer;
begin
  for i := 0 to count - 1 do
    if not nodes [i].leaf then
      nodes [i].next.Free;

  inherited;
end;

function TResourceNode.IsID (idx : Integer): boolean;
var
  i : Integer;
begin
  result := True;
  for i := 1 to Length (nodes [idx].id) do
    if not (nodes [idx].id [i] in ['0'..'9']) then
    begin
      result := False;
      break
    end;

  if result then
    result := IntToStr (StrToInt (nodes [idx].id)) = nodes [idx].id;
end;

function TPEResourceModule.AddResource(details: TResourceDetails): Integer;
begin
  Result := fDetailList.Add (details);
end;

procedure TPEResourceModule.SortResources;
begin
  fDetailList.Sort (compareDetails);
end;

end.