-= Версия файла =- [D7, Win95/98, WinME, Win2k, WinXP]
WST © (2006-01-23 20:41:00)
Есть кусок кода извлекающий версию файла, производителя и т.д.
Но он у меня работает только с exe, а dll например не хочет
использовать, может чего не так, исправте, плз!!!
uses
Windows, SysUtils, Classes, ShellApi;
type
TFileVersionInfo = record
FileType,
CompanyName,
FileDescription,
FileVersion,
InternalName,
LegalCopyRight,
LegalTradeMarks,
OriginalFileName,
ProductName,
ProductVersion,
Comments,
SpecialBuildStr,
PrivateBuildStr,
FileFunction : string;
DebugBuild,
PreRelease,
SpecialBuild,
PrivateBuild,
Patched,
InfoInferred : Boolean;
end;
{$R *.res}
function FileVersionInfo(const sAppNamePath: TFileName):
TFileVersionInfo;
var
rSHFI: TSHFileInfo;
iRet: Integer;
VerSize: Integer;
VerBuf: PChar;
VerBufValue: Pointer;
VerHandle: Cardinal;
VerBufLen: Cardinal;
VerKey: string;
FixedFileInfo: PVSFixedFileInfo;
//================================================================
function GetFileSubType(FixedFileInfo:
PVSFixedFileInfo) : string;
begin
case FixedFileInfo.dwFileType of
VFT_UNKNOWN: Result := 'Unknown';
VFT_APP: Result := 'Application';
VFT_DLL: Result := 'DLL';
VFT_STATIC_LIB: Result := 'Static-link
Library';
VFT_DRV:
case
FixedFileInfo.dwFileSubtype
of
VFT2_UNKNOWN: Result :=
'Unknown Driver';
VFT2_DRV_COMM: Result :=
'Communications Driver';
VFT2_DRV_PRINTER: Result :=
'Printer Driver';
VFT2_DRV_KEYBOARD: Result
:= 'Keyboard Driver';
VFT2_DRV_LANGUAGE: Result
:= 'Language Driver';
VFT2_DRV_DISPLAY: Result :=
'Display Driver';
VFT2_DRV_MOUSE: Result :=
'Mouse Driver';
VFT2_DRV_NETWORK: Result :=
'Network Driver';
VFT2_DRV_SYSTEM: Result :=
'System Driver';
VFT2_DRV_INSTALLABLE:
Result := 'InstallableDriver';
VFT2_DRV_SOUND: Result :=
'Sound Driver';
end;
VFT_FONT:
case FixedFileInfo.dwFileSubtype
of
VFT2_UNKNOWN: Result :=
'Unknown Font';
VFT2_FONT_RASTER: Result :=
'Raster Font';
VFT2_FONT_VECTOR: Result :=
'Vector Font';
VFT2_FONT_TRUETYPE: Result
:='Truetype Font';
else;
end;
VFT_VXD: Result :='Virtual Defice
Identifier = ' +
IntToHex(FixedFileInfo.dwFileSubtype, 8);
end;
end;
//======================================================
function HasdwFileFlags(FixedFileInfo:
PVSFixedFileInfo;
Flag : Word) : Boolean;
begin
Result := (FixedFileInfo.dwFileFlagsMask and
FixedFileInfo.dwFileFlags and
Flag) = Flag;
end;
//======================================================
function GetFixedFileInfo: PVSFixedFileInfo;
begin
if not VerQueryValue(VerBuf, '',
Pointer(Result), VerBufLen) then
Result := nil
end;
//======================================================
function GetInfo(const aKey: string): string;
begin
Result := '';
VerKey := Format('\StringFileInfo\%.4x%.4x\%s',
[LoWord(Integer(VerBufValue^)),
HiWord(Integer(VerBufValue^)), aKey]);
if VerQueryValue(VerBuf,
PChar(VerKey),VerBufValue,VerBufLen) then
Result := StrPas(VerBufValue);
end;
//======================================================
function QueryValue(const aValue: string): string;
begin
Result := '';
if GetFileVersionInfo(PChar(sAppNamePath),
VerHandle,
VerSize, VerBuf) and
VerQueryValue(VerBuf,
'\VarFileInfo\Translation',
VerBufValue, VerBufLen) then
Result := GetInfo(aValue);
end;
//======================================================
begin
with Result do
begin
FileType := '';
CompanyName := '';
FileDescription := '';
FileVersion := '';
InternalName := '';
LegalCopyRight := '';
LegalTradeMarks := '';
OriginalFileName := '';
ProductName := '';
ProductVersion := '';
Comments := '';
SpecialBuildStr:= '';
PrivateBuildStr := '';
FileFunction := '';
DebugBuild := False;
Patched := False;
PreRelease:= False;
SpecialBuild:= False;
PrivateBuild:= False;
InfoInferred := False;
end;
if SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI,
SizeOf(rSHFI),
SHGFI_TYPENAME) <> 0 then
begin
Result.FileType := rSHFI.szTypeName;
end;
iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI,
SizeOf(rSHFI), SHGFI_EXETYPE);
if iRet <> 0 then
begin
VerSize :=
GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);
if VerSize > 0 then
begin
VerBuf := AllocMem(VerSize);
try
with Result do
begin
CompanyName
:= QueryValue('CompanyName');
FileDescription :=
QueryValue('FileDescription');
FileVersion
:= QueryValue('FileVersion');
InternalName
:= QueryValue('InternalName');
LegalCopyRight :=
QueryValue('LegalCopyRight');
LegalTradeMarks :=
QueryValue('LegalTradeMarks');
OriginalFileName :=
QueryValue('OriginalFileName');
ProductName
:= QueryValue('ProductName');
ProductVersion :=
QueryValue('ProductVersion');
Comments
:= QueryValue('Comments');
SpecialBuildStr :=
QueryValue('SpecialBuild');
PrivateBuildStr :=
QueryValue('PrivateBuild');
//= fill the
VS_FIXEDFILEINFO ==========================
FixedFileInfo
:= GetFixedFileInfo;
DebugBuild
:= HasdwFileFlags(FixedFileInfo,VS_FF_DEBUG);
PreRelease
:= HasdwFileFlags(FixedFileInfo,VS_FF_PRERELEASE);
PrivateBuild
:= HasdwFileFlags(FixedFileInfo,VS_FF_PRIVATEBUILD);
SpecialBuild
:= HasdwFileFlags(FixedFileInfo,VS_FF_SPECIALBUILD);
Patched
:= HasdwFileFlags(FixedFileInfo,VS_FF_PATCHED);
InfoInferred
:= HasdwFileFlags(FixedFileInfo,VS_FF_INFOINFERRED);
FileFunction
:= GetFileSubType(FixedFileInfo);
end;
finally
FreeMem(VerBuf, VerSize);
end
end;
end
end;
function GetFileVersionInfo(AFile: String): TFileVersionInfo;
stdcall;
const
Tabulator: array[0..0] of Integer = (70);
BoolValues: array[Boolean] of string = ('No', 'Yes');
begin
Result := FileVersionInfo(AFile);
// ListBox1.TabWidth := 1;
// SendMessage(ListBox1.Handle, LB_SETTABSTOPS, 1,
Longint(@Tabulator));
end;
begin...end (2006-01-23 22:10:00) [1]
Всё не проверял, но одну ошибку нашёл:
> iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI,
> SizeOf(rSHFI), SHGFI_EXETYPE);
> if iRet <> 0 then
Во-первых, SHGFI_EXETYPE в качестве параметра будет приводить
к неудаче вызова SHGetFileInfo для любого файла, отличного от EXE,
так что на этом функция FileVersionInfo завершится. Во-вторых,
зачем вообще нужен этот повторный вызов функции SHGetFileInfo? Для
EXE-файла она возвратит в iRet тип исполняемого файла, но Вы это,
вроде, нигде не сохраняете и не используете. Думаю, повторный вызов
и if надо убрать.
Наверх 
ЧАТ |
Орешник |
|
