Got an iPhone or iPad? We have a brand new Pastebin App for both devices, and it's totally free! Click here to download the new Pastebin App for iOS.
Public Pastes
Guest

JimmySkull

By: a guest on Jun 19th, 2008  |  syntax: Delphi  |  size: 5.65 KB  |  hits: 40  |  expires: Never
download  |  raw  |  embed  |  report abuse
Copied
  1. // Pegar Informações de um Executável
  2. // http://0x1f.blogspot.com/
  3.  
  4. function FileVerInfo(const FileName: string; var FileInfo: TStringList): Boolean;
  5. // Requer um StringList criado antes de executar a função
  6. // com o nome de StrLst
  7. // StrLst := TStringList.Create;
  8. const
  9.  
  10.   Key: array[1..9] of string = ('CompanyName',
  11.     'FileDescription',
  12.     'FileVersion',
  13.     'InternalName',
  14.     'LegalCopyright',
  15.     'OriginalFilename',
  16.     'ProductName',
  17.     'ProductVersion',
  18.     'Comments');
  19.  
  20.   KeyBr: array[1..9] of string = (
  21.     'Empresa.......',
  22.     'Descricao.....',
  23.     'Versao do Arq.',
  24.     'Nome Interno..',
  25.     'Copyright.....',
  26.     'Nome Original.',
  27.     'Produto.......',
  28.     'Versao do Prod',
  29.     'Comentarios...');
  30. var
  31.   Dummy: THandle;
  32.   BufferSize, Len: Integer;
  33.   Buffer: PChar;
  34.   LoCharSet, HiCharSet: Word;
  35.   Translate, Return: Pointer;
  36.   StrFileInfo, Flags: string;
  37.   TargetOS, TypeArq: string;
  38.   FixedFileInfo: Pointer;
  39.   i: Byte;
  40. begin
  41.   Result := False;
  42.   if not FileExists(FileName) then
  43.   begin
  44.     Result := False;
  45.     exit;
  46.   end;
  47.   BufferSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
  48.   if BufferSize <> 0 then
  49.   begin
  50.     GetMem(Buffer, Succ(BufferSize));
  51.     try
  52.       if GetFileVersionInfo(PChar(FileName), 0, BufferSize, Buffer) then
  53.         if VerQueryValue(Buffer, '\VarFileInfo\Translation', Translate, UINT(Len)) then
  54.         begin
  55.           LoCharSet := LoWord(Longint(Translate^));
  56.           HiCharSet := HiWord(Longint(Translate^));
  57.           for i := 1 to 9 do
  58.           begin
  59.             StrFileInfo := Format('\StringFileInfo\0%x0%x\%s', [LoCharSet, HiCharSet, Key[i]]);
  60.             if VerQueryValue(Buffer, PChar(StrFileInfo), Return, UINT(Len)) then
  61.               FileInfo.Add(KeyBr[i] + ': ' + PChar(Return));
  62.           end;
  63.           if VerQueryValue(Buffer, '\', FixedFileInfo, UINT(Len)) then
  64.             with TVSFixedFileInfo(FixedFileInfo^) do
  65.             begin
  66.               Flags := '';
  67.               if (dwFileFlags and VS_FF_DEBUG) = VS_FF_DEBUG then
  68.                 Flags := Concat(Flags, '*Debug* ');
  69.               if (dwFileFlags and VS_FF_SPECIALBUILD) = VS_FF_SPECIALBUILD then
  70.                 Flags := Concat(Flags, '*Special Build* ');
  71.               if (dwFileFlags and VS_FF_PRIVATEBUILD) = VS_FF_PRIVATEBUILD then
  72.                 Flags := Concat(Flags, '*Private Build* ');
  73.               if (dwFileFlags and VS_FF_PRERELEASE) = VS_FF_PRERELEASE then
  74.                 Flags := Concat(Flags, '*Pre-Release Build* ');
  75.               if (dwFileFlags and VS_FF_PATCHED) = VS_FF_PATCHED then
  76.                 Flags := Concat(Flags, '*Patched* ');
  77.               if Flags <> '' then
  78.                 FileInfo.Add('Atributos..: ' + Flags);
  79.               TargetOS := 'Plataforma(OS): ';
  80.               case dwFileOS of
  81.                 VOS_UNKNOWN: TargetOS := Concat(TargetOS, 'Desconhecido');
  82.                 VOS_DOS: TargetOS := Concat(TargetOS, 'MS-DOS');
  83.                 VOS_OS216: TargetOS := Concat(TargetOS, '16-bit OS/2');
  84.                 VOS_OS232: TargetOS := Concat(TargetOS, '32-bit OS/2');
  85.                 VOS_NT: TargetOS := Concat(TargetOS, 'Windows NT');
  86.                 VOS_NT_WINDOWS32, 4: TargetOS := Concat(TargetOS, 'Win32 API');
  87.                 VOS_DOS_WINDOWS16: TargetOS := Concat(TargetOS, '16-bit Windows ', 'sob MS-DOS');
  88.               else
  89.                 TargetOS := Concat(TargetOS, 'Fora do Padrão. Código: ', IntToStr(dwFileOS));
  90.               end;
  91.               FileInfo.Add(TargetOS);
  92.               TypeArq := 'Tipo de Arq...: ';
  93.               case dwFileType of
  94.                 VFT_UNKNOWN: TypeArq := Concat(TypeArq, 'Desconhecido');
  95.                 VFT_APP: TypeArq := Concat(TypeArq, 'Aplicacao');
  96.                 VFT_DLL: TypeArq := Concat(TypeArq, 'Dynamic-Link Lib.');
  97.                 VFT_DRV:
  98.                   begin
  99.                     TypeArq := Concat(TypeArq, 'Device driver - Driver ');
  100.                     case dwFileSubtype of
  101.                       VFT2_UNKNOWN: TypeArq := Concat(TypeArq, 'Desconhecido');
  102.                       VFT2_DRV_PRINTER: TypeArq := Concat(TypeArq, 'de Impressao');
  103.                       VFT2_DRV_KEYBOARD: TypeArq := Concat(TypeArq, 'de Teclado');
  104.                       VFT2_DRV_LANGUAGE: TypeArq := Concat(TypeArq, 'de Idioma');
  105.                       VFT2_DRV_DISPLAY: TypeArq := Concat(TypeArq, 'de Vídeo');
  106.                       VFT2_DRV_MOUSE: TypeArq := Concat(TypeArq, 'de Mouse');
  107.                       VFT2_DRV_NETWORK: TypeArq := Concat(TypeArq, 'de Rede');
  108.                       VFT2_DRV_SYSTEM: TypeArq := Concat(TypeArq, 'de Sistema');
  109.                       VFT2_DRV_INSTALLABLE: TypeArq := Concat(TypeArq, 'Instalavel');
  110.                       VFT2_DRV_SOUND: TypeArq := Concat(TypeArq, 'Multimida');
  111.                     end;
  112.                   end;
  113.                 VFT_FONT:
  114.                   begin
  115.                     TypeArq := Concat(TypeArq, 'Fonte - Fonte ');
  116.                     case dwFileSubtype of
  117.                       VFT2_UNKNOWN: TypeArq := Concat(TypeArq, 'Desconhecida');
  118.                       VFT2_FONT_RASTER: TypeArq := Concat(TypeArq, 'Raster');
  119.                       VFT2_FONT_VECTOR: TypeArq := Concat(TypeArq, 'Vetorial');
  120.                       VFT2_FONT_TRUETYPE: TypeArq := Concat(TypeArq, 'TrueType');
  121.                     end;
  122.                   end;
  123.                 VFT_VXD: TypeArq := Concat(TypeArq, 'Virtual Device');
  124.                 VFT_STATIC_LIB: TypeArq := Concat(TypeArq, 'Static-Link Lib.');
  125.               end;
  126.               FileInfo.Add(TypeArq);
  127.             end;
  128.         end;
  129.     finally
  130.       FreeMem(Buffer, Succ(BufferSize));
  131.       Result := FileInfo.Text <> '';
  132.     end;
  133.   end;
  134. end;
create a new version of this paste RAW Paste Data