Obter Informações sobre arquivo

Var
  StrLst : TStringList;
begin
StrLst := TStringList.Create;

FileVerInfo(Application.ExeName,StrLst);
RichEditSobre.Lines := StrLst;

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......´,
  ´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;