Ne se samnqvam , che kakto kaza Pechenia nqma da imash problem s VB-to , no mislq che tozi primer sahsto ne e losh, makar , che tozi nachin na pisane na funkcii v drugi funkcii ne go obicham.

 



unit verinfo;



interface





type

  TFileVersionInfo = record

    fCompanyName,

    fFileDescription,

    fFileVersion,

    fInternalName,

    fLegalCopyRight,

    fLegalTradeMark,

    fOriginalFileName,

    fProductName,

    fProductVersion,

    fComments: string;

  end;



procedure GetAppVersionInfo(sAppNamePath: string);



var

  FileVersionInfo: TFileVersionInfo;



implementation

uses

  Windows, SysUtils, Forms;



procedure GetAppVersionInfo(sAppNamePath: string);

{ sAppNamePath must specify full path and file name, if sAppNamePath       }

{ is empty then the current running app is used.                           } 

var

  VerSize: integer;

  VerBuf: PChar;

  VerBufValue: pointer;

  VerHandle: cardinal;

  VerBufLen: cardinal;

  VerKey: string;



  function GetInfo(ThisKey: string): string;

  begin

    Result := '';

    VerKey := '\StringFileInfo\' + IntToHex(loword(integer(VerBufValue^)), 4) +

    IntToHex(hiword(integer(VerBufValue^)), 4) + '\' + ThisKey; 

    if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then

      Result := StrPas(VerBufValue);

  end;



  function QueryValue(ThisValue: string): string;

  begin

    Result := '';

    if GetFileVersionInfo(PChar(sAppNamePath), VerHandle, VerSize, VerBuf) and

      VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, VerBufLen) then

      Result := GetInfo(ThisValue);

  end;



begin

  if sAppNamePath = '' then

    sAppNamePath := Application.ExeName;

  VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);

  VerBuf := AllocMem(VerSize);

  try

    FileVersionInfo.fCompanyName      := QueryValue('CompanyName'); 

    FileVersionInfo.fFileDescription  := QueryValue('FileDescription');

    FileVersionInfo.fFileVersion      := QueryValue('FileVersion'); 

    FileVersionInfo.fInternalName     := QueryValue('InternalName'); 

    FileVersionInfo.fLegalCopyRight   := QueryValue('LegalCopyRight');

    FileVersionInfo.fLegalTradeMark   := QueryValue('LegalTradeMark');

    FileVersionInfo.fOriginalFileName := QueryValue('OriginalFileName');

    FileVersionInfo.fProductName      := QueryValue('ProductName'); 

    FileVersionInfo.fProductVersion   := QueryValue('ProductVersion');

    FileVersionInfo.fComments         := QueryValue('Comments');

  finally

    FreeMem(VerBuf, VerSize);

  end;

end;



end.