Установка компонентов в Delphi

Как установить компоненты, которые находятся в модуле?

Раньше (вплоть до Delphi 7) все было просто: Component > Install Component и в появившемся окне выбираем модуль для установки (автоматически подставляется имя редактируемого в данный момент модуля).

В более поздних версиях Delphi легкий путь убрали (мы же не ищем легких путей, правда?). Остался более сложный, зато он доступен в любых версиях.

Создайте новый Package (в Delphi 2009: File > New > Package - Delphi). Добавьте в него модуль, который хотите установить (в Delphi 2009: Project > Add To Project). После этого в Project Manager используйте команду Install. Сохранять Package не обязательно.

Проводник своими руками

Некоторые даже не догадываются, что в Delphi начиная с шестой версии включены компоненты ShellControls, воссоздающие функциональность Проводника. А некоторые безуспешно пытались найти их в Delphi 2009.

Так вот, радостное известие: они никуда не делись! Все так же входят в комплект поставки, просто спрятаны лучше.

Найти их можно так:

Для пользователей Delphi 7, например:
C:\Program Files\Borland\Delphi7\Demos\ShellControls 

Для пользователей Delphi 2009, например:
С:\Documents and Settings\All Users\Документы\RAD Studio\6.0\Demos\DelphiWin32\VCLWin32\ShellControls

Для остальных версий — подобным образом. После установки четыре пиктограмки будет добавлено в панель Samples.

Набор компонентов ShellControls включает:

1. TShellListView: список папок и файлов, совсем как в Проводнике Windows.
2. TShellTreeView: дерево папок, совсем как в Проводнике Windows.
3. TShellComboBox: выпадающий список папок, совсем как в Проводнике Windows.
4. ShellChangeNotifier: компонент который отслеживает изменения в заданной папке.
   

Соединив TShellListView, TShellTreeView и TShellComboBox можно получить большую часть функциональности Проводника без написания кода.

Однако не стоит забывать, что ShellControls не зря не включены в основной набор VCL (в отличие от абсолютно бесполезных Win 3.1 Controls). Компоненты глючноваты и абсолютно недокументированы.

Установка даты/времени для папок

В Delphi есть замечательные функции для установки аттрибутов и даты/времени файлов:

function FileSetAttr(const FileName: string; 
  Attr: Integer): Integer;
function FileSetDate(const FileName: string; 
  Age: Integer): Integer;

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

Что-ж, это не впервой. Вооружаемся кнопкой F7 и начинаем трассировку с глубоким проникновением в дебри VCL.

Оказывается, функция FileSetDate выглядит примерно так:

function FileSetDate(const FileName: string; 
  Age: Integer): Integer;
var
  f: THandle;
begin
  f := FileOpen(FileName, fmOpenWrite);
  if f = THandle(-1) then
    Result := GetLastError
  else
  begin
    Result := FileSetDate(f, Age);
    FileClose(f);
  end;
end;

После вызова FileOpen срабатывает условие f = THandle(-1). Это говорит нам о том, что использовать данную функцию для получения хэндла папки нельзя.

Проникнем в функцию FileOpen. Она представляет собой вызов API-шной функции CreateFile с определенным набором параметров. Сама функция имеет такой набор параметров:

function CreateFile(lpFileName: PWideChar; 
  dwDesiredAccess, dwShareMode: DWORD; 
  lpSecurityAttributes: PSecurityAttributes;
  dwCreationDisposition, dwFlagsAndAttributes: DWORD;
  hTemplateFile: THandle): THandle; stdcall;

MSDN не скрывает от нас того факта, что для получения хэндла папки нобходимо присутствие флага FILE_FLAG_BACKUP_SEMANTICS в параметре dwFlagsAndAttributes. Попробуем это на практике. Напишем свою функцию:

function FileSetDate2(const FileName: string; 
  Age: Integer): Integer;
var
  F: THandle;
begin
  F := CreateFile(PChar(FileName),
    GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
  if F = THandle(-1) then
    Result := GetLastError
  else
  begin
    Result := FileSetDate(F, Age);
    FileClose(F);
  end;
end;

По-сути мы скопировали функцию из VCL и только заменили способ создания хэндла. Теперь должно работать и с папками.

Но, увы, не работает.

Теперь хэндл создается корректно. Дальше тоже все работает корректно. И все-таки дата у папки остается прежней. В чем же дело? Лезем еще глубже — в ту версию функции FileSetDate, которая принимает хэндл в качестве параметра.

function FileSetDate(Handle: Integer; 
  Age: Integer): Integer;
var
  LocalFileTime, FileTime: TFileTime;
begin
  Result := 0;
  if DosDateTimeToFileTime(LongRec(Age).Hi, 
    LongRec(Age).Lo, LocalFileTime) and
    LocalFileTimeToFileTime(LocalFileTime, 
    FileTime) and SetFileTime(Handle, nil, nil, 
    @FileTime) then Exit;
  Result := GetLastError;
end;

Как видно, эта функция приводит дату к нужному виду, а затем просто передает ее в API-функцию SetFileTime, имеющую четыре параметра: хэндл открытого файла или папки, время создания, время последнего обращения и время последнего изменения. В нашем же случае передается только последний параметр, что логично для файла и абсолютно бессмысленно для папки! Ведь у папки есть только время создания.

В конце концов, наша собственная функция начинает работать корректно и для файлов и для папок:

function FileSetDate2(const FileName: string;
  Age: Integer): Integer;

var

  LocalFileTime, FileTime: TFileTime;
  F: THandle;

begin

  F := CreateFile(PChar(FileName),
    GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);

  if F = THandle(-1) then

    Result := GetLastError

  else

  begin

    try

      if DosDateTimeToFileTime(LongRec(Age).Hi,
        LongRec(Age).Lo, LocalFileTime) and

        LocalFileTimeToFileTime(LocalFileTime,
        FileTime) and SetFileTime(F, @FileTime,
        nil, @FileTime) then Exit;

      Result := GetLastError;

    finally

      FileClose(F);

    end;

  end;

end;

Если для файла нужно устанавливать только дату последнего изменения, можно изменить функцию, добавив соответствующую проверку.