uses 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;
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;
// dwFileType, dwFileSubtype function GetFileSubType(FixedFileInfo: PVSFixedFileInfo) : string;
begincase 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;
beginifnot VerQueryValue(VerBuf, '', Pointer(Result), VerBufLen) then
Result := nilend;
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 := '';
// obtain version information about the specified file if GetFileVersionInfo(PChar(sAppNamePath), VerHandle,
VerSize, VerBuf) and// return selected version information
VerQueryValue(VerBuf, '\VarFileInfo\Translation',
VerBufValue, VerBufLen) then
Result := GetInfo(aValue);
end;
begin// Initialize the Result with Result dobegin
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;
// Get the file type if SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI),
SHGFI_TYPENAME) <> 0 thenbegin
Result.FileType := rSHFI.szTypeName;
end;
iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI,
SizeOf(rSHFI), SHGFI_EXETYPE);
if iRet <> 0 thenbegin// determine whether the OS can obtain version information
VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);
if VerSize > 0 thenbegin
VerBuf := AllocMem(VerSize);
trywith Result dobegin
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 structure
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);
endend;
endend;
// Test it: procedure TForm1.Button1Click(Sender: TObject);
var
FvI: TFileVersionInfo;
const
Tabulator: array[0..0] of Integer = (70);
BoolValues: array[Boolean] ofstring = ('No', 'Yes');
begin
FvI := FileVersionInfo('C:\FileName.exe');
ListBox1.TabWidth := 1;
SendMessage(ListBox1.Handle, LB_SETTABSTOPS, 1, Longint(@Tabulator));
with FvI, ListBox1.Items dobegin
Add('FileType:'#9 + FileType);
Add('CompanyName:'#9 + CompanyName);
Add('CompanyName:'#9 + FileDescription);
Add('FileVersion:'#9 + FileVersion);
Add('InternalName:'#9 + InternalName);
Add('LegalCopyRight:'#9 + LegalCopyRight);
Add('LegalTradeMarks:'#9 + LegalTradeMarks);
Add('OriginalFileName:'#9 + OriginalFileName);
Add('ProductName:'#9 + ProductName);
Add('ProductVersion:'#9 + ProductVersion);
Add('SpecialBuildStr:'#9 + SpecialBuildStr);
Add('PrivateBuildStr:'#9 + PrivateBuildStr);
Add('FileFunction:'#9 + FileFunction);
Add('DebugBuild:'#9 + BoolValues[DebugBuild]);
Add('PreRelease:'#9 + BoolValues[PreRelease]);
Add('PrivateBuild:'#9 + BoolValues[PrivateBuild]);
Add('SpecialBuild:'#9 + BoolValues[SpecialBuild]);
end;
end;
Программа на языке Delphi для извлечения информации о версии файла. Структура TFileVersionInfo содержит различные поля для хранения полученной информации.
Вот разбивка кода:
Структуры и функции: Структура TSHFileInfo представляет информацию о файле, а функции GetFileSubType, HasdwFileFlags и GetFixedFileInfo используются для извлечения конкретной информации о версии.
Функция FileVersionInfo: Эта функция принимает путь к файлу в качестве входных данных и возвращает экземпляр TFileVersionInfo. Она использует SHGetFileInfo для получения типа файла, а затем проверяет, может ли операционная система получить информацию о версии с помощью GetFileVersionInfoSize.
Функция QueryValue: Эта функция извлекает конкретную информацию о версии для заданного ключа.
Процедура Button1Click: Когда кнопка нажата, она вызывает функцию FileVersionInfo с указанным путем к файлу и пополняет список элементов с полученной информацией.
Программа использует различные функции Delphi, такие как SHGetFileInfo, GetFileVersionInfoSize и VerQueryValue. Тип TFileName представляет имя файла, а PChar используется для преобразования строк в указатели. Функция SendMessage используется для установки таб-стопов для списка элементов.
Программа также использует некоторые функции, определенные пользователем:
GetFileSubType: Возвращает подтип файла на основе полей dwFileType и dwFileSubtype структуры VSFixedFileInfo.
HasdwFileFlags: Проверяет, установлен ли конкретный флаг в поле dwFileFlags структуры VSFixedFileInfo.
Некоторые примечания:
Код использует некоторые синтаксисы Delphi, такие как оператор with для временного связывания объекта с записью.
Программа использует динамическое выделение памяти с помощью AllocMem и FreeMem.
Массив BoolValues используется для преобразования булевых значений в строки.
В целом, это код обеспечивает基本ное реализацию извлечения информации о версии файла в Delphi.
Функция FileVersionInfo в Delphi для получения информации о версии файла.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.