How to implement FileVerInfo
lazarus / 7-LCL

----------------------------------------------------------------------
laurologx · 2008-05-12 13:38

How to implement the function FileVerInfo below in Lazarus?
This function already works in Delphi.

The Lazarus function has to be multi platform!

The mean problem is how to implement in Lazarus equivalent functions
to:
GetFileVersionInfoSize
GetFileVersionInfo
VerQueryValue
TVSFixedFileInfo

Ideas?

Code: [Select]function FileVerInfo(const FileName: string;var
FileInfo: TStringList): Boolean;
const
Key: array[1..9] of string =('CompanyName',
 'FileDescription',
 'FileVersion',
 'InternalName',
 'LegalCopyright',
 'OriginalFilename',
 'ProductName',
 'ProductVersion',
 'Comments');

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;

----------------------------------------------------------------------
Phil · 2008-05-12 14:40

Quote from: "laurologx"How to implement the function FileVerInfo below
in Lazarus?
This function already works in Delphi.

The Lazarus function has to be multi platform!

The mean problem is how to implement in Lazarus equivalent functions
to:
GetFileVersionInfoSize
GetFileVersionInfo
VerQueryValue
TVSFixedFileInfo

Ideas?



Those are all Win API functions and there's no equivalent on OS X or
Linux. What I do is just put the version information into an INI file
and give it .version extension, then distribute this file with the
executable. Easy to read and implement.

Thanks.

-Phil

----------------------------------------------------------------------
laurologx · 2008-05-12 16:13

Ok. Thank you Phil.
I saw this possibility before create this topic.
But the problem is:
How to retrieve information from an executable file if was not you
that made it?

Thanks

----------------------------------------------------------------------
pospec4444 · 2008-07-11 12:03

Isn't there any way how to call Win API functions? Even if it should
be compiled only for Win 32, of course...

I need to retrieve information from 3rd party executable too  :|

----------------------------------------------------------------------
tech-pro · 2008-07-11 21:25

Yes of course you can call Win API functions. You just have to include
the Windows unit.

----------------------------------------------------------------------
pospec4444 · 2008-07-15 11:06

OK, OK, so me and laurologx can solve it the same way we did it in
Delphi? (GetFileVersionInfoSize -> GetFileVersionInfo ->
VerQueryValue)