{*******************************************************}
{               MiTeC Common Routines                   }
{                  PE Version Info                      }
{                                                       }
{                                                       }
{         Copyright (c) by 1997-2021 Michal Mutl        }
{                                                       }
{*******************************************************}

{$INCLUDE Compilers.inc}

unit MiTeC_VersionInfo;

interface

uses {$IFDEF RAD9PLUS}
     WinAPI.Windows, System.Classes, System.SysUtils,
     {$ELSE}
     Windows, Classes, SysUtils,
     {$ENDIF}
     MiTeC_Windows;

type
  {$IFNDEF RAD6PLUS}
  TBytes = array of Byte;
  {$ENDIF}
  
  TResItem = record
    Name: string;
    Lang: Cardinal;
    CodePage: Cardinal;
    RawDataSize: Cardinal;
  end;

  TResList = array of TResItem;

  TVersionHeader = packed record
    wLength: word;
    wValueLength: word;
    wType: word;
    Key: array[0..16] of WideChar;   // 'VS_VERSION_INFO'
    Version: TVSFixedFileInfo;
  end;
  PVersionHeader = ^TVersionHeader;

  TTableHeader = record
    wLength: word;
    wValueLength: word;
    wType: Word;
  end;

  TVersionStringValue = record
    Name: string;
    Value: string;
  end;

  TTranslation = record
    Lang,
    CodePage: Word;
  end;
  PTranslation = ^TTranslation;

  TStringFileInfo = record
    Translation: TTranslation;
    Values: array of TVersionStringValue;
  end;

  TStringVersionInfo = array of TStringFileInfo;

  TStringFileInfoTables = array of TTranslation;

  TVersionNumber = record
    Major,
    Minor,
    Release,
    Build: integer;
  end;

  TFileFlags = (ffDebug, ffInfoInferred, ffPatched, ffPreRelease, ffPrivateBuild, ffSpecialBuild);
  TVersionFileFlags = set of TFileFlags;

  TVersionInformation = class(TPersistent)
  private
    FHeader: PVersionHeader;
    FMFB: Pointer;
    FSize: Cardinal;
    FFilename: string;
    FModified: Boolean;
    FFVN: TVersionNumber;
    FPVN: TVersionNumber;
    FFF: TVersionFileFlags;
    FOS,FType: Cardinal;
    FValid: Boolean;
    FVI: TStringVersionInfo;
    FRL: TResList;
    FRMF: Boolean;
    procedure Init;
    function CreateResList: boolean;
    procedure ReadData;
    procedure SetFilename(const Value: string);
    procedure SetFVN(const Value: TVersionNumber);
    procedure SetPVN(const Value: TVersionNumber);
    procedure SetFF(const Value: TVersionFileFlags);
    function GetVerItem(ATranslation: TTranslation;
      AIndex: Integer): TVersionStringValue;
    function GetTrans(AIndex: Integer): TTranslation;
    function GetTransCount: Cardinal;
    function GetValue(ATranslation: TTranslation; const AName: string): string;
    function GetItemCount(ATranslation: TTranslation): Cardinal;
    function FindTranslation(ATranslation: TTranslation): Integer;
    procedure SetResLang(const Value: TTranslation);
    procedure PadStream(AStream: TStream);
    procedure SaveVersionHeader(AStream: TStream; ALength, AValueLength, AType: Word; const Aname: string; const AValue);
    function GetProperty(const Index: Integer): string;
    procedure SetProperty(const Index: Integer; const Value: string);
    function GetTransProp: TTranslation;
    procedure SetTransProp(const Value: TTranslation);
    function GetCount: Cardinal;
    function GetItem(AIndex: Integer): TVersionStringValue;
    function GetResLang: TTranslation;
  protected
    procedure SetTranslation(AIndex: Integer; ANew: TTranslation);
    procedure SetStringFileInfoValue(ATranslation: TTranslation; const AName: string; ANewValue: string); overload;

    property TranslationCount: Cardinal read GetTransCount;
    property Translations[AIndex: Integer]: TTranslation read GetTrans;

    property StringFileInfo[ATranslation: TTranslation; AIndex: Integer]: TVersionStringValue read GetVerItem;
    property StringFileInfoItemCount[ATranslation: TTranslation]: Cardinal read GetItemCount;
    property StringFileInfoValue[ATranslation: TTranslation; const AName: string]: string read GetValue;
  public
    constructor Create; overload;
    constructor Create(AMappedFileBase: Pointer); overload;
    destructor Destroy; override;
    procedure SetStringFileInfoValue(AIndex: Integer; const AName: string; ANewValue: string); overload;
    procedure RefreshData;
    function SaveData: boolean;
    procedure AddItem(const AName, AValue: string);

    property FileName: string read FFilename write SetFilename;
    property Valid: Boolean read FValid;
    property Modified: Boolean read FModified;
    property ResourceLanguage: TTranslation read GetResLang write SetResLang;

    property Translation: TTranslation read GetTransProp write SetTransProp;

    property ProductVersionNumber: TVersionNumber read FPVN write SetPVN;
    property FileVersionNumber: TVersionNumber read FFVN write SetFVN;
    property FileFlags: TVersionFileFlags read FFF write SetFF;
    property FileOS: Cardinal read FOS;
    property FileType: Cardinal read FType;

    property ItemCount: Cardinal read GetCount;
    property Items[AIndex: Integer]: TVersionStringValue read GetItem;

    property CompanyName: string Index 0 read GetProperty write SetProperty;
    property FileDescription: string Index 1 read GetProperty write SetProperty;
    property FileVersion: string Index 2 read GetProperty write SetProperty;
    property InternalName: string Index 3 read GetProperty write SetProperty;
    property LegalCopyright: string Index 4 read GetProperty write SetProperty;
    property LegalTrademarks: string Index 5 read GetProperty write SetProperty;
    property OriginalFilename: string Index 6 read GetProperty write SetProperty;
    property ProductName: string Index 7 read GetProperty write SetProperty;
    property ProductVersion: string Index 8 read GetProperty write SetProperty;
    property Comments: string Index 9 read GetProperty write SetProperty;
  end;

implementation

function GetFileSize(const AFilename: string): Integer;
var
  FI :TBYHANDLEFILEINFORMATION;
  h :THandle;
begin
  Result:=-1;
  h:=FileOpen(AFilename,fmOpenRead or fmShareDenyNone);
  if h<>Cardinal(-1) then begin
    GetFileInformationByHandle(h,FI);
    FileClose(h);
    Result:=FI.nFileSizelow+256*FI.nFileSizehigh;
  end;
end;

{ TVersionInformation }

constructor TVersionInformation.Create;
begin
  FRMF:=True;
  Init;
end;

procedure TVersionInformation.AddItem(const AName, AValue: string);
begin
  SetLength(FVI[0].Values,Length(FVI[0].Values)+1);
  FVI[0].Values[High(FVI[0].Values)].Name:=AName;
  FVI[0].Values[High(FVI[0].Values)].Value:=AValue;
end;

constructor TVersionInformation.Create(AMappedFileBase: Pointer);
begin
  FMFB:=AMappedFileBase;
  FRMF:=False;
  Init;
end;

function TVersionInformation.CreateResList: Boolean;
var
  fm,fh,flh: THandle;
  ErrorMode: Word;
  Is64: Boolean;
  HeadersAddress,HeadersSize: Cardinal;
  ImageNTHeaders: PImageNtHeaders;
  OptionalHeader: {$IFDEF RAD9PLUS}PImageOptionalHeader32{$ELSE}PImageOptionalHeader{$ENDIF};
  OptionalHeader64: PImageOptionalHeader64;

function GetDataDirectory(ADirectory: Word): TImagedataDirectory;
begin
  if Is64 then
    Result:=TImageDataDirectory(OptionalHeader64.DataDirectory[ADirectory])
  else
    Result:=TImageDataDirectory(OptionalHeader.DataDirectory[ADirectory])
end;

function RvaToVa(Rva: Cardinal; Correct: boolean = True): Pointer;
var
  i: Cardinal;
  sh: PImageSectionHeader;
  d: Cardinal;
begin
  d:=0;
  if Correct then begin
    for i:=0 to ImageNTHeaders.FileHeader.NumberOfSections-1 do begin
      sh:=PImageSectionHeader(HeadersAddress+HeadersSize+i*SizeOf(TImageSectionHeader));
      if ((rva>=sh.VirtualAddress) and (rva<sh.VirtualAddress+sh.Misc.VirtualSize)) then begin
        d:=sh.VirtualAddress-sh.PointerToRawData;
        Break;
      end;
    end;
  end;
  Result:=PAnsiChar(FMFB)+Rva-d;
end;

function ResOfsToRawData(Ofs: Cardinal): Cardinal;
begin
  Result:=(Ofs and $7FFFFFFF)+Cardinal(RvaToVA(GetDataDirectory(IMAGE_DIRECTORY_ENTRY_RESOURCE).VirtualAddress));
end;

function DirectoryEntryToData(Directory: Word): Pointer;
begin
  Result:=RvaToVA(GetDataDirectory(Directory).VirtualAddress);
end;

procedure ReadSubDir(AEntry: PImageResourceDirectoryEntry; AType: Cardinal; ATypename: string);
var
  i: Integer;
  s,n: string;
  rd: PImageResourceDirectory;
  e: PImageResourceDirectoryEntry;
  de: PImageResourceDataEntry;
begin
  if AEntry^.Name and IMAGE_RESOURCE_NAME_IS_STRING<>0 then begin
    with PImageResourceDirStringU(ResOfsToRawData(AEntry^.Name))^ do
      n:=WideCharLenToString(NameString,Length);
    SetLength(n,Length(n));
  end else
    n:=IntToStr(AEntry^.Name and $FFFF);
  rd:=PImageResourceDirectory(ResOfsToRawData(AEntry.OffsetToDirectory));
  e:=Pointer(Cardinal(rd)+SizeOf(TImageResourceDirectory));
  if e=AEntry then
    Exit;
  for i:=0 to rd.NumberOfNamedEntries+rd.NumberOfIdEntries-1 do begin
    if e^.OffsetToData and IMAGE_RESOURCE_DATA_IS_DIRECTORY<>0 then
      ReadSubDir(e,AType,ATypename)
    else begin
      de:=PImageResourceDataEntry(ResOfsToRawData(e^.OffsetToData));
      if e^.Name and IMAGE_RESOURCE_NAME_IS_STRING<>0 then begin
        with PImageResourceDirStringU(ResOfsToRawData(e^.Name))^ do
          s:=WideCharLenToString(NameString,Length);
        SetLength(s,Length(s));
      end else
        s:=IntToStr(e^.Name and $FFFF);
      if AType=rtVersion then begin
        SetLength(FRL,Length(FRL)+1);
        with FRL[High(FRL)] do begin
          Name:=n;
          Lang:=StrToIntDef(s,0);
          CodePage:=de.CodePage;
          RawDataSize:=de.Size;
        end;
      end;
    end;
    Inc(e);
  end;
end;

var
  rd: PImageResourceDirectory;
  re: PImageResourceDirectoryEntry;
  i: Integer;
  s: string;
begin
  Result:=False;
  fh:=0;
  fm:=0;
  if FRMF then
    FMFB:=nil;
  flh:=0;
  try
    if not Assigned(FMFB) then begin
      fh:=CreateFile(PChar(FFilename),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
      if (FH<>INVALID_HANDLE_VALUE) then begin
        fm:=CreateFileMapping(FH,nil,PAGE_READONLY,0,0,nil);
        if (FM<>0) then
          FMFB:=MapViewOfFile(FM,FILE_MAP_READ,0,0,0);
      end;
    end;

    ErrorMode:=SetErrorMode(SEM_FailCriticalErrors or SEM_NoOpenFileErrorBox);
    try
      try flh:=LoadLibraryEx(PChar(FFilename),0,DONT_RESOLVE_DLL_REFERENCES); except end;
    finally
      SetErrorMode(ErrorMode);
    end;

    if Assigned(FMFB) and (PImageDosHeader(FMFB)^.e_magic=IMAGE_DOS_SIGNATURE) and (PImageDosHeader(FMFB)^._lfanew<GetFileSize(FFilename)) then
      try
        ImageNTHeaders:=PImageNtHeaders(Integer(FMFB)+PImageDosHeader(FMFB)^._lfanew);
        OptionalHeader:={$IFDEF RAD9PLUS}PImageOptionalHeader32{$ELSE}PImageOptionalHeader{$ENDIF}(Integer(FMFB)+PImageDosHeader(FMFB)^._lfanew+sizeof(TImageNTHeaders)-SizeOf(Word));
        OptionalHeader64:=PImageOptionalHeader64(Integer(FMFB)+PImageDosHeader(FMFB)^._lfanew+sizeof(TImageNTHeaders)-SizeOf(Word));
        Is64:=ImageNtHeaders^.Magic=IMAGE_NT_OPTIONAL_HDR64_MAGIC;

        HeadersAddress:=Cardinal(ImageNtHeaders);
        if Is64 then
          HeadersSize:=sizeof(TImageNTHeaders)-SizeOf(Word)+SizeOf(TImageOptionalHeader64)
        else
          HeadersSize:=sizeof(TImageNTHeaders)-SizeOf(Word)+SizeOf({$IFDEF RAD9PLUS}TImageOptionalHeader32{$ELSE}TImageOptionalHeader{$ENDIF});

        if GetDataDirectory(IMAGE_DIRECTORY_ENTRY_RESOURCE).Size=0 then
          Exit;
        rd:=PImageResourceDirectory(DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_RESOURCE));
        re:=Pointer(Cardinal(rd)+SizeOf(TImageResourceDirectory));
        for i:=0 to rd.NumberOfNamedEntries+rd.NumberOfIdEntries-1 do begin
          if re^.Name and IMAGE_RESOURCE_NAME_IS_STRING<>0 then begin
            with PImageResourceDirStringU(ResOfsToRawData(re^.Name))^ do
              s:=WideCharLenToString(NameString,Length);
            SetLength(s,Length(s));
          end else
            s:=IntToStr(re^.Name and $FFFF);
          ReadSubDir(re,re^.Name,s);
          Inc(re);
        end;
        Result:=True;
      except
      end;
  finally
    if FRMF then begin
      if Assigned(FMFB) then
        UnmapViewOfFile(FMFB);
      if fm>0 then
        CloseHandle(fm);
      if fh>0 then
        Closehandle(fh);
    end;
    if flh>0 then
      FreeLibrary(flh);
  end;
end;

destructor TVersionInformation.Destroy;
begin
  Init;
  inherited;
end;

function TVersionInformation.FindTranslation(
  ATranslation: TTranslation): Integer;
var
  i: Integer;
begin
  Result:=-1;
  for i:=0 to High(FVI) do
    if (FVI[i].Translation.Lang=ATranslation.Lang) and (FVI[i].Translation.CodePage=ATranslation.CodePage) then begin
      Result:=i;
      Break;
    end;
end;

function TVersionInformation.GetVerItem(ATranslation: TTranslation;
  AIndex: Integer): TVersionStringValue;
var
  i: Integer;
begin
  i:=FindTranslation(ATranslation);
  if i>-1 then
    Result:=FVI[i].Values[AIndex];
end;

function TVersionInformation.GetCount: Cardinal;
begin
  Result:=0;
  if Length(FVI)=0 then
    Exit;
  Result:=Length(FVI[0].Values);
end;

function TVersionInformation.GetItem(AIndex: Integer): TVersionStringValue;
begin
  if Length(FVI)=0 then
    Exit;
  Result:=FVI[0].Values[AIndex];
end;

function TVersionInformation.GetItemCount(ATranslation: TTranslation): Cardinal;
var
  i: Integer;
begin
  Result:=0;
  i:=FindTranslation(ATranslation);
  if i>-1 then
    Result:=Length(FVI[i].Values);
end;

function TVersionInformation.GetProperty(const Index: Integer): string;
var
  s: string;
begin
  Result:='';
  if Length(FVI)=0 then
    Exit;
  case Index of
    0: s:='CompanyName';
    1: s:='FileDescription';
    2: s:='FileVersion';
    3: s:='InternalName';
    4: s:='LegalCopyright';
    5: s:='LegalTrademarks';
    6: s:='OriginalFilename';
    7: s:='ProductName';
    8: s:='ProductVersion';
    9: s:='Comments';
  end;
  Result:=GetValue(FVI[0].Translation,s);
end;

function TVersionInformation.GetResLang: TTranslation;
begin
  Result.Lang:=0;
  Result.CodePage:=0;
  if Length(FRL)=0 then
    Exit;
  Result.Lang:=FRL[0].Lang;
  Result.CodePage:=FRL[0].CodePage;
end;

function TVersionInformation.GetTrans(AIndex: Integer): TTranslation;
begin
  if Length(FVI)=0 then
    Exit;
  Result:=FVI[AIndex].Translation;
end;

function TVersionInformation.GetTransCount: Cardinal;
begin
  Result:=Length(FVI);
end;

function TVersionInformation.GetTransProp: TTranslation;
begin
  Result.Lang:=0;
  Result.CodePage:=0;
  if Length(FVI)=0 then
    Exit;
  Result:=FVI[0].Translation;
end;

function TVersionInformation.GetValue(ATranslation: TTranslation;
  const AName: string): string;
var
  i,j: Integer;
begin
  Result:='';
  i:=FindTranslation(ATranslation);
  if i>-1 then
    for j:=0 to High(FVI[i].Values) do
      if SameText(FVI[i].Values[j].Name,AName) then begin
        Result:=FVI[i].Values[j].Value;
        Break;
      end;
end;

procedure TVersionInformation.Init;
var
  i: Integer;
begin
  FHeader:=nil;
  FSize:=0;
  FValid:=False;
  FModified:=False;
  FFF:=[];
  FOS:=0;
  FType:=0;
  ZeroMemory(@FPVN,SizeOf(FPVN));
  ZeroMemory(@FFVN,SizeOf(FFVN));
  for i:=0 to High(FVI) do
    Finalize(FVI[i].Values);
  Finalize(FVI);
  Finalize(FRL);
end;

procedure TVersionInformation.PadStream(AStream: TStream);
var
  w: Word;
begin
  w:=0;
  if AStream.Position mod 4<>0 then
    AStream.Write(w,4-(AStream.Position mod 4));
end;

procedure TVersionInformation.ReadData;
var
  f,i,j,l,vl: Integer;
  vh,p,sp,n: Cardinal;
  Buf,b: TBytes;
  lcp: PTranslation;
  ms: TMemoryStream;
  sh,lh,h: TTableHeader;
  nvfi: Boolean;
  s: string;

function ReadString: string;
var
  w: Word;
  s: string;
begin
  Result:='';
  w:=1;
  while (w<>0) and (ms.Position<ms.Size) do begin
    ms.read(w,SizeOf(w));
    if w<>0 then begin
      s:={$IFNDEF UNICODE}WideCharToString{$ENDIF}(PWideChar(@w));
      SetLength(s,1);
      Result:=Result+s;
    end;
  end;
  while (w=0) and (ms.Position<ms.Size) do
    ms.read(w,SizeOf(w));
  if ms.Position<ms.Size then
    ms.Seek(-SizeOf(w),soFromCurrent);
end;

procedure BufferAlign;
begin
  ms.Position:=Round(Int(((ms.Position+SizeOf(TVersionHeader)+3) div 4)*4))-SizeOf(TVersionHeader);
end;

begin
  Init;
  FSize:=GetFileVersionInfoSize(PChar(FFilename),vh);

  CreateResList;

  if (FSize=0) then
    Exit;
  FHeader:=AllocMem(FSize);
  GetFileVersionInfo(PChar(FFilename),0,FSize,FHeader);
  if FHeader^.Version.dwSignature<>$FEEF04BD then
    Exit;
  SetLength(Buf,FSize);
  Move(FHeader^,Buf[0],FSize);
  FFVN.Major:=HiWord(FHeader^.Version.dwFileVersionMS);
  FFVN.Minor:=LoWord(FHeader^.Version.dwFileVersionMS);
  FFVN.Release:=HiWord(FHeader^.Version.dwFileVersionLS);
  FFVN.Build:=LoWord(FHeader^.Version.dwFileVersionLS);
  FPVN.Major:=HiWord(FHeader^.Version.dwProductVersionMS);
  FPVN.Minor:=LoWord(FHeader^.Version.dwProductVersionMS);
  FPVN.Release:=HiWord(FHeader^.Version.dwProductVersionLS);
  FPVN.Build:=LoWord(FHeader^.Version.dwProductVersionLS);

  FOS:=FHeader^.Version.dwFileOS;
  FType:=FHeader^.Version.dwFileType;

  f:=FHeader^.Version.dwFileFlags and FHeader^.Version.dwFileFlagsMask;
  if (f and VS_FF_DEBUG)<>0 then
    FFF:=FFF+[ffDebug];
  if (f and VS_FF_INFOINFERRED)<>0 then
    FFF:=FFF+[ffInfoInferred];
  if (f and VS_FF_PATCHED)<>0 then
    FFF:=FFF+[ffPatched];
  if (f and VS_FF_PRERELEASE)<>0 then
    FFF:=FFF+[ffPreRelease];
  if (f and VS_FF_PRIVATEBUILD)<>0 then
    FFF:=FFF+[ffPrivateBuild];
  if (f and VS_FF_SPECIALBUILD)<>0 then
    FFF:=FFF+[ffSpecialBuild];

  nvfi:=True;
  if VerQueryValue(FHeader,PChar('\VarFileInfo\Translation'),Pointer(lcp),n) then begin
    SetLength(FVI,n div SizeOf(TTranslation));
    for i:=0 to High(FVI) do begin
      FVI[i].Translation:=lcp^;
      lcp:=Pointer(PAnsiChar(lcp)+SizeOf(TTranslation));
    end;
    nvfi:=False;
  end;

  p:=SizeOf(TVersionHeader);
  ms:=TMemoryStream.Create;
  try
    ms.Write(Buf[p],FHeader.wLength-p);
    ms.Position:=0;
    //{$IFDEF DEBUG}ms.SaveToFile('d:\0\'+ChangeFileExt(ExtractFilename(FFilename),'.bin'));{$ENDIF}
    ms.read(sh,SizeOf(sh));
    SetLength(b,Length('StringFileInfo')*SizeOf(WideChar)+SizeOf(WideChar));
    ms.Read(b[0],Length(b));
    if not WideSameText(PWideChar(b),'StringFileInfo') then begin
      ms.Seek(sh.wLength,soFromBeginning);
      ms.read(sh,SizeOf(sh));
      ms.Seek(Length('StringFileInfo')*SizeOf(WideChar)+SizeOf(Word),soCurrent);
    end;
    i:=0;
    sp:=ms.Position;
    if Length(FVI)>i then
      Finalize(FVI[i].Values);
     ms.Seek(sp,soFromBeginning);
     while ms.Position<sh.wLength do begin
       p:=ms.Position;
       ms.read(lh,SizeOf(lh));
       SetLength(b,9*SizeOf(WideChar));
       ms.read(b[0],Length(b));
       if nvfi or (i=Length(FVI)) then begin
         SetLength(FVI,Length(FVI)+1);
         i:=High(FVI);
         s:={$IFNDEF UNICODE}WideCharToString{$ENDIF}(PWideChar(b));
         SetLength(s,8);
         FVI[i].Translation.Lang:=StrToIntDef('$'+Copy(s,1,4),0);
         FVI[i].Translation.CodePage:=StrToIntDef('$'+Copy(s,5,4),0);
       end;
       while (ms.Position-p<lh.wLength) and (ms.Position<ms.Size) do begin
         SetLength(FVI[i].Values,Length(FVI[i].Values)+1);
         j:=High(FVI[i].Values);
         BufferAlign;
         ms.read(h,SizeOf(h));
         l:=ms.Position;
         FVI[i].Values[j].Name:=ReadString;//{$IFNDEF UNICODE}WideCharToString{$ENDIF}(PWideChar(b));
         BufferAlign;
         l:=ms.Position-l;
         vl:=h.wLength-SizeOf(h)-l;
         if vl>0 then begin
           vl:=vl+vl mod 4;
           SetLength(b,vl);
           FillChar(b[0],Length(b),0);
           ms.read(b[0],Length(b));
           FVI[i].Values[j].Value:={$IFNDEF UNICODE}WideCharToString{$ENDIF}(PWideChar(b));
         end;
       end;
       Inc(i);
     end;
  finally
    ms.Free;
  end;

  FValid:=True;
end;

procedure TVersionInformation.RefreshData;
begin
  ReadData;
end;

function TVersionInformation.SaveData: boolean;
var
  i,j: Integer;
  vr,p,p1,v: Cardinal;
  w,n: Word;
  ms,ms1: TMemoryStream;
  ws: WideString;
begin
  Result:=False;
  if not Assigned(FHeader) then
    Exit;

  w:=0;
  ms:=TMemoryStream.Create;
  try
    SaveVersionHeader(ms,0,sizeof(TVSFixedFileInfo),0,'VS_VERSION_INFO',FHeader^.Version);

    for i:=0 to High(FVI) do begin
      ms1:=TMemoryStream.Create;
      try
        SaveVersionHeader(ms1,0,0,0,IntToHex(FVI[i].Translation.Lang,4)+IntToHex(FVI[i].Translation.CodePage,4),w);
        for j:=0 to High(FVI[i].Values) do begin
          PadStream(ms1);
          p:=ms1.Position;
          ws:=FVI[i].Values[j].Value;
          if ws='' then
            ws:=#0#0;
          SaveVersionHeader(ms1,0,Length(FVI[i].Values[j].Value)+1,1,FVI[i].Values[j].Name,ws[1]);
          n:=ms1.Size-p;
          ms1.Seek(p,soFromBeginning);
          ms1.Write(n,SizeOf(n));
          ms1.Seek(0,soFromEnd);
        end;
        ms1.Seek(0,soFromBeginning);
        n:=ms1.Size;
        ms1.Write(n,sizeof(n));
        PadStream (ms);
        p:=ms.Position;
        SaveVersionHeader(ms,0,0,0,'StringFileInfo',w);
        ms.Write(ms1.Memory^,ms1.size);
        n:=ms.Size-p;
      finally
        ms1.Free
      end;
      ms.Seek(p,soFromBeginning);
      ms.Write(n,sizeof(n));
      ms.Seek(0,soFromEnd);
    end;

    if Length(FVI)>0 then begin
      PadStream(ms);
      p:=ms.Position;
      SaveVersionHeader(ms,0,0,0,'VarFileInfo',w);
      PadStream(ms);
      p1:=ms.Position;
      SaveVersionHeader(ms,0,0,0,'Translation',w);
      for i:=0 to High(FVI) do begin
        v:=MAKELONG(FVI[i].Translation.Lang,FVI[i].Translation.CodePage);
        ms.Write(v,sizeof(v));
      end;

      n:=ms.Size-p1;
      ms.Seek(p1,soFromBeginning);
      ms.Write(n,SizeOf(n));
      n:=sizeof(Integer)*Length(FVI);
      ms.Write(n,SizeOf(n));

      n:=ms.Size-p;
      ms.Seek(p,soFromBeginning);
      ms.Write(n,SizeOf(n));
    end;

    ms.Seek(0,soFromBeginning);
    n:=ms.Size;
    ms.Write(n,SizeOf(n));
    ms.Seek(0,soFromEnd);

    vr:=BeginUpdateResource(PChar(FFilename),False);
    try
      Result:=UpdateResource(vr,RT_VERSION,MAKEINTRESOURCE(VS_VERSION_INFO),FRL[0].Lang,ms.Memory,ms.Size);
    finally
      EndUpdateResource(vr,False);
    end;

  finally
    ms.Free;
  end;
  FModified:=False;
end;

procedure TVersionInformation.SaveVersionHeader(AStream: TStream; ALength,
  AValueLength, AType: Word; const Aname: string; const AValue);
var
  ws: WideString;
  vl,nl: Word;
begin
  ws:=AName;
  AStream.Write(ALength,SizeOf(ALength));
  AStream.Write(AValueLength,SizeOf(AValueLength));
  AStream.Write(AType,sizeof(AType));
  nl:=(Length(AName)+1)*sizeof(WideChar);
  AStream.Write(ws[1],nl);
  PadStream(AStream);
  if AValueLength>0 then begin
    vl:=AValueLength;
    if AType=1 then
      vl:=vl*sizeof(WideChar);
    AStream.Write(AValue,vl);
  end;
end;

procedure TVersionInformation.SetFF(const Value: TVersionFileFlags);
var
  f: Cardinal;
begin
  if not Assigned(FHeader) then
    Exit;

  FFF:=Value;

  f:=0;
  if ffDebug in Value then
    f:=f or VS_FF_DEBUG;
  if ffInfoInferred in Value then
    f:=f or VS_FF_INFOINFERRED;
  if ffPatched in Value then
    f:=f or VS_FF_PATCHED;
  if ffPreRelease in Value then
    f:=f or VS_FF_PRERELEASE;
  if ffPrivateBuild in Value then
    f:=f or VS_FF_PRIVATEBUILD;
  if ffSpecialBuild in Value then
    f:=f or VS_FF_SPECIALBUILD;

  if (FHeader^.Version.dwFileFlags and FHeader^.Version.dwFileFlagsMask)<>f then
    FHeader^.Version.dwFileFlags:=(FHeader^.Version.dwFileFlags and not FHeader^.Version.dwFileFlagsMask) or f;

  FModified:=True;
end;

procedure TVersionInformation.SetFilename(const Value: string);
begin
  if SameText(FFilename,Value) then
    Exit;
  FFilename:=Value;
  ReadData;
end;

procedure TVersionInformation.SetFVN(const Value: TVersionNumber);
begin
  if not Assigned(FHeader) then
    Exit;

  FFVN:=Value;

  FHeader^.Version.dwFileVersionMS:=MAKELONG(FFVN.Minor,FFVN.Major);
  FHeader^.Version.dwFileVersionLS:=MAKELONG(FFVN.Build,FFVN.Release);

  FModified:=True;
end;

procedure TVersionInformation.SetProperty(const Index: Integer;
  const Value: string);
var
  s: string;
begin
  if Length(FVI)=0 then
    Exit;
  case Index of
    0: s:='CompanyName';
    1: s:='FileDescription';
    2: s:='FileVersion';
    3: s:='InternalName';
    4: s:='LegalCopyright';
    5: s:='LegalTrademarks';
    6: s:='OriginalFilename';
    7: s:='ProductName';
    8: s:='ProductVersion';
    9: s:='Comments';
  end;
  SetStringFileInfoValue(0,s,Value);
  FModified:=True;
end;

procedure TVersionInformation.SetPVN(const Value: TVersionNumber);
begin
  if not Assigned(FHeader) then
    Exit;

  FPVN:=Value;

  FHeader^.Version.dwProductVersionMS:=MAKELONG(FPVN.Minor,FPVN.Major);
  FHeader^.Version.dwProductVersionLS:=MAKELONG(FPVN.Build,FPVN.Release);

  FModified:=True;
end;

procedure TVersionInformation.SetResLang(const Value: TTranslation);
begin
  if Length(FRL)=0 then
    Exit;
  FRL[0].Lang:=Value.Lang;
  FRL[0].CodePage:=Value.CodePage;
  FModified:=True;
end;

procedure TVersionInformation.SetStringFileInfoValue(AIndex: Integer;
  const AName: string; ANewValue: string);
var
  i: Integer;
  f: Boolean;
begin
  if Length(FVI)=0 then
    Exit;
  f:=False;
  for i:=0 to High(FVI[AIndex].Values) do
    if SameText(FVI[AIndex].Values[i].Name,AName) then begin
      FVI[AIndex].Values[i].Value:=ANewValue;
      FModified:=True;
      f:=True;
      Break;
    end;
  if not f and (ANewValue<>'') then begin
    SetLength(FVI[AIndex].Values,Length(FVI[AIndex].Values)+1);
    FVI[AIndex].Values[High(FVI[AIndex].Values)].Name:=AName;
    FVI[AIndex].Values[High(FVI[AIndex].Values)].Value:=ANewValue;
    FModified:=True;
  end;
end;

procedure TVersionInformation.SetStringFileInfoValue(ATranslation: TTranslation;
  const AName: string; ANewValue: string);
var
  i,j: Integer;
begin
  if Length(FVI)=0 then
    Exit;
  i:=FindTranslation(ATranslation);
  if i>-1 then
    for j:=0 to High(FVI[i].Values) do
      if SameText(FVI[i].Values[j].Name,AName) then begin
        FVI[i].Values[j].Value:=ANewValue;
        FModified:=True;
        Break;
      end;
end;

procedure TVersionInformation.SetTranslation(AIndex: Integer;
  ANew: TTranslation);
begin
  if Length(FVI)=0 then
    Exit;
  FVI[AIndex].Translation:=ANew;
  FModified:=True;
end;

procedure TVersionInformation.SetTransProp(const Value: TTranslation);
begin
  if Length(FVI)=0 then
    Exit;
  FVI[0].Translation:=Value;
  FModified:=True;
end;

end.