Delphi по-русски

Delphi x64

2011-04-29T03:40:00.000+03:00

Просто поражает количество вопросов в сети, касающихся компиляции приложений для Windows x64 в Delphi.

Ну нет 64-х битного компилятора Delphi. Совсем нет. Есть только 32-х битный, который, соответственно, генерит 32-х битный код. И этот код отлично работает под 64-х разрядными виндами.

Уже много лет тянется создание делфового компилятора для 32/64-битных систем. И вроде как работа близка к завершению. По крайней мере есть уже скриншоты нового IDE. Так что ждать осталось недолго. Скорее всего, поддержка 64-битности появится в следующей версии Delphi.

Ошибка «SetThreadContext failed» в Delphi 2007/2009 под Windows 7 x64

2011-04-18T14:56:00.000+03:00

Столкнулся с неприятной ошибкой в Delphi 2009 под Windows 7 x64. Как оказалось, точно такая же ошибка присутствует и в Delphi 2007.

При закрытии любого запущенного из IDE приложения появляется сообщение об ошибке: «Assertion failure: "(!"SetThreadContext failed")" in ..\win32src\thread32.cpp at line 412 Continue execution?»

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

Но, разумеется, есть неофициальное.

Трудолюбивые программисты могут почитать объяснение, поковыряться в коде хекс-эдитором и сделать так, чтоб работало.

Ленивые программисты могут просто скачать неофициальный патч.

Учтите, что в любом случае никто не несет ответственности за ваши действия.

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

2009-10-22T11:58:00.000+03:00

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

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

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

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

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

2009-10-19T18:21:00.001+03:00

Некоторые даже не догадываются, что в 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 включает:

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

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

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

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

2009-10-19T17:44:00.003+03:00

В 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

  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;

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