Arquivos - executavel obtendo versao e descricao

Top  Previous  Next

// versao, descricao etc... do exe, dll, ocx:

 

const

  VersionInfo: array [1..8of string = (

                                         'CompanyName'   , 'FileDescription' , 'FileVersion''InternalName',

                                         'LegalCopyRight''OriginalFileName''ProductName''ProductVersion');

 

function GetFileInfo(FName, InfoType: string): string;

var

  Info    : Pointer;

  InfoData: Pointer;

  InfoSize: LongInt;

  InfoLen : DWORD;

  DataLen : UInt;

  LangPtr : Pointer;

begin

  Result  := '';

  DataLen := 255;

  if Length(FName) <= 0 then exit;

  FName := FName + #0;

  InfoSize := GetFileVersionInfoSize(@Fname[1], InfoLen);

  if (InfoSize > 0) then

  begin

    GetMem(Info, InfoSize);

    try

      if GetFileVersionInfo(@FName[1], InfoLen, InfoSize, Info) then

      begin

        if VerQueryValue(Info,'\VarFileInfo\Translation',LangPtr, DataLen) then

          InfoType:=Format('\StringFileInfo\%0.4x%0.4x\%s'#0,[LoWord(LongInt(LangPtr^)),

                                                              HiWord(LongInt(LangPtr^)), InfoType]);

        if VerQueryValue(Info,@InfoType[1],InfoData,Datalen) then

          Result := StrPas(InfoData);

      end;

    finally

      FreeMem(Info, InfoSize);

    end;

  end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  Label1.Caption := GetFileInfo('c:\winnt\explorer.exe''FileVersion');

  Label2.Caption := GetFileInfo('c:\DivXc32.dll''FileVersion');

  Label3.Caption := GetFileInfo('c:\DivXc32.dll''FileDescription');

end;