1 reply to this topic

[FilNet]

Por exemplo, selecione o arquivo .exe que o programa mostra a versão do arquivo.
Funciona tipo a opção propriedades que aparece quando clicado com botão direito em cima de um arquivo no Windows.

Alguem tem função parecida que possa compartilhar??

Obrigado,

[feubr]

Ae, abaixo o código fonte. Retirado do Dicas e Truques Delphi V 2.6. Se vc não tiver essas dicas eu te mando.

Abraços.

Pegar informações de Executavel
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;