compresupdate.pas

源代码

unit CompResUpdate;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Resource update functions

  $jrsoftware: issrc/Projects/CompResUpdate.pas,v 1.7 2004/06/26 04:36:08 jr Exp $
}

interface

uses
  Windows, SysUtils,
  VerInfo;

{$I VERSION.INC}

procedure UpdateVersionInfo(const Filename: String;
  const NewBinaryFileVersion: TFileVersionNumbers;
  const NewCompanyName, NewFileDescription, NewTextFileVersion: String);

procedure UpdateIcons(const FileName, IcoFileName: String);

implementation

uses
  FileClass;

procedure Error(const Msg: String);
begin
  raise Exception.Create('Resource update error: ' + Msg);
end;

procedure ErrorWithLastError(const Msg: String);
begin
  Error(Msg + '(' + IntToStr(GetLastError) + ')');
end;

procedure UpdateVersionInfo(const Filename: String;
  const NewBinaryFileVersion: TFileVersionNumbers;
  const NewCompanyName, NewFileDescription, NewTextFileVersion: String);
const
  IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16;
  IMAGE_SIZEOF_SHORT_NAME = 8;
  IMAGE_DIRECTORY_ENTRY_RESOURCE = 2;
type
  PImageFileHeader = ^TImageFileHeader;
  TImageFileHeader = packed record
    Machine: Word;
    NumberOfSections: Word;
    TimeDateStamp: DWORD;
    PointerToSymbolTable: DWORD;
    NumberOfSymbols: DWORD;
    SizeOfOptionalHeader: Word;
    Characteristics: Word;
  end;
  PImageDataDirectory = ^TImageDataDirectory;
  TImageDataDirectory = record
    VirtualAddress: DWORD;
    Size: DWORD;
  end;
  PImageOptionalHeader = ^TImageOptionalHeader;
  TImageOptionalHeader = packed record
    { Standard fields. }
    Magic: Word;
    MajorLinkerVersion: Byte;
    MinorLinkerVersion: Byte;
    SizeOfCode: DWORD;
    SizeOfInitializedData: DWORD;
    SizeOfUninitializedData: DWORD;
    AddressOfEntryPoint: DWORD;
    BaseOfCode: DWORD;
    BaseOfData: DWORD;
    { NT additional fields. }
    ImageBase: DWORD;
    SectionAlignment: DWORD;
    FileAlignment: DWORD;
    MajorOperatingSystemVersion: Word;
    MinorOperatingSystemVersion: Word;
    MajorImageVersion: Word;
    MinorImageVersion: Word;
    MajorSubsystemVersion: Word;
    MinorSubsystemVersion: Word;
    Win32VersionValue: DWORD;
    SizeOfImage: DWORD;
    SizeOfHeaders: DWORD;
    CheckSum: DWORD;
    Subsystem: Word;
    DllCharacteristics: Word;
    SizeOfStackReserve: DWORD;
    SizeOfStackCommit: DWORD;
    SizeOfHeapReserve: DWORD;
    SizeOfHeapCommit: DWORD;
    LoaderFlags: DWORD;
    NumberOfRvaAndSizes: DWORD;
    DataDirectory: packed array[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of TImageDataDirectory;
  end;
  TISHMisc = packed record
    case Integer of
      0: (PhysicalAddress: DWORD);
      1: (VirtualSize: DWORD);
  end;
  PImageSectionHeader = ^TImageSectionHeader;
  TImageSectionHeader = packed record
    Name: packed array[0..IMAGE_SIZEOF_SHORT_NAME-1] of Byte;
    Misc: TISHMisc;
    VirtualAddress: DWORD;
    SizeOfRawData: DWORD;
    PointerToRawData: DWORD;
    PointerToRelocations: DWORD;
    PointerToLinenumbers: DWORD;
    NumberOfRelocations: Word;
    NumberOfLinenumbers: Word;
    Characteristics: DWORD;
  end;
  TImageResourceDirectory = packed record
    Characteristics: DWORD;
    TimeDateStamp: DWORD;
    MajorVersion: Word;
    MinorVersion: Word;
    NumberOfNamedEntries: Word;
    NumberOfIdEntries: Word;
  end;
  TImageResourceDirectoryEntry = packed record
    Id: DWORD;
    Offset: DWORD;
  end;
  TImageResourceDataEntry = packed record
    OffsetToData: DWORD;
    Size: DWORD;
    CodePage: DWORD;
    Reserved: DWORD;
  end;
  PPESectionHeaderArray = ^TPESectionHeaderArray;
  TPESectionHeaderArray = array[0..$7FFFFFFF div SizeOf(TImageSectionHeader)-1] of TImageSectionHeader;
var
  F: TFile;

  function FindResOffset(const AnyId: Boolean; const Id: Cardinal;
    const FindSubdir: Boolean; var Offset: Cardinal): Boolean;
  var
    Dir: TImageResourceDirectory;
    Entry: TImageResourceDirectoryEntry;
    I: Integer;
  begin
    F.ReadBuffer(Dir, SizeOf(Dir));
    { Skip over named entries }
    for I := 0 to Dir.NumberOfNamedEntries-1 do
      F.ReadBuffer(Entry, SizeOf(Entry));
    { Now process ID entries }
    Result := False;
    for I := 0 to Dir.NumberOfIdEntries-1 do begin
      F.ReadBuffer(Entry, SizeOf(Entry));
      if (AnyId or (Entry.Id = Id)) and
         ((Entry.Offset and $80000000 <> 0) = FindSubdir) then begin
        Offset := Entry.Offset and $7FFFFFFF;
        Result := True;
        Break;
      end;
    end;
  end;

  function WideStrsEqual(P1, P2: PWideChar): Boolean;

    function WideUpCase(C: WideChar): WideChar;
    begin
      Result := C;
      if (Result >= 'a') and (Result <= 'z') then
        Dec(Result, Ord('a') - Ord('A'));
    end;

  begin
    while True do begin
      if WideUpCase(P1^) <> WideUpCase(P2^) then begin
        Result := False;
        Exit;
      end;
      if P1^ = #0 then
        Break;
      Inc(P1);
      Inc(P2);
    end;
    Result := True;
  end;

  procedure BumpToDWordBoundary(var P: Pointer);
  begin
    if Cardinal(P) and 3 <> 0 then
      Cardinal(P) := (Cardinal(P) or 3) + 1;
  end;

  function QueryValue(P: Pointer; Path: PWideChar; var Buf: Pointer;
    var BufLen: Cardinal): Boolean;
  var
    EndP: Pointer;
    ValueLength: Cardinal;
    BinaryType: Boolean;
  begin
    Result := False;
    Cardinal(EndP) := Cardinal(P) + PWord(P)^;
    Inc(PWord(P));
    ValueLength := PWord(P)^;
    Inc(PWord(P));
    BinaryType := (PWord(P)^ = 0);
    Inc(PWord(P));
    if WideStrsEqual(PWideChar(P), Path) then begin
      Inc(PWideChar(P), lstrlenW(P) + 1);
      BumpToDWordBoundary(P);
      Inc(Path, lstrlenW(Path) + 1);
      if Path^ = #0 then begin
        { Found the requested value }
        Buf := P;
        BufLen := ValueLength;
        Result := True;
      end
      else begin
        { Handle children.
          NOTE: This assumes that ValueLength is expressed in bytes. }
        if BinaryType then
          Inc(Cardinal(P), ValueLength)
        else
          Inc(Cardinal(P), ValueLength * SizeOf(WideChar));
        BumpToDWordBoundary(P);
        while Cardinal(P) < Cardinal(EndP) do begin
          Result := QueryValue(P, Path, Buf, BufLen);
          if Result then
            Exit;
          Inc(Cardinal(P), PWord(P)^);
          BumpToDWordBoundary(P);
        end;
      end;
    end;
  end;

  procedure UpdateStringValue(P: Pointer; const Path: PWideChar; NewValue: String);
  var
    Value: Pointer;
    ValueLen: Cardinal;
  begin
    if not QueryValue(P, Path, Value, ValueLen) then
      Error('Unexpected version resource format (1)');
    MultiByteToWideChar(CP_ACP, 0, PChar(NewValue), Length(NewValue), Value, lstrlenW(Value));
  end;

  procedure UpdateFixedFileInfo(P: Pointer; const Path: PWideChar; NewFileVersion: TFileVersionNumbers);
  var
    FixedFileInfo: PVSFixedFileInfo;
    ValueLen: Cardinal;
  begin
    if not QueryValue(P, Path, Pointer(FixedFileInfo), ValueLen) then
      Error('Unexpected version resource format (2)');
    if FixedFileInfo.dwSignature <> $FEEF04BD then
      Error('Unexpected version resource format (3)');
    FixedFileInfo.dwFileVersionLS := NewFileVersion.LS;
    FixedFileInfo.dwFileVersionMS := NewFileVersion.MS;
  end;

var
  EXESig: Word;
  PEHeaderOffset, PESig: Cardinal;
  PEHeader: TImageFileHeader;