Conseguir Datos de la aplicacion.

[ErenioDhG]

De todas las funciones que he encontrado en internet solo me dan el FileDescription y FileVersion necesito una funcion que me permita visualizar los otros:
CompanyName
InternalName
LegalCopyright
LegalTrademarks
OriginalFilename
ProductName
ProductVersion
Comments
Espero que puedas ayudarme o darme una idea de como hacerlo.
De todas las funciones que he conseguido solo puedo adquirir el FileDescription y fileVersion.

[[maeyanes]]

Prueba con este procedimiento:

Código Delphi [-]

type
  TAppVerInfo = record
    Comments: string;
    CompanyName: string;
    FileDescription: string;
    FileVersion: string;
    LegalCopyright: string;
    LegalTrademarks: string;
    ProductName: string;
    ProductVersion: string;
  end;

procedure GetAppVersionInfo(var AppVerInfo: TAppVerInfo);
const
  VARFILEINFO = '\\VarFileInfo\Translation';

var
  Size: Cardinal;
  Handle: Cardinal;
  BufferLen: Cardinal;
  Tbl: Cardinal;
  Data: Pointer;
  Buffer: Pointer;
  StrTbl: string;
  LangCharSetIDArray: array [1..2] of Word;

  function GetValueInfo(AValue: string): string;
  var
    StringFileInfo: string;

  begin
    StringFileInfo := Format('\\StringFileInfo\%s\%s', [StrTbl, AValue]);
    VerQueryValue(Data, PChar(StringFileInfo), Buffer, BufferLen);
    Result := PChar(Buffer)
  end;

begin
  Size := GetFileVersionInfoSize(PChar(Application.ExeName), Handle);
  GetMem(Data, Size + 1);
  try
    if GetFileVersionInfo(PChar(Application.ExeName), Handle, Size, Data) then
      if VerQueryValue(Data, VARFILEINFO, Buffer, BufferLen) then
      begin
        LangCharSetIDArray[1] := LoWord(PLongint(Buffer)^);
        LangCharSetIDArray[2] := HiWord(PLongint(Buffer)^);
        Tbl := (LangCharSetIDArray[1] shl 16) or LangCharSetIDArray[2];
        StrTbl := Format('%x', [Tbl]);
        if Length(StrTbl) < 8 then
          StrTbl := '0' + StrTbl;
        with AppVerInfo do
        begin
          Comments := GetValueInfo('Comments');
          CompanyName := GetValueInfo('CompanyName');
          FileDescription := GetValueInfo('FileDescription');
          FileVersion := GetValueInfo('FileVersion');
          LegalCopyright := GetValueInfo('LegalCopyright');
          LegalTrademarks := GetValueInfo('LegalTrademarks');
          ProductName := GetValueInfo('ProductName');
          ProductVersion := GetValueInfo('ProductVersion')
        end
      end
  finally
    FreeMem(Data, Size + 1)
  end
end;

Si necesitas el dato InternalName, solo agregalo al tipo registro y agrega la línea en el procedimiento.


Saludos...