Fórum Versão do Sistema #366544

function FileVerInfo(const FileName: string;var FileInfo: TStringList): Boolean;
//
// Obtem diversas informações de um arquivo executável
//
// Requer um StringList criado antes de executar a função
// deve ser declarado na clausula Var no inicio da Unit
// StrLst := TStringList.Create;
//
//
const
 
Key: array[1..9] of string =(´CompanyName´,
  ´FileDescription´,
  ´FileVersion´,
  ´InternalName´,
  ´LegalCopyright´,
  ´OriginalFilename´,
  ´ProductName´,
  ´ProductVersion´,
  ´Comments´);
 
KeyBr: array [1..9] of string = (´Empresa..........................´,
  ´Descricao........................´,
  ´Versao do Arquivo...........´,
  ´Nome Interno...................´,
  ´Copyright..........................´,
  ´Nome Original do Arquivo.´,
  ´Produto.............................´,
  ´Versao do Produto............´,
  ´Comentarios...............:´);
var
  Dummy : THandle;
  BufferSize, Len : Integer;
  Buffer : PChar;
  LoCharSet, HiCharSet : Word;
  Translate, Return : Pointer;
  StrFileInfo, Flags : string;
  TargetOS, TypeArq : string;
  FixedFileInfo : Pointer;
  i : Byte;
begin
Result := False;
If not FileExists(FileName) then
  begin
  showmessage(´Arquivo não encontrado´);
  Result := False;
  exit;
  end;
BufferSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
if BufferSize <> 0 then
  begin
  GetMem(Buffer, Succ(BufferSize));
  try
  if GetFileVersionInfo(PChar(FileName), 0, BufferSize,Buffer) then
  begin
  if VerQueryValue(Buffer, ´\VarFileInfo\Translation´, Translate, UINT(Len)) then
  begin
  LoCharSet := LoWord(Longint(Translate^));
  HiCharSet := HiWord(Longint(Translate^));
  for i := 1 to 9 do
  begin
  StrFileInfo := Format(´\StringFileInfo\0¬x0¬x\¬s´,[LoCharSet, HiCharSet, Key[i]]);
  if VerQueryValue(Buffer,PChar(StrFileInfo), Return,UINT(Len)) then
  begin
  FileInfo.Add(KeyBr[i] + ´: ´ + PChar(Return));
  end;
  end;
  if VerQueryValue(Buffer,´\´,FixedFileInfo, UINT(Len)) then
  with TVSFixedFileInfo(FixedFileInfo^) do
  begin
  Flags := ´´;
  if (dwFileFlags and VS_FF_DEBUG) = VS_FF_DEBUG then
  begin
  Flags := Concat(Flags,´*Debug* ´);
  end;
  if (dwFileFlags and VS_FF_SPECIALBUILD) = VS_FF_SPECIALBUILD then
  begin
  Flags := Concat(Flags, ´*Special Build* ´);
  end;
  if (dwFileFlags and VS_FF_PRIVATEBUILD) = VS_FF_PRIVATEBUILD then
  begin
  Flags := Concat(Flags, ´*Private Build* ´);
  end;
  if (dwFileFlags and VS_FF_PRERELEASE) = VS_FF_PRERELEASE then
  begin
  Flags := Concat(Flags, ´*Pre-Release Build* ´);
  end;
  if (dwFileFlags and VS_FF_PATCHED) = VS_FF_PATCHED then
  begin
  Flags := Concat(Flags, ´*Patched* ´);
  end;
  if Flags <> ´´ then
  begin
  FileInfo.Add(´Atributos: ´ + Flags);
  end;
  TargetOS := ´Plataforma (OS): ´;
  case dwFileOS of
  VOS_UNKNOWN : TargetOS := Concat(TargetOS, ´Desconhecido´);
  VOS_DOS : TargetOS := Concat(TargetOS, ´MS-DOS´);
  VOS_OS216 : TargetOS := Concat(TargetOS, ´16-bit OS/2´);
  VOS_OS232 : TargetOS := Concat(TargetOS, ´32-bit OS/2´);
  VOS_NT : TargetOS := Concat(TargetOS, ´Windows NT´);
  VOS_NT_WINDOWS32, 4: TargetOS := Concat(TargetOS, ´Win32 API´);
  VOS_DOS_WINDOWS16: TargetOS := Concat(TargetOS, ´16-bit Windows ´,´sob MS-DOS´);
  else
  TargetOS := Concat(TargetOS, ´Fora do Padrão. Código: ´, IntToStr(dwFileOS));
  end;
  FileInfo.Add(TargetOS);
  TypeArq := ´Tipo de Arquivo: ´;
  case dwFileType of
  VFT_UNKNOWN : TypeArq := Concat(TypeArq,´Desconhecido´);
  VFT_APP : TypeArq := Concat(TypeArq,´Aplicacao´);
  VFT_DLL : TypeArq := Concat(TypeArq,´Dynamic-Link Lib.´);
  VFT_DRV : begin
  TypeArq := Concat(TypeArq,´Device driver - Driver ´);
  case dwFileSubtype of
  VFT2_UNKNOWN : TypeArq := Concat(TypeArq,´Desconhecido´);
  VFT2_DRV_PRINTER : TypeArq := Concat(TypeArq,´de Impressao´);
  VFT2_DRV_KEYBOARD : TypeArq := Concat(TypeArq,´de Teclado´);
  VFT2_DRV_LANGUAGE : TypeArq := Concat(TypeArq,´de Idioma´);
  VFT2_DRV_DISPLAY : TypeArq := Concat(TypeArq,´de Vídeo´);
  VFT2_DRV_MOUSE : TypeArq := Concat(TypeArq,´de Mouse´);
  VFT2_DRV_NETWORK : TypeArq := Concat(TypeArq,´de Rede´);
  VFT2_DRV_SYSTEM : TypeArq := Concat(TypeArq,´de Sistema´);
  VFT2_DRV_INSTALLABLE : TypeArq := Concat(TypeArq,´Instalavel´);
  VFT2_DRV_SOUND : TypeArq := Concat(TypeArq,´Multimida´);
  end;
  end;
  VFT_FONT : begin
  TypeArq := Concat(TypeArq,´Fonte - Fonte ´);
  case dwFileSubtype of
  VFT2_UNKNOWN : TypeArq := Concat(TypeArq, ´Desconhecida´);
  VFT2_FONT_RASTER : TypeArq := Concat(TypeArq,´Raster´);
  VFT2_FONT_VECTOR : TypeArq := Concat(TypeArq,´Vetorial´);
  VFT2_FONT_TRUETYPE : TypeArq := Concat(TypeArq,´TrueType´);
  end;
  end;
  VFT_VXD : TypeArq := Concat(TypeArq,´Virtual Device´);
  VFT_STATIC_LIB: TypeArq := Concat(TypeArq,´Static-Link Lib.´);
  end;
  FileInfo.Add(TypeArq);
  end;
  end;
  end;
  finally
  FreeMem(Buffer, Succ(BufferSize));
  Result := FileInfo.Text <> ´´;
  end;
  end;
end;

Function TForm1.RetornaVersaoSistema(Arquivo: String): String;
//Retorna a versão do arquivo passado como parâmetro...
Var
  Dummy : THandle;
  BufferSize, Len : Integer;
  Buffer : PChar;
  LoCharSet, HiCharSet : Word;
  Translate, Return : Pointer;
  StrFileInfo, Flags : string;
begin

  Result := ´´;
  If Not FileExists(Arquivo) Then
  Begin
    ShowMessage(´Arquivo não encontrado.´);
    Result := ´´;
    Exit;
  End;

  BufferSize := GetFileVersionInfoSize(PChar(Arquivo), Dummy);
  If BufferSize <> 0 then
  Begin
    GetMem(Buffer, Succ(BufferSize));
    Try
      If GetFileVersionInfo(PChar(Arquivo), 0, BufferSize, Buffer) then
      Begin
        If VerQueryValue(Buffer, ´\VarFileInfo\Translation´, Translate, UINT(Len)) then
        begin
          LoCharSet := LoWord(Longint(Translate^));
          HiCharSet := HiWord(Longint(Translate^));
          //Pega a versão...
          StrFileInfo := Format(´\StringFileInfo\0¬x0¬x\¬s´,[LoCharSet, HiCharSet, ´FileVersion´]);
          If VerQueryValue(Buffer,PChar(StrFileInfo), Return,UINT(Len)) then
          begin
            Result := PChar(Return);
          end;
        End;
      End;
    Finally
      FreeMem(Buffer, Succ(BufferSize));
    End;
  End;
End;

Label1.Caption := RetornaVersaoSistema(Application.ExeName);
//Nesse caso o label1 terá o seu caption setado para o valor 
//retornado pela função, que é a versão do seu aplicativo.