unit getver;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;


{ Record to receive charset }
type TTranslation = record
   langID  : WORD;
   charset  : WORD;
end;

type
  TGetVersionInfoFromFile = class
  private
    FFileName : String;
    FmyVersionStrings : TStringList;
    FmyVersionCategories    : TStringList;

    procedure SetFileName (inp : string);
    procedure dontWrite(inp : TStringList);
    procedure readVersionFromFile;
  protected
    { Protected-Deklarationen}
  public
     procedure Init();
     function getVersionSetting(inp : string): String;
  published
    property fileName : string  read FFileName write SetFileName;
    property VersionStrings  : TStringList  read FmyVersionStrings write dontWrite;
    property VersionCategories : TStringList read FmyVersionCategories write dontWrite;
  end;

var
  fileVer: TGetVersionInfoFromFile;

implementation

{ initialize everything }
Procedure TGetVersionInfoFromFile.Init();
begin
    FmyVersionStrings := TStringList.Create;
    FmyVersionCategories  := TStringList.Create;
    FFileName := '';
end;

{ Get filename, check if file exists and read info from file }
procedure TGetVersionInfoFromFile.SetFileName (inp : string);
begin
    FmyVersionStrings.clear;
    FmyVersionCategories.clear;

    if fileexists(inp) then
    begin
         FFileName := inp;
         readVersionFromFile;
    end
    else
    begin
         FFileName := '';
    end;
end;

{ don磘 do anything }
procedure TGetVersionInfoFromFile.dontWrite(inp : TStringList);
begin
end;

{ read info from file }
procedure TGetVersionInfoFromFile.readVersionFromFile;
var struSize : Dword;
    dwBytes,someDummy : Dword;
    a,txt : array[0..256] of char;
    p : pchar;
    i : integer;
    pp : pointer;
    theFixedInfo : TVSFixedFileInfo;
    theTrans : TTranslation;
    s : string;
    ts  : TStringList;
begin
     ts := TStringList.Create;
     ts.add('CompanyName');
     ts.add('FileDescription');
     ts.add('FileVersion');
     ts.add('InternalName');
     ts.add('LegalCopyright');
     ts.add('OriginalFilename');
     ts.add('ProductName');
     ts.add('ProductVersion');

     strPCopy(a,FFileName);

     { get size of data }
     struSize := GetFileVersionInfoSize(a,someDummy);
     if struSize=0 then exit;
     p := NIL;
     try
       { get memory }
       GetMem(p,struSize+10);
       { get data }
       GetFileVersionInfo(a,0,struSize,p);

       { get root info }
       if not VerQueryValue(p,'\',pp,dwBytes) then exit;
       move(pp^,theFixedInfo,dwBytes);

       { get translation info }
       if not VerQueryValue(p,'\VarFileInfo\Translation',pp,dwBytes) then exit;
       move(pp^,theTrans,dwBytes);

       { iterate over defined items }
       for i:=0 to ts.count-1 do
       begin
         s := '\StringFileInfo\'+inttohex(theTrans.langID,4)+inttohex(theTrans.charset,4)+'\'+ts[i];
         StrPCopy(a,s);
         if not VerQueryValue(p,a,pp,dwBytes) then exit;

         if dwBytes>0 then
         begin
          move(pp^,txt,dwBytes);
          FmyVersionCategories.add(ts[i]);
          FmyVersionStrings.add(StrPas(txt));
         end;
       end;
     finally
       { release memory }
       FreeMem(p);
     end;
end;

{ get single version string }
function TGetVersionInfoFromFile.getVersionSetting(inp : string): String;
var i : integer;
begin
     result := '';
     for i:= 0 to FmyVersionCategories.Count -1 do
     begin
          if lowercase(FmyVersionCategories[i])=lowercase(inp) then
          begin
               result := FmyVersionStrings[i];
               break;
          end;
     end;
end;

end.