unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function PobierzInformacjeOPliku(nazwaPliku :String) :TStrings;
const
  InfoStr : array [1..12] of String =
    ('Comments', 'InternalName', 'ProductName',
     'CompanyName', 'LegalCopyright', 'ProductVersion',
     'FileDescription', 'LegalTrademarks', 'PrivateBuild',
     'FileVersion', 'OriginalFilename', 'SpecialBuild');
var
    i :Cardinal;
    bufor :PChar; rozmiarBufora :Integer;
    wartosc :PChar; rozmiarWartosci :Cardinal;
    jezyk :WORD;
    stronaKodowa :DWORD;
    informacjeOPliku :PVSFixedFileInfo;
    typPliku :String;
begin
Result:=TStringList.Create;
RozmiarBufora:=GetFileVersionInfoSize(PChar(nazwaPliku),i);
if RozmiarBufora>0 then
  begin
  Bufor:=AllocMem(RozmiarBufora);
  GetFileVersionInfo(PChar(nazwaPliku),0,RozmiarBufora,Bufor);
  //ShowMessage('Rozmiar bufora: '+IntToStr(rozmiarBufora));

  if VerQueryValue(Bufor,'\',Pointer(informacjeOPliku),rozmiarWartosci) then
    begin
    case informacjeOPliku.dwFileType of
      VFT_UNKNOWN: typPliku:='Nieznany';
      VFT_APP: typPliku:='Aplikacja';
      VFT_DLL: typPliku:='Biblioteka DLL';
      VFT_STATIC_LIB: typPliku:='Biblioteka ładowana statycznie';
      VFT_DRV:
        case
          informacjeOPliku.dwFileSubtype of
            VFT2_UNKNOWN: typPliku:='Nieznany rodzaj sterownika';
            VFT2_DRV_COMM: typPliku:='Sterownik komunikacyjny';
            VFT2_DRV_PRINTER: typPliku:='Sterownik drukarki';
            VFT2_DRV_KEYBOARD: typPliku:='Sterownik klawiatury';
            VFT2_DRV_LANGUAGE: typPliku:='Sterownik języka';
            VFT2_DRV_DISPLAY: typPliku:='Sterownik karty graficznej';
            VFT2_DRV_MOUSE: typPliku:='Sterownik myszy';
            VFT2_DRV_NETWORK: typPliku:='Sterownik karty sieciowej';
            VFT2_DRV_SYSTEM: typPliku:='Sterownik systemowy';
            VFT2_DRV_INSTALLABLE: typPliku:='Sterownik do instalacji';
            VFT2_DRV_SOUND: typPliku:='Sterownik karty dwiękowej';
        end;
      VFT_FONT:
        case informacjeOPliku.dwFileSubtype of
            VFT2_UNKNOWN: typPliku:='Unknown Font';
            VFT2_FONT_RASTER: typPliku:='Raster Font';
            VFT2_FONT_VECTOR: typPliku:='Vector Font';
            VFT2_FONT_TRUETYPE: typPliku:='Truetype Font';
            else;
        end;
      VFT_VXD: typPliku:='Virtual Defice Identifier = '+IntToHex(informacjeOPliku.dwFileSubtype,8);
    end;
    Result.Add('Typ pliku: '+typPliku);
    end;

  if VerQueryValue(Bufor,'\VarFileInfo\Translation',Pointer(wartosc),rozmiarWartosci) then
    begin
    jezyk:=PWORD(wartosc)^;
    stronaKodowa:=PWORD(wartosc+2)^;
    end
    else
    begin
    jezyk:=0;
    stronaKodowa:=0;
    end;
  Result.Add('Język: '+IntToStr(jezyk)+' ('+IntToHex(jezyk,4)+')');
  Result.Add('Strona kodowa: '+IntToStr(stronaKodowa)+' ('+IntToHex(stronaKodowa,4)+')');

  for i:=Low(InfoStr) to High(InfoStr) do //od pierwszego do ostatniego indeksu tablicy
    begin
    //ShowMessage(PChar('\StringFileInfo\'+IntToHex(jezyk,4)+IntToHex(stronaKodowa,4)+'\'+InfoStr[i]));
    if VerQueryValue(Bufor,
                     PChar('\StringFileInfo\'+
                           IntToHex(jezyk,4)+
                           IntToHex(stronaKodowa,4)+
                           '\'+InfoStr[i]),
                     Pointer(wartosc),
                     rozmiarWartosci) then
      Result.Add(InfoStr[i]+': '+wartosc);
    end;
  FreeMem(Bufor,RozmiarBufora);
  end
  else ShowMessage('Brak informacji o wersji pliku');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
Edit1.Text:=Application.ExeName;
Memo1.Lines.AddStrings(PobierzInformacjeOPliku(Edit1.Text));
end;

procedure TForm1.Button1Click(Sender: TObject);
var OpenDialog :TOpenDialog;
begin
OpenDialog:=TOpenDialog.Create(Self);
OpenDialog.FileName:=Edit1.Text;
if OpenDialog.Execute then Edit1.Text:=OpenDialog.FileName;
OpenDialog.Free;

Memo1.Clear;
Memo1.Lines.AddStrings(PobierzInformacjeOPliku(Edit1.Text));
end;

end.
