Получение информации о версии файла

Delphi , Файловая система , Файлы

Автор: Gua
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение информации о версии файла

Зависимости:
Автор:       Gua, fbsdd@ukr.net, ICQ:141585495, Simferopol
Copyright:
Дата:        05 мая 2002 г.
***************************************************** }

{$B-,R-}

function GetFileVersion(const FileName: string): string;
type
  PDWORD = ^DWORD;
  PLangAndCodePage = ^TLangAndCodePage;
  TLangAndCodePage = packed record
    wLanguage: WORD;
    wCodePage: WORD;
  end;
  PLangAndCodePageArray = ^TLangAndCodePageArray;
  TLangAndCodePageArray = array[0..0] of TLangAndCodePage;
var
  loc_InfoBufSize: DWORD;
  loc_InfoBuf: PChar;
  loc_VerBufSize: DWORD;
  loc_VerBuf: PChar;
  cbTranslate: DWORD;
  lpTranslate: PDWORD;
  i: DWORD;
begin
  Result := '';
  if (Length(FileName) = 0) or (not Fileexists(FileName)) then
    Exit;
  loc_InfoBufSize := GetFileVersionInfoSize(PChar(FileName), loc_InfoBufSize);
  if loc_InfoBufSize > 0 then
  begin
    loc_VerBuf := nil;
    loc_InfoBuf := AllocMem(loc_InfoBufSize);
    try
      if not GetFileVersionInfo(PChar(FileName), 0, loc_InfoBufSize, loc_InfoBuf)
        then
        exit;
      if not VerQueryValue(loc_InfoBuf, '\\VarFileInfo\\Translation',
        Pointer(lpTranslate), DWORD(cbTranslate)) then
        exit;
      for i := 0 to (cbTranslate div SizeOf(TLangAndCodePage)) - 1 do
      begin
        if VerQueryValue(
          loc_InfoBuf,
          PChar(Format(
          'StringFileInfo\0%x0%x\FileVersion', [
          PLangAndCodePageArray(lpTranslate)[i].wLanguage,
            PLangAndCodePageArray(lpTranslate)[i].wCodePage])),
            Pointer(loc_VerBuf),
          DWORD(loc_VerBufSize)
          ) then
        begin
          Result := loc_VerBuf;
          Break;
        end;
      end;
    finally
      FreeMem(loc_InfoBuf, loc_InfoBufSize);
    end;
  end;
end;

Here's the translation of the content into Russian:

Зависимости

Программа зависит от следующих модулей:

• Windows для операций с файлами и вызовов API
• System для базовых типов данных и функций

Константы и Типы

Программа определяет несколько констант и типов:

• PDWORD: указатель на 32-разрядное неотрицательное целое число
• PLangAndCodePage: указатель на запись TLangAndCodePage
• TLangAndCodePage: упакованная запись, содержащая два поля WORD: wLanguage и wCodePage
• PLangAndCodePageArray: массив указателей на записи TLangAndCodePage

Переменные

Программа объявляет несколько переменных:

• loc_InfoBufSize: 32-разрядное неотрицательное целое число, используемое для хранения размера буфера информации о версии файла
• loc_InfoBuf: указатель на массив символов (тип PChar), хранящий буфер информации о версии файла
• loc_VerBufSize: 32-разрядное неотрицательное целое число, используемое для хранения размера буфера версии
• loc_VerBuf: указатель на массив символов (тип PChar), хранящий буфер версии
• cbTranslate: 32-разрядное неотрицательное целое число, используемое для хранения количества переводов в буфере информации о версии файла
• lpTranslate: указатель на PDWORD, хранящий ссылку на буфер перевода
• i: 32-разрядное неотрицательное целое число, используемое как индекс в цикле

Функция

Программа определяет функцию GetFileVersion, которая принимает один аргумент: FileName, представляющий путь и имя файла.

Вот что функция делает:

1. Она проверяет, является ли вводное имя файла пустым или не существует, и выходит в случае отрицательного результата.
2. Она вызывает GetFileVersionInfoSize для получения размера буфера информации о версии файла.
3. Если размер буфера не равен нулю, она выделяет память для буфера с помощью AllocMem.
4. Она вызывает GetFileVersionInfo для получения информации о версии файла из файла.
5. Она проверяет, была ли операция успешной, и выходит в случае отрицательного результата.
6. Она проходит по переводам в буфере информации о версии файла и пытается найти перевод, соответствующий языку и кодовой странице текущего процесса.
7. Если она находит соответствующий перевод, она извлекает информацию о версии из буфера и устанавливает переменную Result в строку версии.
8. Наконец, она освобождает память, выделившуюся для буфера информации о версии файла с помощью FreeMem.

Альтернативное решение

Если вам нужно упростить код, можно использовать функцию GetFileVersionInfoEx вместо GetFileVersionInfo. Функция GetFileVersionInfoEx позволяет указать параметр флагов, который позволяет включать или отключать определенные аспекты процесса извлечения. Например:

function GetFileVersion(FileName: string): string;
begin
  Result := '';
  if Length(FileName) = 0 or not FileExists(FileName) then
    Exit;

  loc_InfoBufSize := GetFileVersionInfoSize(PChar(FileName), loc_InfoBufSize);
  if loc_InfoBufSize > 0 then
  begin
    loc_VerBuf := nil;
    loc_InfoBuf := AllocMem(loc_InfoBufSize);
    try
      if not GetFileVersionInfoEx(FVI_FORMAT, PChar(FileName), loc_InfoBufSize, loc_InfoBuf) or
         (GetFileVersionInfoSize(PChar(FileName), loc_InfoBufSize) = 0) then
        Exit;

      Result := '';
      for i := 0 to (cbTranslate div SizeOf(TLangAndCodePage)) - 1 do
      begin
        if VerQueryValue(loc_InfoBuf, PChar(Format('StringFileInfo\0%x0%x\FileVersion', [PLangAndCodePageArray(lpTranslate)[i].wLanguage, PLangAndCodePageArray(lpTranslate)[i].wCodePage])), Pointer(loc_VerBuf), DWORD(loc_VerBufSize)) then
        begin
          Result := loc_VerBuf;
          Break;
        end;
      end;
    finally
      FreeMem(loc_InfoBuf, loc_InfoBufSize);
    end;
  end;
end;

В этом альтернативном решении функция GetFileVersionInfoEx используется вместо GetFileVersionInfo. Параметр флагов установлен в FVI_FORMAT, что позволяет включать извлечение информации о версии файла в конкретном формате. Остальная часть кода остается прежней.

Функция GetFileVersion позволяет получать информацию о версии файла, используя библиотеку Delphi и API-функции Windows.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Файлы ::