Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
 
www.td-truck.ru - гибридный грузовик profia

Что в версии тебе моей...

Признайтесь, у каждого из нас когда-либо возникало желание вывести в своей программе информацию о версии файла. Неважно, в заголовок ли окна, или в файл журнала. Некоторые просто пишут версию вручную, а некоторые используют встроенную в файлы формата PE возможность заполнять блок информации о версии файла. Я расскажу о втором способе.

Информация о версии файла хранится в виде набора строк, которые можно получать через специальные функции Windows API.

Для начала необходимо узнать размер блока. Это требуется для того, чтобы выделить буфер требуемого размера для хранения этого блока. Тут нам поможет вот такая процедура:

GetFileVersionInfoSize(Filename: pchar, var BuffSize: cardinal);

Здесь, Filename - имя файла, содержащего версию файла, а BuffSize - переменная, в которую будет записано количество байт, занимаемых информацией о версии. Функция запишет в переменную BuffSize число меньшее 1, если информация о версии отсутствует или произошла ошибка.

После этого, выделив буфер, мы запрашиваем сам блок информации о версии файла.

VIBuff := AllocMem(VISize);
GetFileVersionInfo(pchar(Filename),cardinal(0),VISize,VIBuff);

Но это еще не все. Информация о версии является многоязычным ресурсом, поэтому следует узнать список языков, которые поддерживаются версией файла.

  VerQueryValue(VIBuff,'\VarFileInfo\Translation',Trans,buffsize);
  if buffsize >= 4 then
  begin
    temp:=0;
    StrLCopy(@temp, pchar(Trans), 2);
    LangCharSet:=IntToHex(temp, 4);
    StrLCopy(@temp, pchar(Trans)+2, 2);
    FLanguageInfo := LangCharSet+IntToHex(temp, 4);
  end else raise EReadError.Create('Invalid language info in file '+Filename);

Выяснив язык, запрашиваем информацию, которая требуется при помощи вот такой функции:

  function GetStringValue(const From: string): string;
  begin
    VerQueryValue(VIBuff,pchar('\StringFileInfo\'+LanguageInfo+'\'+From),
                  pointer(str), buffsize);
    if buffsize > 0 then Result := str else Result := 'n/a';
  end;

В качестве входного параметра ей задается символическое имя записи в блоке информации о версии файла в виде строковой константы. Константы могут быть следующими: "CompanyName", "FileDescription", "FileVersion", "InternalName", "LegalCopyright", "OriginalFilename", "ProductName", "ProductVersion", "Comments" и они соответствуют одноименным полям блока информации о версии.

Вот и все, что следует знать для того, чтобы уметь получать информацию о версии файла. Разумеется, я рассказал далеко не все и совершенно не углублялся в данную технологию. Могу лишь заметить, что с помощью этой части Windows API можно делать множество интересных вещей. Пишите мне по электронной почте, если хотите продолжения статьи.

Текст модуля компонента

unit gsFileVersionInfo;

//**! ------------------------------------------------------------------
//**! This unit is a part of GSPackage project (Gregory Sitnin's Delphi 
//**! Components Package).
//**! ------------------------------------------------------------------
//**! You may use or redistribute this unit for your purposes while
//**! unit's code and this copyright notice is unchanged and exists.
//**! ------------------------------------------------------------------
//**! (c) Gregory Sitnin, 2001-2002. All rights reserved.
//**! ------------------------------------------------------------------

interface

uses
  Windows, Messages, SysUtils, Classes;

type
  TgsFileVersionInfo = class(TComponent)
  private
    FFilename: TFilename;
    FVersionInfoSize: cardinal;
    FFileVersion: string;
    FFileDescription: string;
    FInternalName: string;
    FOriginalFilename: string;
    FCompanyName: string;
    FProductVersion: string;
    FProductName: string;
    FLegalCopyright: string;
    FLanguageInfo: string;
    FComments: string;
    procedure SetFilename(const Value: TFilename);
    { Private declarations }
  protected
    { Protected declarations }
    property VersionInfoSize: cardinal read FVersionInfoSize;
    procedure LoadFromFile;
    procedure ClearAll;
  public
    { Public declarations }
  published
    { Published declarations }
    function GetBuildOnly: string;
    property Filename: TFilename read FFilename write SetFilename;
    property LanguageInfo: string read FLanguageInfo;
    property CompanyName: string read FCompanyName;
    property FileDescription: string read FFileDescription;
    property FileVersion: string read FFileVersion;
    property InternalName: string read FInternalName;
    property LegalCopyright: string read FLegalCopyright;
    property OriginalFilename: string read FOriginalFilename;
    property ProductName: string read FProductName;
    property ProductVersion: string read FProductVersion;
    property Comments: string read FComments;
  end;

procedure Register;

implementation
uses dialogs;
procedure Register;
begin
  RegisterComponents('GSPackage', [TgsFileVersionInfo]);
end;

{ TgsFileVersionInfo }

procedure TgsFileVersionInfo.ClearAll;
begin
  FVersionInfoSize: -1;
  FCompanyName := '';
  FFileDescription := '';
  FFileVersion := '';
  FInternalName := '';
  FLegalCopyright := '';
  FOriginalFilename := '';
  FProductName := '';
  FProductVersion := '';
  FComments := '';
end;

function TgsFileVersionInfo.GetBuildOnly: string;
var p: integer;
    s: string;
begin
  s := FileVersion;
  p := LastDelimiter('.',s);
  Result := copy(s,p+1,length(s)-p);
end;

procedure TgsFileVersionInfo.LoadFromFile;
var VISize:   cardinal;
    VIBuff:   pointer;
    trans:    pointer;
    buffsize: cardinal;
    temp: integer;
    str: pchar;
    LangCharSet: string;

  function GetStringValue(const From: string): string;
  begin
    VerQueryValue(VIBuff,pchar('\StringFileInfo\'+LanguageInfo+'\'+From), pointer(str),
                  buffsize);
    if buffsize > 0 then Result := str else Result := 'n/a';
  end;

begin
  ClearAll;
  VIBuff := nil;
  if not fileexists(Filename) then raise EFilerError.Create('File not found: '+Filename);
  VISize := GetFileVersionInfoSize(pchar(Filename),buffsize);
  FVersionInfoSize := VISize;
  if VISize < 1 then raise EReadError.Create('Invalid version info record in file '+Filename);
  VIBuff := AllocMem(VISize);
  GetFileVersionInfo(pchar(Filename),cardinal(0),VISize,VIBuff);

  VerQueryValue(VIBuff,'\VarFileInfo\Translation',Trans,buffsize);
  if buffsize >= 4 then
  begin
    temp:=0;
    StrLCopy(@temp, pchar(Trans), 2);
    LangCharSet:=IntToHex(temp, 4);
    StrLCopy(@temp, pchar(Trans)+2, 2);
    FLanguageInfo := LangCharSet+IntToHex(temp, 4);
  end else raise EReadError.Create('Invalid language info in file '+Filename);

  FCompanyName := GetStringValue('CompanyName');
  FFileDescription := GetStringValue('FileDescription');
  FFileVersion := GetStringValue('FileVersion');
  FInternalName := GetStringValue('InternalName');
  FLegalCopyright := GetStringValue('LegalCopyright');
  FOriginalFilename := GetStringValue('OriginalFilename');
  FProductName := GetStringValue('ProductName');
  FProductVersion := GetStringValue('ProductVersion');
  FComments := GetStringValue('Comments');

  FreeMem(VIBuff,VISize);
end;

procedure TgsFileVersionInfo.SetFilename(const Value: TFilename);
begin
  FFilename := Value;
  LoadFromFile;
end;

end.
   Внимание! Запрещается перепечатка данной статьи или ее части без согласования с автором. Если вы хотите разместить эту статью на своем сайте или издать в печатном виде, свяжитесь с автором.
Автор статьи:  Григорий Ситнин, 2001-2002. (http://gregor.kcsystema.ru/)
  

Другие статьи Наверх


  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо