Wersja aplikacji do zmiennej

{
Usage:
VersionInformation(ListBox1)
}

{Pads or truncates a String and
Justifies Left if StrJustify=True}
Function StringPad(
   InputStr,
   FillChar: String;
   StrLen: Integer;
   StrJustify: Boolean): String;
Var
   TempFill: String;
   Counter : Integer;
Begin
   If Not (Length(InputStr) = StrLen) Then
   Begin
     If Length(InputStr) > StrLen Then
     Begin
       InputStr := Copy(InputStr,1,StrLen) ;
     End
     Else
     Begin
       TempFill := '';
       For Counter := 1 To StrLen-Length(InputStr) Do
       Begin
         TempFill := TempFill + FillChar;
       End;
       If StrJustify Then
       Begin
         {Left Justified}
         InputStr := InputStr + TempFill;
       End
       Else
       Begin
         {Right Justified}
         InputStr := TempFill + InputStr ;
       End;
     End;
   End;
   Result := InputStr;
End;


Function VersionInformation(
   ListBox : TListBox): Boolean;
const
   InfoNum = 11;
   InfoStr : array [1..InfoNum] of String =
     ('CompanyName', 'FileDescription', 'FileVersion',
'InternalName', 'LegalCopyright', 'LegalTradeMarks',
'OriginalFilename', 'ProductName', 'ProductVersion',
'Comments', 'Author') ;
   LabelStr : array [1..InfoNum] of String =
     ('Company Name', 'Description', 'File Version',
'Internal Name', 'Copyright', 'TradeMarks',
'Original File Name', 'Product Name',
'Product Version', 'Comments', 'Author') ;
var
  S : String;
    j : Integer;
   Len, n: Cardinal;
   Buf : PChar;
   Value : PChar;
begin
   Try
     S := Application.ExeName;
     ListBox.Items.Clear;  <-----------------------  Tu wywala błąd
     ListBox.Sorted := True;
     ListBox.Font.Name := 'Courier New';
     n := GetFileVersionInfoSize(PChar(S),n) ;
     If n > 0 Then Begin
       Buf := AllocMem(n) ;
       ListBox.Items.Add
(StringPad('Size',' ',20,True)+' = '+IntToStr(n)) ;
       GetFileVersionInfo(PChar(S),0,n,Buf) ;
       For j:=1 To InfoNum Do Begin
         If VerQueryValue(Buf,PChar('StringFileInfo\040904E4\'+
                           InfoStr[j]),Pointer(Value),Len) Then
         Begin
           Value := PChar(Trim(Value)) ;
           If Length(Value) > 0 Then
           Begin
             ListBox.Items.Add
(StringPad(labelStr,' ',20,True)+' = '+Value) ;
           End;
         End;
       End;
       FreeMem(Buf,n) ;
     End
     Else Begin
       ListBox.Items.Add
('No FileVersionInfo found') ;
     End;
     Result := True;
   Except
     Result := False;
   End;
End;

procedure GetBuildInfo(var V1, V2, V3, V4: word);
var
  VerInfoSize, VerValueSize, Dummy: DWORD;
  VerInfo: Pointer;
  VerValue: PVSFixedFileInfo;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  if VerInfoSize > 0 then
  begin
      GetMem(VerInfo, VerInfoSize);
      try
        if GetFileVersionInfo(PChar(sFileName), 0, VerInfoSize, VerInfo) then
        begin
          VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
          with VerValue^ do
          begin
            V1 := dwFileVersionMS shr 16;
            V2 := dwFileVersionMS and $FFFF;
            V3 := dwFileVersionLS shr 16;
            V4 := dwFileVersionLS and $FFFF;
          end;
        end;
      finally
        FreeMem(VerInfo, VerInfoSize);
      end;
  end;
end;

const
  IV_CompanyName      = 0;
  IV_FileDescription  = 1;
  IV_FileVersion      = 2;
  IV_InternalName     = 3;
  IV_LegalCopyRight   = 4;
  IV_LegalTradeMark   = 5;
  IV_OriginalFileName = 6;
  IV_ProductName      = 7;
  IV_ProductVersion   = 8;
  IV_Comments         = 9;

function GetAppVersionInfo(const FileName: String; InfoValue: Byte): String;
var
  VerSize: Integer;
  VerBuf: PChar;
  VerBufValue: Pointer;
  VerHandle: Cardinal;
  VerBufLen: Cardinal;
  VerKey: String;

  function GetInfo(ThisKey: String): String;
  begin
    Result := '';
    VerKey := '\StringFileInfo\' + IntToHex(LoWord(Integer(VerBufValue^)), 4) +
               IntToHex(HiWord(Integer(VerBufValue^)), 4) + '\' + ThisKey;

    if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then
      Result := StrPas(VerBufValue);
  end;

  function QueryValue(ThisValue: string): string;
  begin
    Result := '';

    if GetFileVersionInfo(PChar(FileName), VerHandle, VerSize, VerBuf) and
       VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, VerBufLen) then
         Result := GetInfo(ThisValue);
  end;

begin
  VerSize := GetFileVersionInfoSize(PChar(FileName), VerHandle);
  VerBuf := AllocMem(VerSize);
  
  try
    case InfoValue of
      IV_CompanyName:      Result := QueryValue('CompanyName');
      IV_FileDescription:  Result := QueryValue('FileDescription');
      IV_FileVersion:      Result := QueryValue('FileVersion');
      IV_InternalName:     Result := QueryValue('InternalName');
      IV_LegalCopyRight:   Result := QueryValue('LegalCopyRight');
      IV_LegalTradeMark:   Result := QueryValue('LegalTradeMark');
      IV_OriginalFileName: Result := QueryValue('OriginalFileName');
      IV_ProductName:      Result := QueryValue('ProductName');
      IV_ProductVersion:   Result := QueryValue('ProductVersion');
      IV_Comments:         Result := QueryValue('Comments');
    end;
  finally
    FreeMem(VerBuf, VerSize);
  end;
end;

void GetAppVersion(DWORD &V1, DWORD &V2, DWORD &V3, DWORD &V4)
{
   //give your application full path
   LPTSTR lpszFilePath = g_CmdLine;

   DWORD dwDummy;
   DWORD dwFVISize = GetFileVersionInfoSize( lpszFilePath , &dwDummy );

   LPBYTE lpVersionInfo = new BYTE[dwFVISize];

   GetFileVersionInfo( lpszFilePath , 0 , dwFVISize , lpVersionInfo );

   UINT uLen;
   VS_FIXEDFILEINFO *lpFfi;

   VerQueryValue( lpVersionInfo , _T("\\") , (LPVOID *)&lpFfi , &uLen );

   DWORD dwFileVersionMS = lpFfi->dwFileVersionMS;
   DWORD dwFileVersionLS = lpFfi->dwFileVersionLS;

   delete [] lpVersionInfo;

   V1 = HIWORD(dwFileVersionMS);
   V2 = LOWORD(dwFileVersionMS);
   V3 = HIWORD(dwFileVersionLS);
   V4 = LOWORD(dwFileVersionLS);
}

program qwer;
const
  version = '1.2.3.4';
begin
end.