Компоненты Internet Direct (Indy). Вводная статья для новичков

Если в двух словах, Indy — компоненты для удобной работы с популярными интернет-протоколами. Принцип их работы основывается на использовании сокетов в блокирующем режиме. Indy интересен и удобен тем, что достаточно сильно абстрагирован. И программирование в Indy сводится к линейному программированию. Кстати, в интернете широко распространена переводная статья, в которой есть слова "блокирующий режим не является дьяволом" :)) В свое время меня очень позабавил этот перевод. Статья — часть книги Хувера и Харири "Глубины Indy". В принципе, для работы с Indy вам вовсе не обязательно всю ее читать, но ознакомиться с принципами работы протоколов интернета я все-таки рекомендую. Что касается "дьявольского" режима. Вызов блокирующего сокета действительно не возвращает управления, пока не выполнит свою задачу. Когда вызовы делаются в главном потоке, интерфейс приложения может "подвиснуть". Чтобы позволить избежать этой неприятной ситуации, разработчики индей создали компонент TIdAntiFreeze. Достаточно просто кинуть его на форму — и пользовательский интерфейс будет преспокойно перерисовываться во время выполнения блокирующих вызовов.

Вы наверняка уже ознакомились с содержимым различных закладок "Indy (...)" в Delphi. Компонентов там немало, и каждый из них может быть полезным. Я сама работала далеко не со всеми, так как не вижу надобности их изучать без определенной задачи.

В базовый дистрибутив Delphi входят Indy v.9 с копейками. Наверное, желательно сразу сделать обновление до более новой версии (например, у меня сейчас 10.0.76, но есть и более поздние, вроде).

Есть клиентские и серверные компоненты для работы с одними и теми же протоколами. Indy реально упрощают разработку приложений, в отличие от варианта разработки того же самого функционала на сокетах. Например, чтобы установить связь с сервером, вы должны просто-напросто вызвать метод Connect. Успешное установление соединения ознаменуется возвратом из метода без возникновения эксепшена. Если же соединение неызовется установится — вызовется исключение.

"Академический" пример (код не рабочий, не запускайте :) ):


with IndyClient do   
begin  
  Host := 'test.com';  
  Port := 2000;  
  Connect;   
  Try  
    // работа с данными (чтение, запись...)  
  finally   
    Disconnect;   
  end;  
end;  

Host и port могут быть установлены в инспекторе объектов или в рантайме.

Для чего же можно использовать компоненты Indy в задачах парсинга? Применение разнообразно! Самое простое — получение содержимого страницы (с этим уже все, наверное, сталкивались) с использованием компонента IdHTTP:


var  
  rcvrdata: TMemoryStream;  
  idHttp1: TidHttp;  
begin  
  idHttp1 := TidHttp.Create(nil);  
  rcvrdata := TMemoryStream.Create;  
  idHttp1.Request.UserAgent := 'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)';  
  idHttp1.Request.AcceptLanguage := 'ru';  
  idHttp1.Response.KeepAlive := true;  
  idHttp1.HandleRedirects := true;  
  try  
    idHttp1.Get(Edit1.Text, rcvrdata);  
  finally  
    idHttp1.Free;  
  end;  
  if rcvrdata.Size > 0 then begin  
    ShowMessage('Получено ' + inttostr(rcvrdata.Size));  
    rcvrdata.SaveToFile('c:\111.tmp');  
  end;  
  rcvrdata.Free;  
end;  

Как видно, можно не только получить содержимое страницы, но и имитировать загрузку документа с определенного клиента. Компоненты Indy вообще удобны для формирования заголовков и POST-запросов. Об этом с примерами в следующий раз.

Добавлено: 02 Августа 2018 08:04:11 Добавил: Андрей Ковальчук

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

Директивы условной компиляции
{$C+} и {$C-} - директивы проверки утверждений
{$I+} и {$I-} - директивы контроля ввода/вывода
{$M} и {$S} - директивы, определяющие размер стека
{$M+} и {$M-} - директивы информации времени выполнения о типах
{$Q+} и {$Q-} - директивы проверки переполнения целочисленных операций
{$R} - директива связывания ресурсов
{$R+} и {$R-} - директивы проверки диапазона
{$APPTYPE CONSOLE} - директива создания консольного приложения

1) Директивы компилятора, разрешающие или запрещающие проверку утверждений.

По умолчанию {$C+} или {$ASSERTIONS ON}

Область действия локальная

Описание

Директивы компилятора $C разрешают или запрещают проверку утверждений. Они влияют на работу процедуры Assert,используемой при отладке программ. По умолчанию действует
директива {$C+} и процедура Assert генерирует исключение EAssertionFailed, если проверяемое утверждение ложно.

Так как эти проверки используются только в процессе отладки программы, то перед ее окончательной компиляцией следует указать директиву {$C-}. При этом работа процедур Assert будет блокировано и генерация исключений EassertionFailed производиться не будет.

Директивы действуют на весь файл исходного кода независимо от того, в каком месте файла они расположены.

2) Директивы компилятора, включающие и выключающие контроль файлового ввода-вывода.

По умолчанию {$I+} или {$IOCHECKS ON}

Область действия локальная

Описание

Директивы компилятора $I включают или выключают автоматический контроль результата вызова процедур ввода-вывода Object Pascal. Если действует директива {$I+}, то при возвращении процедурой ввода-вывода ненулевого значения генерируется
исключение EInOutError и в его свойство errorcode заносится код ошибки. Таким образом, при действующей директиве {$I+} операции ввода-вывода располагаются в блоке try...except, имеющем обработчик исключения EInOutError. Если такого блока нет, то обработка производится методом TApplication.HandleException.

Если действует директива {$I-}, то исключение не генерируется. В этом случае проверить, была ли ошибка, или ее не было, можно, обратившись к функции IOResult. Эта функция очищает ошибку и возвращает ее код, который затем можно анализировать. Типичное применение директивы {$I-} и функции IOResult демонстрирует следующий пример:


{$I-}  
  
AssignFile(F,s);  
Rewrite(F);  
  
{$I+}  
i:=IOResult;  
if i<>0 then  
  
case i of  
      2: ..........  
      3: ..........  
   end;   

В этом примере на время открытия файла отключается проверка ошибок ввода вывода, затем она опять включается, переменной i присваивается значение, возвращаемое функцией IOResult и, если это значение не равно нулю (есть ошибка), то предпринимаются какие-то действия в зависимости от кода ошибки. Подобный стиль программирования был типичен до введения в Object Pascal механизма обработки исключений. Однако сейчас, по-видимому, подобный стиль устарел и применение директив $I потеряло былое значение.

3) Директивы компилятора, определяющие размер стека

По умолчанию {$M 16384,1048576}

Область действия глобальная

Описание

Локальные переменные в процедурах и функциях размещаются в стеке приложения. При каждом вызове процедуры или функции ее локальные переменные помещаются в стек. При выходе из процедуры или функции эти локальные процедуры удаляются из стека.
Директивы компилятора $M задают параметры стека приложения: его минимальный и максимальный размеры. Приложение всегда гарантированно имеет размер стека, равный его минимальной величине. Если при запуске приложения Windows обнаруживает, что не может
выделить этот минимальный объем памяти, то выдается сообщение об этой ошибке.

Если во время работы выясняется, что минимального размера стека не хватает, то размер увеличивается на 4 K, но не более, чем до установленного директивой максимального размера. Если увеличение размера стека невозможно из-за нехватки памяти или из-за достижения его максимальной величины, генерируется исключение EStackOverflow. Минимальный размер стека по умолчанию равен 16384 (16K). Этот размер может изменяться параметром minstacksize
директивы {$M} или параметром number директивы {$MINSTACKSIZE}.

Максимальный размер стека по умолчанию равен 1,048,576 (1M). Этот размер может изменяться параметром maxstacksize директивы {$M} или параметром number директивы {$MAXSTACKSIZE number}. Значение минимального размера стека может задаваться целым числом в диапазоне между1024 и 2147483647. Значение максимального размера стека должно быть не менее минимального размера и не более 2147483647. Директивы задания размера стека могут включаться только в программу и не должны использоваться в библиотеках и модулях.

В Delphi 1 имеется процедура компилятора {$S}, осуществляющая переключение контроля переполнения стека. Теперь этот процесс полностью автоматизирован и директива {$S} оставлена только для обратной совместимости.

4) Директивы компилятора, включающие и выключающие генерацию информации времени выполнения о типах (runtime type information - RTTI).

По умолчанию {$M-} или {$ TYPEINFO OFF}

Область действия локальная

Описание

Директивы компилятора $I включают или выключают генерацию информации времени выполнения о типах (runtime type information - RTTI). Если класс объявляется в состоянии {$M+} или является производным от класса объявленного в этом состоянии, то компилятор генерирует RTTI о его полях, методах и свойствах, объявленных в разделе published. В противном
случае раздел published в классе не допускается. Класс TPersistent, являющийся предшественником большинства классов Delphi и все классов компонентов, объявлен в модуле Classes в состоянии {$M+}. Так что для всех классов, производных от него, заботиться о директиве {$M+}не приходится.

5) Директивы компилятора, включающие и выключающие проверку переполнения при целочисленных операциях

По умолчанию {$Q-} или {$OVERFLOWCHECKS OFF}

Область действия локальная

Описание

Директивы компилятора $Q включают или выключают проверку переполнения при целочисленных операциях. Под переполнением понимается получение результата, который не может сохраняться в регистре компьютера. При включенной директиве {$Q+} проверяется переполнение при целочисленных операциях +, -, *, Abs, Sqr, Succ, Pred, Inc и Dec. После каждой из этих операций размещается код, осуществляющий соответствующую проверку. Если обнаружено переполнение,
то генерируется исключение EIntOverflow. Если это исключение не может быть обработано, выполнение программы завершается.

Директивы $Q проверяют только результат арифметических операций. Обычно они используются совместно с директивами {$R}, проверяющими диапазон значений при присваивании.
Директива {$Q+} замедляет выполнение программы и увеличивает ее размер. Поэтому обычно она используется только во время отладки программы. Однако, надо отдавать себе отчет, что отключение этой директивы приведет к появлению ошибочных результатов расчета в случаях, если переполнение действительно произойдет во время выполнении программы. Причем сообщений о подобных ошибках не будет.

6) Директива компилятора, связывающая с выполняемым модулем файлы ресурсов

Область действия локальная

Описание

Директива компилятора {$R} указывает файлы ресурсов (.DFM, .RES), которые должны быть включены в выполняемый модуль или в библиотеку. Указанный файл должен быть файлом ресурсов Windows. По умолчанию расширение файлов ресурсов - .RES. В процессе компоновки компилированной программы или библиотеки файлы, указанные в директивах {$R}, копируются в
выполняемый модуль. Компоновщик Delphi ищет эти файлы сначала в том каталоге, в котором расположен модуль, содержащий директиву {$R}, а затем в каталогах, указанных при выполнении команды главного меню Project | Options на странице Directories/Conditionals диалогового окна в опции Search path или в опции /R командной строки DCC32.

При генерации кода модуля, содержащего форму, Delphi автоматически включает в файл .pas директиву {$R *.DFM}, обеспечивающую компоновку файлов ресурсов форм. Эту директиву нельзя удалять из текста модуля, так как в противном случае загрузочный модуль не будет создан и сгенерируется исключение EResNotFound.

7) Директивы компилятора, включающие и выключающие проверку диапазона целочисленных значений и индексов

По умолчанию {$R-} или {$RANGECHECKS OFF}

Область действия локальная

Описание

Директивы компилятора $R включают или выключают проверку диапазона целочисленных значений и индексов. Если включена директива {$R+}, то все индексы массивов и строк и все присваивания скалярным переменным и переменным с ограниченным диапазоном значений проверяются на соответствие значения допустимому диапазону. Если требования
диапазона нарушены или присваиваемое значение слишком велико, генерируется исключение ERangeError. Если оно не может быть перехвачено, выполнение программы завершается.

Проверка диапазона длинных строк типа Long strings не производится.
Директива {$R+} замедляет работу приложения и увеличивает его размер. Поэтому она обычно используется только во время отладки.

8) Директива компилятора, связывающая с выполняемым модулем файлы ресурсов

Область действия локальная

Описание

Директива компилятора {$R} указывает файлы ресурсов (.DFM, .RES), которые должны быть включены в выполняемый модуль или в библиотеку. Указанный файл должен быть файлом ресурсов Windows. По умолчанию расширение файлов ресурсов - .RES.
В процессе компоновки компилированной программы или библиотеки файлы, указанные в директивах {$R}, копируются в выполняемый модуль. Компоновщик Delphi ищет эти файлы сначала в том каталоге, в котором расположен модуль, содержащий директиву {$R}, а затем в каталогах, указанных при выполнении команды главного меню Project | Options на странице Directories/Conditionals диалогового окна в опции Search path или в опции /R командной строки DCC32.

При генерации кода модуля, содержащего форму, Delphi автоматически включает в файл .pas директиву {$R *.DFM}, обеспечивающую компоновку файлов ресурсов форм. Эту директиву нельзя удалять из текста модуля, так как в противном случае загрузочный модуль не будет создан и сгенерируется исключение EResNotFound.

Добавлено: 02 Августа 2018 08:03:06 Добавил: Андрей Ковальчук

Как прочитать ID3-Tag'и из MP3-файла?

На самом деле, как это не кажется, прочитать ID3-теги из MP3-файла совсем не сложно и, более того, для этого не требуется никаких специальных компонентов. TMediaPlayer здесь также бессилен. Все ID3-теги хранятся в последних 128-ми байтах MP3-файла. Часть из них записана не в том виде, в каком мы привыкли их читать в Winamp или в другом проигрывателе... Итак, перейдём сразу к коду...


{   
  Byte 1-3 = ID 'TAG'   
  Byte 4-33 = Titel / Title   
  Byte 34-63 = Artist   
  Byte 64-93 = Album   
  Byte 94-97 = Jahr / Year   
  Byte 98-127 = Kommentar / Comment   
  Byte 128 = Genre   
}  

Это - общая схема хранения информации в MP3-файле, которую мы будем читать. Вся эта информация отделяется от "музыкальной" части файла символами 'TAG' . После них и начинается служебная информация: название композиции, исполнитель, альбом, год исполнения, комментарий, жанр. Будет гораздо проще работать с ID3-тегами, объявив для них отдельный тип:


type    
  TID3Tag = record    
    ID: string[3];    
    Titel: string[30];    
    Artist: string[30];    
    Album: string[30];    
    Year: string[4];    
    Comment: string[30];    
    Genre: Byte;    
  end;  

Итак, мы объявили тип TID3Tag и теперь можем его использовать. Как видно из кода, этот класс содержит несколько строковых полей, в каждом из которых и будет записан соответствующий ID3-тег.

Теперь следует поговорить о теге, отвечащем за жанр композиции. Дело в том, что в файле хранится лишь номер жанра, а не название самого жанра, поэтому получать его название придётся вручную. Сначала объявим массив, содержащий названия всех возможных жанров. Всего их 147:


const   
 Genres : array[0..146] of string =    
    ('Blues','Classic Rock','Country','Dance','Disco','Funk','Grunge',    
    'Hip- Hop','Jazz','Metal','New Age','Oldies','Other','Pop','R&B',    
    'Rap','Reggae','Rock','Techno','Industrial','Alternative','Ska',    
    'Death Metal','Pranks','Soundtrack','Euro-Techno','Ambient',    
    'Trip-Hop','Vocal','Jazz+Funk','Fusion','Trance','Classical',    
    'Instrumental','Acid','House','Game','Sound Clip','Gospel','Noise',    
    'Alternative Rock','Bass','Punk','Space','Meditative','Instrumental Pop',    
    'Instrumental Rock','Ethnic','Gothic','Darkwave','Techno-Industrial','Electronic',    
    'Pop-Folk','Eurodance','Dream','Southern Rock','Comedy','Cult','Gangsta',    
    'Top 40','Christian Rap','Pop/Funk','Jungle','Native US','Cabaret','New Wave',    
    'Psychadelic','Rave','Showtunes','Trailer','Lo-Fi','Tribal','Acid Punk',    
    'Acid Jazz','Polka','Retro','Musical','Rock & Roll','Hard Rock','Folk',    
    'Folk-Rock','National Folk','Swing','Fast Fusion','Bebob','Latin','Revival',    
    'Celtic','Bluegrass','Avantgarde','Gothic Rock','Progressive Rock',    
    'Psychedelic Rock','Symphonic Rock','Slow Rock','Big Band','Chorus',    
    'Easy Listening','Acoustic','Humour','Speech','Chanson','Opera',    
    'Chamber Music','Sonata','Symphony','Booty Bass','Primus','Porn Groove',    
    'Satire','Slow Jam','Club','Tango','Samba','Folklore','Ballad',    
    'Power Ballad','Rhytmic Soul','Freestyle','Duet','Punk Rock','Drum Solo',    
    'Acapella','Euro-House','Dance Hall','Goa','Drum & Bass','Club-House',    
    'Hardcore','Terror','Indie','BritPop','Negerpunk','Polsk Punk','Beat',    
    'Christian Gangsta','Heavy Metal','Black Metal','Crossover','Contemporary C',    
    'Christian Rock','Merengue','Salsa','Thrash Metal','Anime','JPop','SynthPop');  

Наконец, процедура, читающая все теги из MP3-файла... Пропишем её в разделе implementation:


var    
  Form1: TForm1;    
   
implementation    
   
{$R *.dfm}    
   
function readID3Tag(FileName: string): TID3Tag;    
var    
  FS: TFileStream;    
  Buffer: array [1..128] of Char;    
begin    
  FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);    
  try    
    FS.Seek(-128, soFromEnd);    
    FS.Read(Buffer, 128);    
    with Result do    
    begin    
      ID := Copy(Buffer, 1, 3);    
      Titel := Copy(Buffer, 4, 30);    
      Artist := Copy(Buffer, 34, 30);    
      Album := Copy(Buffer, 64, 30);    
      Year := Copy(Buffer, 94, 4);    
      Comment := Copy(Buffer, 98, 30);    
      Genre := Ord(Buffer[128]);    
    end;    
  finally    
    FS.Free;    
  end;    
end;  

Данная функция возвратит нам всё содержимое ID3-тегов MP3-файла, указанного в FileName. Теперь дело за малым - написать обработчик открытия файла и чтения содержимого всех тегов из выбранного файла:


procedure TfrmMain.Button1Click(Sender: TObject);    
begin    
  IF OpenDialog1.Execute then    
  begin    
    WITH readID3Tag(OpenDialog1.FileName) do    
    begin    
      LlbID.Caption := 'ID: ' + ID;    
      LlbTitel.Caption := 'Titel: ' + Titel;    
      LlbArtist.Caption := 'Artist: ' + Artist;    
      LlbAlbum.Caption := 'Album: ' + Album;    
      LlbYear.Caption := 'Year: ' + Year;    
      LlbComment.Caption := 'Comment: ' + Comment;    
      IF (Genre >= 0) AND (Genre <=146) then    
       LlbGenre.Caption := 'Genre: ' + Genres[Genre]    
      else    
       LlbGenre.Caption := 'N/A';    
    end;    
  end;    
end;  

Ну вот и всё... Добавьте соответствующие компоненты на форму и испробуйте работоспособность кода. В архиве с данной статьёй есть данная демо-программа.

Кроме ID3 тегов (полное имя которых звучит как ID3v1), существуют ID3v2-теги. Они содержат большее количество информации: все ID3v1 теги, а также информацию об авторских правах, настоящем исполнителе, адресе в интернете, композиторе и другой информации. Принцип их чтения тот же, что и у ID3v1 тегов.

Добавлено: 02 Августа 2018 08:02:06 Добавил: Андрей Ковальчук

Как обойти ограничение программ по сроку действия

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

По ходу работы мне приходится сталкиваться и с другими случаями. Вот, например, последний. Всем известная фирма регулярно выпускает электронный каталог своей продукции с ценами и техническими характеристиками. "Регулярно" потому что цены актуальны только в пределах определенного времени, да и ассортимент время от времени пополняется новыми позициями, а старые снимаются с производства. Каталог этот выпускается каждые полгода, соответственно и "срок годности" у него рассчитан на этот период. Но беда в том, что своевременно обновлять этот каталог не получается. Поэтому приходится продлевать жизнь просроченному. Как правило, сверка даты происходит во время запуска программы. Это самый распространенный случай, обход которого и будет рассмотрен ниже. Я также встречал проверку спустя непродолжительный интервал времени (примерно 30 сек). Все зависит от хитрости разработчиков, они ведь тоже не глупые люди :-). Но даже и с таким вариантом справиться очень легко!


program BackTime; {$APPTYPE CONSOLE}  
  
uses ShellApi,Windows,SysUtils;  
  
var Today:TDateTime;  
    bkTime, bkProgram: String;  
    Interval, j: SmallInt;  
begin  
  Today:=Date; // фиксируем реальную дату  
  if ParamCount<>3  
  then  
   begin // если параметры не заданы то печатаем подсказку  
    WriteLn(output,'BackTime (c)DSKalugin@rambler.ru');  
    WriteLn(output,'---------------------');  
    WriteLn(output,'BackTime.exe T I P');  
    WriteLn(output,'T - Date;');  
    WriteLn(output,'I - Interval, [sec];');  
    WriteLn(output,'P - Program');  
    WriteLn(output,'---------------------');  
    WriteLn(output,'Example:');  
    WriteLn(output,'BackTime.exe 04.01.2000 15  
                                "C:\Program Files\program.exe"');  
   end  
  else  
   begin  
    // 1й параметр - дата  
    bkTime:=ParamStr(1);  
    // 2й параметр - интервал в секундах  
    Interval:=StrToInt(ParamStr(2));  
    // 3й параметр - полный путь к программе  
    bkProgram:=ParamStr(3);  
    // установка необходимой даты  
    WinExec(PChar('cmd /c date '+bkTime), SW_HIDE);  
    // запуск программы  
    ShellExecute(0, 'open', PChar(bkProgram), nil, nil, SW_SHOW);  
    j:=0;  
    while j2<Interval do  
     begin  // задержка в секундах  
      sleep(1000);  
      inc(j);  
     end;  
    // восстанавливаем реальную дату  
    WinExec(PChar('cmd /c date '+DateToStr(Today)), SW_HIDE);  
   end  
end.  

Как видите, все очень просто! Предлагаемая утилита BackTime запускается из командной строки и принимает 3 параметра:

Дата, при которой программа является работоспособной. Формат даты должен соответствовать заданному в системе.
Интервал времени в секундах до восстановления реального времени.
Сама программа. Если в пути присутствуют пробелы, то необходимо параметр взять в двойные кавычки.
Задержка перед восстановлением реальной даты нужна в любом случае. Во-первых программе требуется несколько секунд для полной загрузки. А во-вторых, как сказано выше, некоторые хитрецы делают сверку не сразу.

Как теперь это использовать? На рабочем столе создаем ярлык...

Добавлено: 02 Августа 2018 08:01:05 Добавил: Андрей Ковальчук

К вопросу о защите программ

Часть 1. Прячем формы
Как известно, многие рекомендации по совершенствованию программ, созданных с применением VCL, сводятся к простому указанию – открыть исполняемый модуль очередным Restorator’ом и поправить то или иное место в ресурсе формы или датамодуля. Наличие исходных текстов и какая-никакая документированность потоковой системы VCL привели к тому, что сегодня извлечение в читабельное представление и обратная запись содержимого ресурсов форм не является задачей, посильной только усилиям гуру.

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

1. СОЗДАНИЕ ФИЛЬТРА ЧТЕНИЯ ДАННЫХ

Итак, единственное место во всем VCL, где происходит доступ к ресурсу формы – это функция InternalReadComponentRes из Classes, текст которой приведен ниже:


function InternalReadComponentRes(  
    const ResName: string;  
    HInst: THandle;  
    var Instance: TComponent  
): Boolean;  
var  
    HRsrc: THandle;  
begin        { avoid possible EResNotFound exception }  
    if HInst = 0 then HInst := HInstance;  
    HRsrc := FindResource(HInst, PChar(ResName), RT_RCDATA);  
    Result := HRsrc <> 0;  
    if not Result then Exit;  
    with TResourceStream.Create(HInst, ResName, RT_RCDATA) do  
    try  
        Instance := ReadComponent(Instance);  
    finally  
        Free;  
    end;  
    Result := True;  
end;  

Суть ее действий несложна: в модуле, определяемом параметром HInst, ищем ресурс с типом RCDATA и заданным именем. Если не находим, то возвращаем False и на этом успокаиваемся, иначе создаем поток на данных указанного ресурса и читаем из него данные методом ReadComponent.

В таком случае возникает вопрос, что нам мешает вклиниться между созданием потока и чтением из него данных с тем, чтобы перед чтением нужным образом их модифицировать? Собственно, прямых ограничений нет – нам придется лишь выполнить одну условно сомнительную операцию – модифицировать модуль Classes, дополнив его перед implementation следующим текстом:


type  
    TLoadComponentFunc = function (hInst: THandle;  
      const ResName: string;  
      var Instance: TComponent): Boolean;  
  
var  
    LoadComponentFunc: TLoadComponentFunc;

а в implementation мы изменим функцию InternalReadComponentRes следующим образом:


function InternalReadComponentRes(  
      const ResName: string;  
      HInst: THandle;  
      var Instance: TComponent): Boolean;  
var  
    HRsrc: THandle;  
begin        { avoid possible EResNotFound exception }  
    if HInst = 0 then HInst := HInstance;  
    if not Assigned(LoadComponentFunc) then  
    begin  
        HRsrc := FindResource(HInst, PChar(ResName), RT_RCDATA);  
        Result := HRsrc <> 0;  
        if not Result then Exit;  
        with TResourceStream.Create(HInst, ResName, RT_RCDATA) do  
        try  
            Instance := ReadComponent(Instance);  
        finally  
            Free;  
        end;  
        Result := True;  
    end else Result := LoadComponentFunc(HInst, ResName, Instance);  
end;  

Легко увидеть, что TLoadComponentFunc по описанию совпадает с InternalReadComponentRes и вызывается внутри нее, выступая в качестве того самого «клина», о котором мы и говорили выше. Описание TLoadComponentFunc и переменную, содержащую адрес обработчика мы добавляли в самом конце interface-секции Classes с единственной целью – избежать таких изменений в модуле, которые приводили бы к печально известному сообщению (“Unit xxx was compiled with another version of yyy”). Практика свидетельствует, что дописывание каких-либо новых определений в конец существующего модуля никак не влияет на «версионную отметку» вышестоящих описаний (подробнее об этом в другой раз, пока придется поверить на слово).

Таким образом, мы определили функцию-фильтр, которая будет вызываться при каждой попытке доступа к ресурсу формы. Удобной особенностью является то, что при отсутствии фильтра приложение может работать в штатном режиме, т.е. можно спокойно вести разработку и защищать данные от случая к случаю.

Пример модуля, реализующего фильтр, тождественный VCL-ному чтению:


unit DFMLoader;  
  
interface  
  
uses  
Classes; // Classes должны быть измененными!  
  
implementation  
  
uses  
    Windows;  
  
function MyLoadFunc(  
    HInst: THandle;  
    const ResName: string;  
    var Instance: TComponent  
): Boolean;  
begin  
    with TResourceStream.Create(HInst, ResName, RT_RCDATA) do  
    try  
        Instance := ReadComponent(Instance);  
    finally  
        Free;  
    end;  
    Result := True;  
end;  
  
initialization  
    LoadComponentFunc := @MyLoadFunc;  
  
finalization  
    LoadComponentFunc := nil;  
end.  

Обратим внимание на initialization и finalization. Установка фильтра помещена в initialization с тем, чтобы для активизации нашего метода защиты было достаточно просто подключить модуль к проекту. Изъятие фильтра на finalization обусловлено тем, что при использовании пакетов (packages) обращение к фильтру происходит внутри VCLXX.BPL (или RTLXX.bpl в D6), а сам фильтр располагается в другом пакете, который может быть выгружен. Именно поэтому на выходе мы и уберем за собой.

Лирическое отступление: в процессе тестирования описываемой защиты первоначально зануление фильтра отсутствовало, но быстро появилось после эффектного падения IDE на перекомпиляции модуля с защитой ;-) Кстати, IDE могло упасть только после перекомпиляции VCLXX/RTLXX, но о том, как это делалось, тоже не в этот раз.

2. РЕАЛИЗАЦИЯ ФИЛЬТРА

Рассмотрим реализацию простейшего фильтра (фильтры посложнее вы реализуете сами, доверившись своему вкусу) и обработки приложения для его использования. Над байтами оригинального ресурса проделаем следующее – увеличим значение на единицу: операция обратимая и, следовательно, назад это фарш прокрутить можно.

При этом обратим внимание, что начало данных ресурса формы обозначено сигнатурой “TPF0”, а после нашего преобразования там будет “UQG1” (вместо каждого символа сигнатуры мы взяли следующий за ним по таблице ASCII). Мы используем это обстоятельство для решения вопроса о том, каким образом читать ресурс.

Итак, функция чтения ресурса теперь будет выглядеть так:


function MyLoadFunc(  
    HInst: THandle;  
     const ResName: string;  
     var Instance: TComponent  
): Boolean;  
const  
    MySignature: array[0..3] of Char = 'UQG1';  
var  
    I: Integer;  
    HRsrc: THandle;  
    src: TResourceStream;  
    Stream: TMemoryStream;  
begin  
    HRsrc := FindResource(HInst, PChar(ResName), RT_RCDATA);  
    Result := HRsrc <> 0;  
    if not Result then Exit;  
  
    src := TResourceStream.Create(HInst, ResName, RT_RCDATA);  
    try  
        if LongInt(src.Memory^) = LongInt(MySignature) then  
        begin  
            Stream := TMemoryStream.Create;  
            try  
                Stream.LoadFromStream(src);  
                { расшифровываем }  
                for I := 0 to Stream.Size - 1 do  
                    Dec(Byte(PChar(Stream.Memory)[I]));  
                { и загружаем }  
                Instance := Stream.ReadComponent(Instance);  
            finally  
                Stream.Free;  
            end;  
        end else Instance := src.ReadComponent(Instance);  
    finally  
        src.Free;  
    end;  
    Result := True;  
end;  

А для того, чтобы защитить скомпилированный проект, напишем такую же простенькую «защищалку»:


program protect;  
  
{$APPTYPE CONSOLE}  
  
uses  
    Windows, Classes;  
  
const  
    FormSignature: array[0..3] of Char = 'TPF0';  
  
function MyEnumProc(hModule: THandle; lpResType, lpResName: PChar;  
    lParam: LPARAM): BOOL; stdcall;  
var  
    I: Integer;  
    Src: TResourceStream;  
    Dst: TMemoryStream;  
begin  
    if DWORD(lpResName) and $FFFF0000 <> 0 then  
    begin  
        Src := TResourceStream.Create(hModule, lpResName, lpResType);  
        try  
        { удостоверимся, что это именно ресурс формы! }  
            if LongInt(Src.Memory^) = LongInt(FormSignature) then  
            begin  
                Dst := TMemoryStream.Create;  
                try  
                    Dst.LoadFromStream(Src);  
                    Dst.Position := 0;  
  
                    { зашифруем }  
                    for I := 0 to Dst.Size - 1 do  
                    Inc(Byte(PChar(Dst.Memory)[I]));  
  
                    TStrings(lParam).AddObject(lpResName, Dst);  
                except  
                    Dst.Free;  
                    raise;  
                end;  
              
        finally  
            Src.Free;  
        end;  
    end;  
    Result := True;  
end;  
  
procedure GetResNames(const Filename: string; Items: TStrings);  
var  
    hModule: THandle;  
begin  
    hModule := LoadLibraryEx(PChar(Filename), 0, LOAD_LIBRARY_AS_DATAFILE);  
    if hModule <> 0 then  
    try  
        EnumResourceNames(hModule, RT_RCDATA, @MyEnumProc, LPARAM(Items));  
    finally  
        FreeLibrary(hModule);  
    end;  
end;  
  
procedure UpdateResources(const Filename: string; Items: TStrings);  
var  
    I: Integer;  
    Stream: TMemoryStream;  
    hUpdate: THandle;  
begin  
    hUpdate := BeginUpdateResource(PChar(Filename), False);  
    if hUpdate <> 0 then  
    try  
        for I := 0 to Items.Count - 1 do  
        begin  
            Stream := Items.Objects[I] as TMemoryStream;  
            UpdateResource(hUpdate, RT_RCDATA, PChar(Items[I]), 0, Stream.Memory, Stream.Size);  
        end;  
    finally  
        EndUpdateResource(hUpdate, False);  
    end;  
end;  
  
var  
    I: Integer;  
    Items: TStrings;  
begin  
    Items := TStringList.Create;  
    try  
        GetResNames(ParamStr(1), Items);  
        UpdateResources(ParamStr(1), Items);  
    finally  
        { освободим временные буфера }  
        for I := 0 to Items.Count - 1 do  
            Items.Objects[I].Free;  
        Items.Free;  
    end;  
end.  

Что мы здесь делаем: во-первых, загружаем обрабатываемый исполняемый модуль и находим в нем все ресурсы с данными от форм (обращая внимание на то, чтобы это были именно данные форм путем проверки сигнатуры). Преобразованные копии этих ресурсов вместе с именами мы складываем в список.

Затем мы освобождаем модуль и открываем его уже для изменения ресурсов (одновременно произвести два открытия нам не дадут). Т.к. нам известны имена, типы и содержимое обновляемых ресурсов, ничто не мешает нам заменить ресурсы и, запустив программу, убедиться, что все работает. Осмотр же с использованием Restorator’а более не выявляет внутри программы каких-либо форм. Что и требовалось доказать.

3. ЧТО ОСТАЛОСЬ ЗА КАДРОМ

Во-первых, обработка большинства ошибок. Например, отсутствие на диске исходного файла в защищалке. Или более тщательная проверка целостности и корректности информации в шифрованных ресурсах. Для описания концепции приведенной информации вполне достаточно, а при развитии идеи появятся иные места для проверки.

Во-вторых, системная функция обновления ресурсов в файле есть только в WinNT/2K/XP. Однако для целей защиты всегда можно найти машину с указанными ОС или, перелопатив MSDN, написать полностью свое обновление ресурсов.

В-третьих, наше предположение о том, что все операции чтения ресурсов будут проходить именно через наш фильтр, основывается исключительно на анализе исходного кода VCL. Впрочем, кроме VCL никто данные в ресурсы форм и не пишет. Если у вас дело обстоит не так, то уделите внимание вопросу разрешения потенциальных конфликтов.

В-четвертых, диапазон возможностей, которые открываются в описанном подходе, не ограничивается только преобразованием ресурсов. В фильтре вполне возможно реализовать чтение данных через Интернет. Ну или хотя бы преобразовать их через установленный электронный ключ… Или в самом простом случае, упаковать их каким-либо алгоритмом (zLib, к примеру).

4. ЗАКЛЮЧЕНИЕ

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

Особая изюминка заключается в сложности написания универсальной «открывашки» для ресурсов – даже если для версии N Вашей программы определили алгоритм восстановления ресурсов, в версии N+1 Вы незначительно изменяете алгоритм и делаете бесполезной предыдущий хакерский труд.

Очень удобной является привязка параметров шифрования к коду программы – при попытке подпатчить программу велика вероятность столкнуться с нечитаемостью ресурсов и, очевидно, недоступностью ряда возможностей программы.

А что же в минусе: необходимость модифицировать исходный текст VCL и поддерживать затем эти изменения при переходе к новым версиям или установки UpdatePack’ов, но это и в самом деле не так страшно, как может показаться. Во всяком случае, за те пять лет, что применяется описанный метод, это никогда не составляло серьезной проблемы.

Автор: Евгений Каснерик

Добавлено: 02 Августа 2018 08:00:21 Добавил: Андрей Ковальчук

Использование открытых интерфейсов Delphi

Одной и наиболее сильных сторон среды программирования Delphi является ее открытая архитектура, благодаря которой Delphi допускает своего рода мета программирование, позволяя "программировать среду программирования". Такой подход переводит Delphi на качественно новый уровень систем разработки приложений и позволяет встраивать в этот продукт дополнительные инструментальные средства, поддерживающие практически все этапы создания прикладных систем. Столь широкий спектр возможностей открывается благодаря реализованной в Delphi концепции так называемых открытых интерфейсов, являющихся связующим звеном между IDE (Integrated Development Environment) и внешними инструментами. Данная статья посвящена открытым интерфейсам Delphi и представляет собой обзор представляемых ими возможностей.

В Delphi определены шесть открытых интерфейсов: Tool Interface, Design Interface, Expert Interface, File Interface, Edit Interface и Version Control Interface. Вряд ли в рамках данной статьи нам удалось бы детально осветить и проиллюстрировать возможности каждого из них. Более основательно разобраться в рассматриваемых вопросах вам помогут исходные тексты Delphi, благо разработчики снабдили их развернутыми комментариями. Объявления классов, представляющих открытые интерфейсы, содержатся в соответствующих модулях в каталоге ...\Delphi\Source\ToolsAPI.

Design Interface (модуль DsgnIntf.pas)
предоставляет средства для создания редакторов свойств и редакторов компонентов. Редакторы свойств и компонентов – это тема, достойная отдельного разговора, поэтому напомним лишь, что редактор свойства контролирует поведение Инспектора Объектов при попытке изменить значение соответствующего свойства, а редактор компонента активизируется при двойном нажатии левой кнопки мыши на изображении помещенного на форму компонента.
Version Control Interface (модуль VCSIntf.pas)
предназначен для создания систем контроля версий. Начиная с версии 2.0, Delphi поддерживает интегрированную систему контроля версий Intersolv PVCS, поэтому в большинстве случаев в разработке собственной системы нет необходимости. По этой причине рассмотрение Version Control Interface мы также опустим.
File Interface (модуль FileIntf.pas)
позволяет переопределить рабочую файловую систему IDE, что дает возможность выбора собственного способа хранения файлов (в Memo-полях на сервере БД, например).
Edit Interface (модуль EditIntf.pas)
предоставляет доступ к буферу исходных текстов, что позволяет проводить анализ кода и выполнять его генерацию, определять и изменять позицию курсора в окне редактора кода, а также управлять синтаксическим выделением исходного текста. Специальные классы предоставляют интерфейсы к помещенным на форму компонентам (определение типа компонента, получение ссылок на родительский и дочерние компоненты, доступ к свойствам, передача фокуса, удаление и т.д.), к самой форме и к ресурсному файлу проекта. Также Edit Interface позволяет идентифицировать так называемые модульные нотификаторы, определяющие реакцию на такие события, как изменение исходного текста модуля, модификация формы, переименование компонента, сохранение, переименование или удаление модуля, изменение ресурсного файла проекта и т. д.
Tool Interface (модуль ToolIntf.pas)
предоставляет разработчикам средства для получения общей информации о состоянии IDE и выполнения таких действий, как открытие, сохранение и закрытие проектов и отдельных файлов, создание модуля, получение информации о текущем проекте (число модулей и форм, их имена и т. д.), регистрация файловой системы, организация интерфейсов к отдельным модулям и т.д. В дополнение к модульным нотификаторам Tool Interface определяет add-in нотификаторы, уведомляющие о таких событиях, как открытие/закрытие файлов и проектов, загрузка и сохранение desktop-файла проекта, добавление/исключение модулей проекта, инсталляция/деинсталляция пакетов, компиляция проекта, причем в отличие от модульных нотификаторов add-in нотификаторы позволяют отменить выполнение некоторых событий. Кроме того, Tool Interface предоставляет средства доступа к главному меню IDE Delphi, позволяя встраивать в него дополнительные пункты.
Expert Interface (модуль ExptIntf.pas)
представляет собой основу для создания экспертов — программных модулей, встраиваемых в IDE c целью расширения ее функциональности. В качестве примера эксперта можно привести входящий в Delphi Database Form Wizard, выполняющий генерацию формы для просмотра и изменения содержимого таблицы БД.
Эксперты бывают нескольких типов (стилей):

Стиль Описание
esStandard Для каждого эксперта такого стиля IDE добавляет пункт меню Tools/..., при выборе которого эксперт активизируется (IDE вызывает его метод Execute)
esForm
esProject IDE рассматривает эксперты данного стиля как шаблоны форм/проектов и помещает активизирующие их изображения в галерею Object Repository.
esAddIn Эксперты подобного стиля обеспечивают собственный интерфейс с IDE

Класс каждого эксперта является потомком базового класса TIExpert, содержащего серию абстрактных методов, которые необходимо перекрыть в порождаемом классе:

Метод Описание
GetName Должен возвращать имя эксперта
GetAuthor Должен возвращать имя автора эксперта. Это имя отображается в Object Repository
GetComment Должен возвращать комментарий (1-2 предложения), поясняющий назначение эксперта. Используется в Object Repository
GetPage Должен возвращать название страницы Object Repository, на которую IDE поместит соответствующее эксперту изображение
GetGlyph Должен возвращать дескриптор (HICON, в Delphi 1.0 – HBITMAP) соответствующего эксперту изображения в ObjectRepository
GetStyle Должен возвращать константу, соответствующую стилю эксперта (esStandard/esForm/esProject/esAddIn)
GetState Если возвращаемое множество содержит константу esChecked, IDE пометит соответствующий эксперту пункт меню "галочкой", а если множество содержит константу esEnabled, то IDE сделает этот пункт меню доступным для выбора
GetIDString Должен возвращать строку – идентификатор эксперта, уникальную среди всех установленных экспертов. По соглашению, формат этой строки таков:
Имя_Компании.Назначение_эксперта,
например: Borland.WidgetExpert
GetMenuText Должен возвращать текст, отображаемый в пункте меню эксперта. Этот метод вызывается каждый раз, когда раскрывается родительское меню, что позволяет сделать пункт меню контекстно-чувствительным
Execute Вызывается при вызове эксперта через меню или Object Repository (в зависимости от стиля)

Набор методов, подлежащих перекрытию, зависит от стиля эксперта:

Метод esStandard esForm esProject esAddIn
GetName + + + +
GetAuthor + +
GetComment + +
GetPage + +
GetGlyph + +
GetStyle + + + +
GetState +
GetIDString + + + +
GetMenuText +
Execute + + +

Определив класс эксперта, необходимо позаботиться о том, чтобы Delphi "узнала" о нашем эксперте. Для этого его нужно зарегистрировать посредством вызова процедуры RegisterLibraryExpert, передав ей в качестве параметра экземпляр класса эксперта.

В качестве иллюстрации создадим простой эксперт в стиле esStandard, который при выборе соответствующего ему пункта меню Delphi выводит сообщение о том, что он запущен. Как видно из вышеприведенной таблицы, стиль esStandard обязывает перекрыть шесть методов:


unit exmpl_01;  
  
{ STANDARD EXPERT }  
  
interface  
  
uses  
  Dialogs, ExptIntf;  
  
type  
  { класс эксперта является потомком базового класса TIExpert }  
  TEMyExpert = class( TIExpert)  
    function GetName: string; override;  
    function GetStyle: TExpertStyle; override;  
    function GetIDString: string; override;  
    function GetMenuText: string; override;  
    function GetState: TExpertState; override;  
    procedure Execute; override;  
end;  
  
procedure register;  
  
implementation  
  
{ возвращаем имя эксперта }  
function TEMyExpert.GetName: string;  
begin  
  Result := 'My Simple Expert 1';  
end;  
  
{ возвращаем стиль эксперта }  
function TEMyExpert.GetStyle: TExpertStyle;  
begin  
  Result := esStandard;  
end;  
  
{ возвращаем строку - идентификатор эксперта }  
function TEMyExpert.GetIDString: string;  
begin  
  Result := 'Doomy.SimpleAddInExpert_1';  
end;  
  
{ возвращаем текст пункта меню }  
function TEMyExpert.GetMenuText: string;  
begin  
  Result := 'Simple Expert 1';  
end;  
  
{ возвращаем множество, характеризующее состояние пункта меню эксперта }  
{ (доступность, наличие "галочки"); в данном случае пункт меню доступен, }  
{ а "галочка" отсутствует }  
function TEMyExpert.GetState: TExpertState;  
begin  
  Result := [esEnabled];  
end;  
  
{ при выборе пункта меню эксперта отображаем сообщение }  
procedure TEMyExpert.Execute;  
begin  
  MessageDlg('Standard Expert Started!', mtInformation, [mbOK], 0);  
end;  
  
{ регистрируем эксперт }  
procedure register;  
begin  
  RegisterLibraryExpert( TEMyExpert.Create);  
end;  
  
end.   

Для того чтобы эксперт был "приведен в действие", необходимо выбрать пункт меню Component/Install Component ... , выбрать в диалоге Browse модуль, содержащий эксперт (в нашем случае exmpl_01.pas), нажать ОК, и после компиляции пакета dclusr30.dpk в главном меню Delphi в разделе Help должен появиться пункт Simple Expert 1, при выборе которого появляется информационное сообщение "Standard Expert started!".

Почему Delphi помещает пункт меню эксперта в раздел Help, остается загадкой. Если вам не нравится то, что пункт меню появляется там, где угодно Delphi, а не там, где хотите вы, возможен следующий вариант: создать эксперт в стиле add-in, что исключает автоматическое создание пункта меню, а пункт меню добавить "вручную", используя средства Tool Interface. Это позволит задать местоположение нового пункта в главном меню произвольным образом. Для добавления пункта меню используется класс TIToolServices — основа Tool Interface — и классы TIMainMenuIntf, TIMenuItemIntf, реализующие интерфейсы к главному меню IDE и его пунктам. Экземпляр ToolServices класса TIToolServices создается самой IDE при ее инициализации. Обратите внимание на то, что ответственность за освобождение интерфейсов к главному меню Delphi и его пунктам целиком ложится на разработчика. Попутно немного усложним функциональную нагрузку эксперта: при активизации своего пункта меню он будет выдавать справку об имени проекта, открытого в данный момент в среде:


unit exmpl_02;  
  
{ ADD-IN EXPERT, ДОБАВЛЕНИЕ ПУНКТА В ГЛАВНОЕ МЕНЮ IDE DELPHI }  
interface  
  
uses  
  Classes, Dialogs, ToolIntF, ExptIntf, Menus;  
  
type  
  { класс эксперта является потомком базового класса TIExpert }  
  TEMyExpert = class( TIExpert)  
  private  
    MenuItem: TIMenuItemIntf;  
  public  
    constructor Create;  
    destructor Destroy; override;  
    function GetName: string; override;  
    function GetStyle: TExpertStyle; override;  
    function GetIDString: string; override;  
    procedure MenuItemClick( Sender: TIMenuItemIntf);  
end;  
  
procedure register;  
  
function AddIDEMenuItem( const Caption, name, PreviousItemName: string;  
const ShortCutKey: Char; OnClick: TIMenuClickEvent): TIMenuItemIntf;  
  
implementation  
  
{ добавляем пункт в главное меню IDE Delphi: }  
{ 1) текст вставляемого пункта меню - 'Simple Expert 2'; }  
{ 2) идентификатор вставляемого пункта меню - 'ViewMyExpertItem2'; }  
{ 3) идентификатор пункта меню, перед которым добавляется новый }  
{ пункт меню - 'ViewWatchItem' (для Delphi 5 - 'ViewWatchesItem');}  
{ 4) горячая клавиша вставляемого пункта - 'Ctrl + 2'; }  
{ 5) обработчик события, соответствующего выбору вставляемого пункта }  
{ меню - MenuItemClick }  
constructor TEMyExpert.Create;  
begin  
  inherited Create;  
  MenuItem:= AddIDEMenuItem( 'Simple Expert 2', 'ViewMyExpertItem2',  
  {$IFDEF VER130}  
  'ViewWatchesItem', '2', MenuItemClick);  
  {$ELSE}  
  'ViewWatchItem', '2', MenuItemClick);  
  {$ENDIF}  
end;  
  
destructor TEMyExpert.Destroy;  
begin  
  if Assigned( MenuItem) then  
    MenuItem.Free;  
  inherited Destroy;  
end;  
  
{ при выборе пункта меню эксперта отображаем сообщение, содержащее }  
{ имя активного проекта }  
procedure TEMyExpert.MenuItemClick( Sender: TIMenuItemIntf);  
begin  
  MessageDlg( 'Current project name is ' + ToolServices.GetProjectName,  
  mtInformation, [mbOK], 0);  
end;  
  
{ возвращаем имя эксперта }  
function TEMyExpert.GetName: string;  
begin  
  Result := 'My Simple Expert 2';  
end;  
  
{ возвращаем стиль эксперта }  
function TEMyExpert.GetStyle: TExpertStyle;  
begin  
  Result := esAddIn;  
end;  
  
{ возвращаем строку - идентификатор эксперта }  
function TEMyExpert.GetIDString: string;  
begin  
  Result := 'Doomy.SimpleAddInExpert_2';  
end;  
  
  
function AddIDEMenuItem( const Caption, name, PreviousItemName: string;  
const ShortCutKey: Char; OnClick: TIMenuClickEvent): TIMenuItemIntf;  
var  
  MainMenu: TIMainMenuIntf;  
  MenuItems, PreviousItem, ParentItem: TIMenuItemIntf;  
begin  
  Result:= nil;  
  { получаем интерфейс пунктов главного меню IDE }  
  MainMenu:= ToolServices.GetMainMenu;  
  if Assigned( MainMenu) then  
    try  
      { получаем интерфейс пунктов верхнего уровня меню }  
      MenuItems:= MainMenu.GetMenuItems;  
      if Assigned( MenuItems) then  
        try  
          { ищем пункт меню перед которым необходимо вставить новый пункт }  
          PreviousItem:= MainMenu.FindMenuItem( PreviousItemName);  
          if Assigned( PreviousItem) then  
            try  
              { получаем интерфейс к родительскому пункту меню }  
              ParentItem:= PreviousItem.GetParent;  
              if Assigned( ParentItem) then  
                try  
                  { вставляем новый пункт меню и в качестве результата функции }  
                  { возвращаем его интерфейс }  
                  Result:= ParentItem.InsertItem( PreviousItem.GetIndex, Caption,  
                  name, '', ShortCut( Word( ShortCutKey), [ssCtrl]), 0, 0,  
                  [mfVisible, mfEnabled], OnClick);  
                finally  
                  { освобождаем интерфейс родительского пункта меню }  
                  ParentItem.Free;  
                end;  
            finally  
              { освобождаем интерфейс пункта меню перед которым вставили }  
              { новый пункт }  
              PreviousItem.Free;  
            end;  
        finally  
          { освобождаем интерфейс пунктов верхнего уровня меню }  
          MenuItems.Free;  
        end;  
    finally  
      { освобождаем интерфейс главного меню IDE }  
      MainMenu.Free;  
    end;  
end;  
  
procedure register;  
begin  
  { регистрируем эксперт }  
  RegisterLibraryExpert( TEMyExpert.Create);  
end;  
  
end.  

В этом примере центральное место занимает функция AddIDEMenuItem, осуществляющая добавление пункта меню в главное меню IDE Delphi. В качестве параметров ей передаются текст нового пункта меню, его идентификатор, идентификатор пункта, перед которым вставляется новый пункт, символьное представление клавиши, которая вместе с клавишей Ctrl может использоваться для быстрого доступа к новому пункту, и обработчик события, соответствующего выбору нового пункта. Мы добавили новый пункт меню в раздел View перед пунктом Watches.

Теперь познакомимся с нотификаторами. Определим add-in нотификатор, отслеживающий моменты закрытия/открытия проектов и корректирующий соответствующим образом поле, хранящее имя активного проекта (реализацию методов, не претерпевших изменений по сравнению с предыдущим примером, для краткости опустим):


unit exmpl_03;  
  
{ ИСПОЛЬЗОВАНИЕ ADD-IN НОТИФИКАТОРОВ }  
interface  
  
uses  
  Classes, Dialogs, ToolIntF, ExptIntf, Menus;  
  
type  
  TEMyExpert = class;  
  
  { касс add-in нотификатора порождаем от TIAddInNotifier}  
  TAddInNotifier = class(TIAddInNotifier)  
  private  
    Expert: TEMyExpert;  
  public  
    constructor Create( anExpert: TEMyExpert);  
    procedure FileNotification( NotifyCode: TFileNotification;  
    const FileName: string; var Cancel: Boolean); override;  
end;  
  
  { класс эксперта является потомком базового класса TIExpert }  
  TEMyExpert = class( TIExpert)  
  private  
    ProjectName: string;  
    MenuItem: TIMenuItemIntf;  
    AddInNotifier: TAddInNotifier;  
  public  
    constructor Create;  
    destructor Destroy; override;  
    function GetName: string; override;  
    function GetStyle: TExpertStyle; override;  
    function GetIDString: string; override;  
    procedure MenuItemClick( Sender: TIMenuItemIntf);  
end;  
  
procedure register;  
  
function AddIDEMenuItem( const Caption, name, PreviousItemName: string;  
const ShortCutKey: Char; OnClick: TIMenuClickEvent): TIMenuItemIntf;  
  
implementation  
  
constructor TAddInNotifier.Create;  
begin  
  inherited Create;  
  Expert := anExpert;  
end;  
  
procedure TAddInNotifier.FileNotification( NotifyCode: TFileNotification;  
const FileName: string; var Cancel: Boolean);  
begin  
  with Expert do  
    case NotifyCode of  
      fnProjectOpened:  
        ProjectName:= FileName; { открытие проекта }  
      fnProjectClosing:  
        ProjectName:= 'unknown' { закрытие проекта }  
    end;  
end;  
  
constructor TEMyExpert.Create;  
begin  
  inherited Create;  
  { добавляем пункт в главное меню IDE Delphi }  
  MenuItem:= AddIDEMenuItem( 'Simple Expert 3', 'ViewMyExpertItem3',  
  {$IFDEF VER130}  
  'ViewWatchesItem', '3', MenuItemClick);  
  {$ELSE}  
  'ViewWatchItem', '3', MenuItemClick);  
  {$ENDIF}  
  try  
    { создаем add-in нотификатор }  
    AddInNotifier:= TAddInNotifier.Create( Self);  
    { регистрируем add-in нотификатор }  
    ToolServices.AddNotifier( AddInNotifier);  
  except  
    AddInNotifier:= nil;  
  end;  
  { инициализируем поле, хранящее имя активного проекта }  
  ProjectName:= ToolServices.GetProjectName;  
end;  
  
destructor TEMyExpert.Destroy;  
begin  
  if Assigned( MenuItem) then  
    MenuItem.Free;  
  if Assigned( AddInNotifier) then  
  begin  
    { снимаем регистрацию add-in нотификатора }  
    ToolServices.RemoveNotifier( AddInNotifier);  
    { уничтожаем add-in нотификатор }  
    AddInNotifier.Free;  
  end;  
  inherited Destroy;  
end;  
  
{ при выборе пункта меню эксперта отображаем сообщение, содержащее }  
{ имя активного проекта }  
procedure TEMyExpert.MenuItemClick( Sender: TIMenuItemIntf);  
begin  
  MessageDlg( 'Current project name is ' + ProjectName,  
  mtInformation, [mbOK], 0);  
end;  
  
...  
  
end.   

Для реализации нотификатора мы определили класс TAddInNotifier, являющийся потомком TIAddInNotifier, и перекрыли метод FileNotification. IDE будет вызывать этот метод каждый раз, когда происходит событие, на которое способен среагировать add-in нотификатор (каждое такое событие обозначается соответствующей константой типа TFileNotification). Поле Expert в классе TAddInNotifier служит для обратной связи с экспертом (метод TAddInNotifier.FileNotification). В деструкторе эксперта регистрация нотификатора снимается, и нотификатор уничтожается.

А теперь проиллюстрируем использование модульных нотификаторов. Создадим add-in эксперт, выдающий сообщения о каждом акте сохранения проектного файла (реализацию уже знакомых нам методов для краткости не приводим):


unit exmpl_04;  
  
{ ИСПОЛЬЗОВАНИЕ МОДУЛЬНЫХ НОТИФИКАТОРОВ }  
  
interface  
  
uses  
  Classes, Dialogs, ToolIntF, ExptIntf, Menus  
  {$IFDEF VER130}, EditIntf{$ENDIF};  
  
type  
  { класс модульного нотификатора порождаем от TIModuleNotifier }  
  TModuleNotifier = class( TIModuleNotifier)  
  private  
    FileName: string;  
  public  
    constructor Create(const aFileName: string);  
    procedure Notify( NotifyCode: TNotifyCode); override;  
    {$IFDEF VER130}  
    procedure ComponentRenamed(ComponentHandle: Pointer;  
    const OldName, NewName: string); override;  
    {$ELSE}  
    procedure ComponentRenamed( const oldName, newName: string); override;  
    {$ENDIF}  
end;  
  
  TEMyExpert = class;  
  
  { класс add-in нотификатора порождаем от TIAddInNotifier}  
  TAddInNotifier = class(TIAddInNotifier)  
  private  
    Expert: TEMyExpert;  
  public  
    constructor Create( anExpert: TEMyExpert);  
    procedure FileNotification( NotifyCode: TFileNotification;  
    const FileName: string; var Cancel: Boolean); override;  
end;  
  
  { класс эксперта является потомком базового класса TIExpert }  
  TEMyExpert = class( TIExpert)  
  private  
    AddInNotifier: TAddInNotifier;  
    ModuleInterface: TIModuleInterface;  
    ModuleNotifier: TModuleNotifier;  
  public  
    constructor Create;  
    destructor Destroy; override;  
    function GetName: string; override;  
    function GetStyle: TExpertStyle; override;  
    function GetIDString: string; override;  
    procedure AddModuleNotifier( const FileName: string);  
    procedure RemoveModuleNotifier;  
end;  
  
procedure register;  
  
implementation  
  
constructor TModuleNotifier.Create(const aFileName: string);  
begin  
  inherited Create;  
  FileName := aFileName;  
end;  
  
procedure TModuleNotifier.Notify( NotifyCode: TNotifyCode);  
begin  
  { если произошло сохранение соответствующего нотификатору файла, }  
  { то выдаем сообщение об этом }  
  if NotifyCode = ncAfterSave then  
    MessageDlg(FileName + 'saved', mtInformation, [mbOK], 0);  
end;  
  
procedure TModuleNotifier.ComponentRenamed;  
begin  
  { ничего здесь не делаем, но метод необходимо перекрыть }   

Добавлено: 02 Августа 2018 07:55:03 Добавил: Андрей Ковальчук

Использование HOOK в Дельфи

Что такое НООК?
НООК - это механизм перехвата сообщений, предоставляемый системой Microsoft Windows. Программист пишет специального вида функцию (НООК-функция), которая затем при помощи функции SetWindowsHookEx вставляется на верх стека НООК-функций системы. Ваша НООК-функция сама решает, передать ли ей сообщение в следующую НООК-функцию при помощи CallNextHookEx или нет.

Какие бывает НООК'и?
НООК бывают глобальные, контролирующие всю систему, так и локальные, ориентированные на какой-либо поток (Thread). Кроме того НООК различаются по типу перехватываемых сообщений (подробнее об этом - ниже). НООК несколько подтормаживают систему, поэтому ставить их рекомендуется только при необходимости, и кактолько необходимость в них отпадает - удалять.

Как создавать НООК?
НООК устанавливается в систему при помощи функции SetWindowsHookEx, вот её заголовок: function SetWindowsHookEx(idHook: Integer; lpfn: TFNHookProc; hmod: HINST; dwThreadId: DWORD): HHOOK;

idHook
константа, определяющая тип вставляемого НООК'а, должна быть одна из нижеследующих констант:
WH_CALLWNDPROC
вставляемая НООК-функция следит за всеми сообщения перед их отпралением в соответствующую оконную функцию
WH_CALLWNDPROCRET
вставляемая НООК-функция следит за всеми сообщениями после их отправления в оконную функцию
WH_CBT
вставляемая НООК-функция следит за окнами, а именно: за созданием, активацией, уничтожением, сменой размера; перед завершением системной команды меню, перед извлечением события мыши или клавиатуры из очереди сообщений, перед установкой фокуса и т.д.
WH_DEBUG
вставляемая НООК-функция следит за другими НООК-функциями.
WH_GETMESSAGE
вставляемая НООК-функция следит за сообщениями, посылаемыми в очередь сообщений.
WH_JOURNALPLAYBACK
вставляемая НООК-функция посылает сообщения, записанные до этого WH_JOURNALRECORD НООК'ом.
WH_JOURNALRECORD
эта НООК-функция записывает все сообщения куда-либо в специальном формате, причем позже они могут быть "воспроизведены" при помощи НООК'а WH_JOURNALPLAYBACK. Это в некотором роде аналог магнитофонной записи сообщений.
WH_KEYBOARD
вставляемая НООК-функция следит за сообщениями клавиатуры
WH_MOUSE
вставляемая НООК-функция следит за сообщениями мыши
WH_MSGFILTER
WH_SHELL
WH_SYSMSGFILTER
lpfn
указатель на непосредственно функцию. Обратите внимание, что если Вы ставите глобальный НООК, то НООК-функция обязательно должна находиться в некоторой DLL!!!
hmod
описатель DLL, в которой находится код функции.
dwThreadId
идентификатор потока, в который вставляется НООК
Подробнее о НООК-функциях сотри справку по Win32API.

Как удалять НООК?
НООК удаляется при помощи функции UnHookWindowsEx.

Пример использования НООК.
Ставим НООК, следящий за мышью (WH_MOUSE). Программа следит за нажатием средней кнопки мыши, и когда она нажимается, делает окно, находящееся непосредственно под указателем, поверх всех остальных (TopMost). Код самой НООК-функции помещен в библиотеку lib2.dll, туда же помещены и функции Start - для установки НООК, и Remove - для удаления НООК.

Файл sticker.dpr

program sticker;  
  
uses windows, messages;  
  
  
var wc : TWndClassEx;  
MainWnd : THandle;  
Mesg : TMsg;  
//экспортируем две функции из библиотеки с НООК'ами  
procedure Start; external 'lib2.dll' name 'Start';  
procedure Remove; external 'lib2.dll' name 'Remove';  
  
function WindowProc(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult; stdcall;  
var nCode, ctrlID : word;  
Begin  
case msg of  
wm_destroy :  
Begin  
Remove;//удаляем НООК  
postquitmessage(0); exit;  
Result:=0;  
End;  
  
else Result:=DefWindowProc(wnd,msg,wparam,lparam);  
end;  
End;  
  
  
begin  
  
wc.cbSize:=sizeof(wc);  
wc.style:=cs_hredraw or cs_vredraw;  
wc.lpfnWndProc:=@WindowProc;  
wc.cbClsExtra:=0;  
wc.cbWndExtra:=0;  
wc.hInstance:=HInstance;  
wc.hIcon:=LoadIcon(0,idi_application);  
wc.hCursor:=LoadCursor(0,idc_arrow);  
wc.hbrBackground:=COLOR_BTNFACE+1;  
wc.lpszMenuName:=nil;  
wc.lpszClassName:='WndClass1';  
  
RegisterClassEx(wc);  
  
  
MainWnd:=CreateWindowEx(0,'WndClass1',  
'Caption',  
ws_overlappedwindow,  
cw_usedefault,cw_usedefault,cw_usedefault,cw_usedefault,0,0,  
Hinstance,nil);  
  
  
ShowWindow(MainWnd,CmdShow);  
  
Start;//вставляем НООК  
  
While GetMessage(Mesg,0,0,0) do  
begin  
TranslateMessage(Mesg);  
DispatchMessage(Mesg);  
end;  
  
end.  

Файл lib2.dpr


library lib2;  
  
  
uses  
windows, messages;  
var  
pt : TPoint;  
theHook : THandle;  
  
function MouseHook(nCode, wParam, lParam : integer) : Lresult; stdcall;  
var  
msg : PMouseHookStruct;  
w : THandle;  
style : integer;  
  
Begin  
if nCode<0 then begin  
result := CallNextHookEx(theHook, nCode, wParam, lParam);  
exit;  
end;  
msg := PMouseHookStruct(lParam);  
  
case wParam of  
WM_MBUTTONDOWN : pt := msg^.pt;  
WM_MBUTTONUP : begin  
w := WindowFromPoint(pt);  
style := GetWindowLong(w, GWL_EXSTYLE);  
if (style and WS_EX_TOPMOST) <> 0 then begin  
//уже поверх всех - сделать обычным  
ShowWindow(w, sw_hide);  
SetWindowPos(w, HWND_NOTOPMOST, 0,0,0,0, SWP_NOMOVE or SWP_NOSIZE OR SWP_SHOWWINDOW);  
end  
else begin  
//сделать поверх остальных   
ShowWindow(w, sw_hide);  
SetWindowPos(w, HWND_TOPMOST, 0,0,0,0, SWP_NOMOVE OR SWP_NOSIZE OR SWP_SHOWWINDOW);  
end;  
  
end;  
end;  
  
  
result := CallNextHookEx(theHook, nCode, wParam, lParam);  
End;  
  
  
procedure Start;  
begin  
  
theHook := SetWindowsHookEx(wh_mouse, @mouseHook, hInstance, 0);  
if theHook = 0 then messageBox(0,'Error!','Error!',mb_ok);  
end;  
  
procedure Remove;  
begin  
UnhookWindowsHookEx(theHook);  
end;  
  
exports  
Start index 1 name 'Start',  
Remove index 2 name 'Remove';  
  
end.  

Всё.

Добавлено: 02 Августа 2018 07:53:24 Добавил: Андрей Ковальчук

Использование Debug API: пример перехвата вызовов функций Win32 API

Эх... Благословясь, приступим к написанию статьи во второй раз. Почему "во второй"? Потому что у меня "посыпался" винт. Это просто рок какой-то: пока я пишу программку на заказ, у меня сначала глюкнул FlashFiler, потом упали Винды, потом грохнулся винт. Интересно, что дальше? Сгорит мать? А потом террористы подсунут бомбу, и я вообще взорвусь?! [Енота: смех - смехом, а ведь правда словно сглазил кто...] Итак:

С ЧЕГО ВСЕ НАЧИНАЛОСЬ:
С начала. Мне нужно было написать перехватчик вызовов WinSock. Дабы любая программа могла работать через SOCKS5-проксик. Я посчитал, что перехват вызовов DLL'ки проще, чем судорожные попытки написать драйвер (да и сейчас так считаю). Енота, правда, ехидно улыбалась и говорила "ну-ну", но я-таки справился. SOCKS сниффер еще пишу, но в принципах перехвата уже разобрался :-) [Енота: разобраться-то он действительно разобрался, а соксифиера нет до сих пор...]

КАК ВСЕ БУДЕТ:
Я предпочитаю не писать сухие статьи с кучей теории. Поскольку я люблю читать работающий исходный код, то и здесь будет только исходный код. Все пояснения я буду вставлять прямо в исходник - в виде комментариев. Впрочем, не надейтесь, что вам будет достаточно выдрать отсюда исходник, и он скомпилится. :-) Это не потому, что я специально что-то скрыл, а потому, что я вырезал кучу вспомогательных процедур, которые каждый может написать сам. Если вы, все же, паталогически ленивы - скачайте архив с полными рабочими исходниками. Оттуда точно заработает.

ИСХОДНИКИ:
Наконец-то... начнем.


procedure DoDebugLoop;  
{ собственно, это главная процедура перехватчика. большую часть времени он крутится именно в ней }  
var  
Event: TDebugEvent;  
{ стандартная Win32 стректура. для интересующихся: 
ЕDebugEvent = record 
dwDebugEventCode: DWORD; 
// тип пришедшего события 
dwProcessId: DWORD; 
// Id прерванного процесса 
dwThreadId: DWORD; 
// Id прерванного потока 
case Integer of 
0: (Exception: TExceptionDebugInfo); 
1: (CreateThread: TCreateThreadDebugInfo); 
2: (CreateProcessInfo: TCreateProcessDebugInfo); 
3: (ExitThread: TExitThreadDebugInfo); 
4: (ExitProcess: TExitThreadDebugInfo); 
5: (LoadDll: TLoadDLLDebugInfo); 
6: (UnloadDll: TUnloadDLLDebugInfo); 
7: (DebugString: TOutputDebugStringInfo); 
8: (RipInfo: TRIPInfo); 
// эти части смотрите сами - не могу же я все разжевывать! :-) 
end; 

следует добавить, что Microsoft - ребята странные. Функция GetThreadContext, при помощи которой реализуется пошаговая отладка и просмотр регистров, требует на входе хэндл процесса. а нам дают только его Id. после безуспешных поисков функции типа ConvertThreadIdToHandle [Енота: мечтатель, однако...] я решил, что придется заводить список запущенных потоков. в событии CREATE_THREAD_DEBUG_EVENT нам дают-таки хэндл. придется запоминать все созданные потоки (не забывая их забывать ( сорри :-) в EXIT_THREAD_DEBUG_EVENT). позже Sleepyhead сказал, что я все придумал очень правильно (ай да Кэтмар! ай да сукин сын! простите, классика :-) - так люди и делают. ну он большой, ему виднее :-) }
dwContinueStatus: DWORD;  
{ как системе обрабатывать событие в ContinueDebugEvent. обнаружилось, что если это событие - не исключение (EXCEPTION_DEBUG_EVENT), то этот флажок системе "по сараю". а если исключение, то есть два варианта: DBG_CONTINUE - наш "отладчик" успешно обработал все сам, и DBG_EXCEPTION_NOT_HANDLED, что значиит - передать исключение системе на обработку }  
CurThread: DWORD;  
{ хэндл потока, найденный в нашем списке потоков (см. замечание чуть повыше) }  
HProc: DWORD;  
{ хэндл процесса, который мы отлаживаем }  
Context: TContext;  
{ контекст потока. проще говоря - содержание его регистров }  
ThreadList: array[0..99] of record Id, Handle: DWORD; end;  
{ тот самый пресловутый список потоков, который мы своими ручками будем создавать и поддерживать. в принципе, это должен быть список или динамический массив, ибо количество потоков, которые может создать программа, заранее не известно, но не будем заморачиваться. код-то демонстрационный! }  
RetAddr: DWORD;  
{ здесь будет храниться адрес возврата из перехваченной API-функции (так, на всякий случай. чтобы вы видели, как и откуда его можно добыть) }  
BPAddr: DWORD;  
{ в учебных целях мы будем перехватывать только одну функцию. поэтому вместо списка обойдемся просто переменной. здесь будет храниться адрес первого байтика перехваченной функции }  
OrigByte: Byte;  
{ а здесь будет храниться сам первый байтик }  
RestoreBreak: Boolean;  
{ флажок, который указывает обработчику события EXCEPTION_SINGLE_STEP надо ли восстанавливать точку останова. весь перехват выглядит так: 
нашли стартовый адрес процедуры (это можно сделать просмотром таблицы экспорта у соответствующей DLL-ки. как именно - здесь не пишу. или разбирайтесь сами, или качайте мои исходники - там все есть. не то чтобы мне жалко, но к Debug API это имеет отношение весьма косвенное. опять же, если народ будет очень интересоваться, сделаю статью с quick overview формата PE); 
запомнили ее первый байт; 
записали вместо первого байта код $CC (это Int3 - DEBUG_EXCEPTION); 
 
по приходу DEBUG_EXCEPTION: 
проверили, точно ли мы прервались на адресе нашей точки останова. если нет - не делаем ничего. иначе: 
восстановили первый байт; 
установили флажок SINGLE_STEP; 
установили флажок ResoteBreak; 
ожидаем прихода события EXCEPTION_SINGLE_STEP; 
 
по приходу EXCEPTION_SINGLE_STEP: 
если установлен флажок RestoreBreak: 
вернули на место $CC; 
сбросили флажок ResoteBreak; }  
ProcessFinished: Boolean;  
{ флажок, указывающий, завершился ли отлаживаемый процесс. Sleepyhead говорит, что иногда процесс не завершается корректно (к примеру, отладчик, который отлаживает отладчик, который отлаживает отладчик... [Енота: GNU's not Unix :-)]), поэтому если процесс не завершится сам, мы прибьем его руками }  
  
begin  
FillChar(ThreadList, SizeOf(ThreadList), 0);  
  
HProc := 0;  
{ хэндл процесса, который будем отлаживать. пока процесс не запущенным считается, соответственно - хэндла нету }  
ProcessFinished := True;  
{ поскольку процесс не запустился, то он считается завершенным :-) }  
BPAddr := 0;  
{ точку останова уточним, когда загрузится нужная DLL }  
RestoreBreak := False;  
  
repeat  
if not WaitForDebugEvent(Event, INFINITE) then break;  
{ ожидаем прихода отладочного события. в реальном отладчике здеесь вместо INFINITE лучше задать маленькую константу, ожидать в цикле, там же в цикле организовывать взаимодействие с юзверем. или вообще для интерфейса отдельный поток создать }  
dwContinueStatus := DBG_EXCEPTION_NOT_HANDLED;  
{ поскольку большинство исключений мы не обрабатываем, то по умолчанию так и говорим системе }  
CurThread := GetThreadHandleFromList(ThreadList, Event.dwThreadId);  
{ просто поиск в массиве ThreadList. Id нам известен, ищем хэндл }  
case Event.dwDebugEventCode of  
{ проверим - а что, собственно случилось? }  
CREATE_PROCESS_DEBUG_EVENT:  
{ запустился новый процесс. запомним его хэндл, и сбросим флажок ProcessFinished }  
begin  
HProc := Event.CreateProcessInfo.HProcess;  
ProcessFinished := False;  
AddThreadToList(ThreadList, Event.dwThreadId, Event.CreateProcessInfo.hThread);  
end;  
EXIT_PROCESS_DEBUG_EVENT:  
{ процесс завершился - значит, можно смело закрывать наш перехватчик. заодно установим флажок ProcessFinished }  
begin  
ProcessFinished := True;  
ContinueDebugEvent(Event.dwProcessId, Event.dwThreadId, DBG_CONTINUE);  
{ это на всякий случай - чтобы ось точно прибила и процесс, и отладчик. в принципе, оно не надо, но смотри выше комментарий к ProcessFinished }  
break; { все, из цикла отладки можно смело выходить }  
end;  
  
CREATE_THREAD_DEBUG_EVENT:  
{ процесс запустил новый поток. здесь у нас есть единственная возможность запомнить его хэндл. так и делаем }  
AddThreadToList(ThreadList, Event.dwThreadId, Event.CreateThread.hThread);  
EXIT_THREAD_DEBUG_EVENT:  
{ процесс завершил исполнение потока. забудем его хэндл }  
DeleteThreadFromList(ThreadList, Event.dwThreadId);  
  
LOAD_DLL_DEBUG_EVENT:  
{ процесс загрузил какую-то DLL'ку. проверим, не та ли это, которая нам нужна. если та, установим точку останова. текст процедуры смотрите ниже }  
ProcessDLLExport(HProc, DWORD(Event.LoadDll.lpBaseOfDll));  
UNLOAD_DLL_DEBUG_EVENT:  
{ процесс выгрузил какую-то DLL'ку. по-правилам, это надо бы обработать, но поскольку я перехватываю вызовы kernel32.dll, который всегда (за очень-очень редким исключением :-) линкуется статически, то это событие я просто игнорирую. а вообще-то надо запомнить адрес загрузки нужной нам DLL в LOAD_DLL_DEBUG_EVENT (ибо это единственный способ идентифицировать DLL'ку), а здесь проверять - не наша ли это. если наша - обнулить BPAddr. можете дописать сами - как любят говорить авторы книг: "в качестве упражнения" :-) [Енота: ага. а сам, когда видит в книге эту фразу, разражается потоком нецензурной лексики :-)] }  
WriteLn('unloading DLL: ', IntToHex(DWORD(Event.UnloadDll.lpBaseOfDll), 8));  
  
EXCEPTION_DEBUG_EVENT:  
{ какое-то исключение. проверим поточнее... }  
case Event.Exception.ExceptionRecord.ExceptionCode of  
EXCEPTION_BREAKPOINT:  
{ это - точка останова. здесь мы уточним: наша или нет. дело в том, что система сама генерирует это событие, когда процесс загрузился, но перед тем, как он запущен (полсе того, как системный загрузчик загрузил процесс и все его DLL'ки. как раз перед тем, как исполнить первую инструкцию процесса). плюс - мало ли, какой код внутри исследуемого процесса может быть? так что... }  
begin  
dwContinueStatus := DBG_CONTINUE;  
{ скажем системе, что это исключение мы обработали сами, пусть не напрягается }  
Context.ContextFlags := CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS;  
GetThreadContext(CurThread, Context);  
{ получили контекст прерванного потока. больше всего нас интересуют IP и Flags. остальные регистры запросили просто для полноты картины }  
if (BPAddr <> 0) and (Context.EIP = BPAddr + 1) then  
begin  
{ если мы уже установили нашу точку останова и прервались именно на ней... }  
RetAddr := ReadProcessLong(HProc, Context.ESP);  
{ то получим адрес возврата из перехваченной нами функции. он нам не нужен, на самом-то деле, это просто пример - откуда его брать. если вам нужны параметры - ReadProcessLong(HProc, Context.ESP + 4) будет первым, ...+ 8) - вторым, и так далее... кстати, ReadProcessLong - просто обертка для системной функции ReadProcessMemory. читает 4 байтика. для удобства. думаю, что у вас не будет проблем сделать себе такую же :-) }  
WriteLn('Return address: 0x', IntToHex(RetAddr, 8));  
{ дальше - уменьшим IP на еденичку (чтобы исполнить ту инструкцию, которую мы заменили на нашу точку останова)... реально, EIP-1 хранится в BPAddr. так и запишем... }  
Context.EIP := BPAddr;  
{ ...и восстановим оригинальный первый байтик этой инструкции }  
WriteProcessByte(HProc, BPAddr, OrigByte);  
{ установим флажок для того, чтобы система генерировала событие EXCEPTION_SINGLE_STEP. в этом событии надо будет вернуть точку останова на место, иначе перехват состоится ровно один раз :-) [Енота: а то бы читатель сам не догадался...] }  
RestoreBreak := True;  
Context.EFlags := Context.EFlags or EFLAGS_TRACE;  
{ вышеприведенной инструкцией мы сообщаем системе, что хотим получать по событию (EXCEPTION_SINGLE_STEP) после каждой исполненной в отлаживаемом процессе машинной команды. кстати, значение константы EFLAGS_TRACE = $100 }  
Context.ContextFlags := CONTEXT_CONTROL;  
SetThreadContext(CurThread, Context);  
{ установим новое значение регистров потока }  
end;  
end;  
EXCEPTION_SINGLE_STEP:  
{ выполнена одна машинная команда. скорее всего, возниконовение этого события - результат выполнения нашей точки останова, но кто знает? проверим флажки. если надо - восстановим точку останова }  
begin  
dwContinueStatus := DBG_CONTINUE;  
{ скажем системе, что это исключение мы обработали сами, пусть не напрягается }  
Context.ContextFlags := CONTEXT_CONTROL;  
GetThreadContext(CurThread, Context);  
if RestoreBreak and (Context.EIP >= BPAddr) and (Context.EIP <= BPAddr + 32) then  
begin  
{ это действительно "наше" событие. восстановим точку останова, чтобы перехватчик работал и дальше }  
OrigByte := WriteInt3(HProc, BPAddr);  
RestoreBreak := False;  
  
Context.EFlags := Context.EFlags and not EFLAGS_TRACE;  
{ сбросим флажок трассировки, ибо больше это событие нам не надо }  
end  
else  
if RestoreBreak then  
Context.EFlags := Context.EFlags or EFLAGS_TRACE;  
{ вернем флажок трассировки, если событие не наше - нам ведь надо нашего дождаться. у меня система сама скидывает сей флаг, так что на всякий случай... }  
  
Context.ContextFlags := CONTEXT_CONTROL;  
SetThreadContext(CurThread, Context);  
end;  
end;  
end;  
  
if not ContinueDebugEvent(Event.dwProcessId, Event.dwThreadId, dwContinueStatus) then break;  
{ все. смело позволяем отлаживаемому процессу исполняться дальше }  
until False;  
{ сюда мы попадем только при каком-нибудь сбое или завершении процесса. на всякий случай (по совету SleepyHead'а) проверим: а точно наш отлаживаемый процесс завершился? если нет - прибьем руками }  
if not ProcessFinished then  
begin  
repeat  
TerminateProcess(HProc, RetAddr);  
if not WaitForDebugEvent(Event, INFINITE) then break;  
if (Event.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT) then break;  
if not ContinueDebugEvent(Event.dwProcessId, Event.dwThreadId, DBG_CONTINUE) then break;  
until False;  
ContinueDebugEvent(Event.dwProcessId, Event.dwThreadId, DBG_CONTINUE);  
end;  
{ все. закончили :-) }  
end;  
  
{ а вот процедурка, которая устанавливает точку останова }  
procedure ProcessDLLExport(PrcH, Base: DWORD);  
var  
DLLName: string;  
ExpTbl: TExportHeader;  
N: DWORD;  
begin  
if (BPAddr <> 0) then exit;  
{ если уже установлена - не делать ничего }  
if not FindExportTable(PrcH, Base, ExpTbl) then exit;  
{ если не смогли найти в DLL'ке таблицу экспорта (мало ли...) - тоже ничего не делать }  
DLLName := ANSILowerCase(GetASCIIZString(PrcH, ExpTbl.NameRVA + Base));  
{ получили имя DLL'ки }  
if (DLLName <> 'kernel32.dll') then exit;  
{ не наша? если да - снова не делаем ничего }  
N := FindExportIndexByName(PrcH, Base, 'AllocConsole', ExpTbl);  
N := FindExportByIndex(PrcH, Base, N, ExpTbl);  
{ нашли по таблице экспорта точку входа (если не нашли - опять же ничего делать не надо }  
if (N = 0) then exit;  
{ а если нашли - запомним необходимую информацию и установим останов }  
BPAddr := N;  
OrigByte := WriteInt3(PrcH, N);  
{ WriteInt3 просто возвращает в качестве результата старый байтик, и на его место записывает код $CC - инструкция Int3. когда система встречает эту инструкцию, она генерирует исключение EXCEPTION_BREAKPOINT }  
end;  

Все. Не так страшен черт, как его малюют [Енота: или: не так страшен Гейтс... :-)]. Остались мелочи.
Если вы запускаете процесс сами, не забудьте указать в CreateProcess флажок DEBUG_ONLY_THIS_PROCESS, чтобы отладчик мог работать, и чтобы процессы, которые может запустить отлаживаемая программа не отлаживались нами (а зачем нам дочерние процессы? если хотим перехватывать вызовы и в них, проще будет ловить непосредственно CreateProcess, и для каждого "новорожденного" запускать свою копию отладчика. Тем более, что если мы присоединяемся к уже запущенному процессу, то система по умолчанию ставит флажок DEBUG_ONLY_THIS_PROCESS. Так что перехватывать CreateProcess надежнее).
Если же вы хотите присоединиться к уже запущенному процессу, то узнайте его Id (с помощью TaskManager в NT или программно), и смело пишите DebugActiveProcess(ProcessId). В дальнейшем никаких различий между работой с процессом, запущенным нами и процессом, к которому мы присоединились "на лету" уже нет.
И еще: учтите, что если наш отладчик завершится, то система автоматически прибьет и процесс, который мы имели счастье отлаживать. Способа "отсоединиться" от процесса нет: взялся за гуж, не говори, что не дюж. :-)
Также замечу, что полезно обрабатывать возможные ошибки при вызове системных функций. Здесь я их - в основном - смело игнорирую, но вам бы лучше так не поступать.

Добавлено: 02 Августа 2018 07:52:01 Добавил: Андрей Ковальчук

Интерфейс переноса Drag-and-Drop

Интерфейс переноса и приема компонентов появился достаточно давно. Он обеспечивает взаимодействие двух элементов управления во время выполнения приложения. При этом могут выполняться любые необходимые операции. Несмотря на простоту реализации и давность разработки, многие программисты (особенно новички) считают этот механизм малопонятным и экзотическим. Тем не менее использование Drag-and-Drop может оказаться очень полезным и простым в реализации. Сейчас мы в этом убедимся.

Для того чтобы механизм заработал, требуется настроить соответствующим образом два элемента управления. Один должен быть источником (Source), второй — приемником (Target). При этом источник никуда не перемещается, а только регистрируется в качестве такового в механизме.

Примечание

Один элемент управления может быть одновременно источником и приемником.

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

После выполнения настройки механизм включается и реагирует на перетаскивание мышью компонента-источника в приемник. Группа методов-обработчиков обеспечивает контроль всего процесса и служит для хранения исходного кода, который разработчик сочтет нужным связать с перетаскиванием. Это может быть передача текста, значений свойств (из одного редактора в другой можно передать настройки интерфейса, шрифта и сам текст); перенос файлов и изображений; простое перемещение элемента управления с места на место и т. д. Пример реализации Drag-and-Drop в Windows — возможность переноса файлов и папок между дисками и папками.

Как видите, можно придумать множество областей применения механизма Drag-and-Drop. Его универсальность объясняется тем, что это всего лишь средство связывания двух компонентов при помощи указателя мыши. А конкретное наполнение зависит только от фантазии программиста и поставленных задач.

Весь механизм Drag-and-Drop реализован в базовом классе TControl, который является предком всех элементов управления. Рассмотрим суть механизма.

Любой элемент управления из Палитры компонентов Delphi является источником в механизме Drag-and-Drop. Его поведение на начальном этапе переноса зависит от значения свойства


type TDragMode = (dmManual, dmAutomatic);  
property DragMode: TDragMode;  

Значение dmAutomatic обеспечивает автоматическую реакцию компонента на нажатие левой кнопки мыши и начало перетаскивания — при этом механизм включается самостоятельно.

Значение dmManual (установлено по умолчанию) требует от разработчика обеспечить включение механизма вручную. Этот режим используется в том случае, если компонент должен реагировать на нажатие левой кнопки мыши как-то иначе. Для инициализации переноса используется метод


procedure BeginDrag(Immediate: Boolean;  
Threshold: Integer = -1); 

Параметр immediate = True обеспечивает немедленный старт механизма. При значении False механизм включается только при перемещении курсора на расстояние, определенное параметром Threshold.

О включении механизма сигнализирует указатель мыши — он изменяется на курсор, определенный в свойстве


property DragCursor: TCursor;   

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

Приемником может стать любой компонент, в котором создан метод-обработчик


procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;  
var Accept: Boolean);  

Он вызывается при перемещении курсора в режиме Drag-and-Drop над этим компонентом. В методе-обработчике можно предусмотреть селекцию источников переноса по нужным атрибутам.

Если параметр Accept получает значение True, то данный компонент становится приемником. Источник переноса определяется параметром source. Через этот параметр разработчик получает доступ к свойствам и методам источника. Текущее положение курсора задают параметры X и Y. Параметр state возвращает информацию о характере движения мыши:


type TDragState = (dsDragEnter, dsDragLeave, dsDragMove); 

dsDragEnter — указатель появился над компонентом; dsDragLeave — указатель покинул компонент; dsDragMove — указатель перемещается по компоненту.

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


type TDragDropEvent = procedure(Sender, Source: TObject; X, Y: Integer)  
of object;  
property OnDragDrop: TDragDropEvent;  

который вызывается при отпускании левой кнопки мыши на компоненте-приемнике. Доступ к источнику и приемнику обеспечивают параметры Source и Sender соответственно. Координаты мыши возвращают параметры X и Y.

При завершении переноса элемент управления — источник — получает соответствующее сообщение, которое обрабатывается методом


type TEndDragEvent = procedure(Sender, Target: TObject; X, Y: Integer)  
of object;  
property OnEndDrag: TEndDragEvent;  

Источник и приемник определяются параметрами Sender и Target соответственно. Координаты мыши определяются параметрами X и Y.

Для программной остановки переноса можно использовать метод EndDrag источника (при обычном завершении операции пользователем он не используется):


procedure EndDrag(Drop: Boolean);   

Теперь настало время закрепить полученные знания на практике. Рассмотрим небольшой пример. В проекте DemoDragDrop на основе механизма Drag-and-Drop реализована передача текста между текстовыми редакторами и перемещение панелей по форме (рис. 27.1).

implementation  
{$R *.DFM)  
procedure TMainForm.EditlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, У: Integer);  
begin if Button = mbLeft  
then TEdit(Sender).BeginDrag(True);  
end;  
procedure TMainForm.Edit2DragOver(Sender, Source: TObject; X, Y: Integer;  
State: TDragState; var Accept: Boolean);  
begin  
if Source is TEdit  
then Accept := True  
else Accept :<= False;  
end;  
procedure TMainForm.Edit2DragDrop(Sender, Source: TObject; X, Y:  
Integer);  
begin  
TEdit(Sender).Text := TEdit(Source).Text;  
TEdit(Sender).SetFocus;  
TEdit(Sender).SelectAll;  
end;  
procedure TMainForm.EditlEndDrag(Sender, Target: TObject; X, Y: Integer);  
begin if Assigned(Target)  
then TEdit(Sender).Text := 'Текст перенесен в ' + TEdit(Target).Name;  
end;  
procedure TMainForm.FormDragOver(Sender, Source: TObject; X, Y: Integer;  
State: TDragState; var Accept: Boolean); begin if Source.ClassName = 'TPanel'  
then Accept := True  
else Accept := False;  
end;  
procedure TMainForm.FormDragDrop(Sender, Source: TObject; X, Y: Integer);  
begin  
TPanel(Source).Left := X;  
TPanel(Source).Top := Y;  
end;  
end.  

Для однострочного редактора Edit1 определены методы-обработчики источника. В методе EditiMouseDown обрабатывается нажатие левой кнопки мыши

и включается механизм переноса. Так как свойство DragMode для Edit1 имеет значение dmManual, то компонент без проблем обеспечивает получение фокуса и редактирование текста.

Метод EditiEndDrag обеспечивает отображение информации о выполнении переноса в источнике.

Для компонента Edit2 определены методы-обработчики приемника. Метод Edit2DragOver проверяет класс источника и разрешает или запрещает прием.

Метод Edit2DragDrop осуществляет перенос текста из источника в приемник.

Примечание

Обратите внимание, что оба компонента TEdit одновременно являются источниками и приемниками. Для этого каждый из них использует методы-обработчики другого. А исходный код методов настроен на обработку владельца как экземпляра класса TEdit.

Форма, как приемник Drag-and-Drop, обеспечивает перемещение панели Panel2, которая выступает в роли источника. Метод FormDragOver запрещает прием любых компонентов, кроме панелей. Метод FormDragDrop осуществляет перемещение компонента.

Панель не имеет своих методов-обработчиков, т. к. работает в режиме dmAutomatic и не нуждается в дополнительной обработке завершения переноса.

Добавлено: 02 Августа 2018 07:49:39 Добавил: Андрей Ковальчук

Изучение работы генератора исходного кода Delphi

В данной статье мы попробуем создать простое приложение с использованием среды delphi и проанализируем работу генератора исходного кода программ.

delphi, по возможности, старается облегчить работу программиста. Когда вы запускаете среду, автоматически создается форма form1 и модуль unit1. Форма представляет собой стандартное окно windows. Вы можете размещать на ней кнопки, надписи, картинки, видео- и аудио фрагменты, а также многое другое. Весь необходимый для создания заготовки формы код уже написан генератором исходного кода delphi.

Рассмотрим текст, расположенный в окне редактора текстов программ:


unit unit1;  
interface  
uses  
windows, messages, sysutils, classes, graphics, controls, forms, dialogs;  
  
type  
tform1 = class(tform)  
private  
{ private declarations }  
public  
{ public declarations }  
end;  
  
var  
form1: tform1;  
  
implementation  
{$r *.dfm}  
end.  

Рассмотрим все строки кода по порядку. Первая строка определяет имя модуля unit1. Вторая строка говорит, что начинается интерфейсная часть модуля (interface). Эта часть содержит сведения о других модулях, которые использует данный модуль (строка uses). Здесь же описываются все типы, переменные, процедуры, функции и константы, используемые в данном модуле. В интерфейсной же части должны быть описаны все глобальные переменные, которые будут использоваться другими модулями. Описание процедур и функций в данной части является неполным: записываются только заголовки функций и процедур. Но размещение таких описаний в интерфейсной части является обязательным.

Посмотрим, что нам записал в интерфейсную часть генератор исходного кода delphi. Итак, здесь определяется тип tform1 относящийся к классу форм delphi. Описание данного класса находится в модуле forms, объявленном в строке uses. Далее объявляется переменная form1, относящаяся к типу tform1. После такого объявления мы можем в любом месте модуля unit1 ссылаться на переменную form1 и выполнять с ней любые возможные действия.

Далее начинается раздел реализации - строка implementation. Именно в этой части модуля находятся полные описания функций и процедур. Здесь же вы можете объявлять переменные, константы, а также другие модули, которые используются только внутри данного модуля и не видны за его пределами, т.е. все локальные переменные. Строка
{$r *.dfm}
записанная в разделе реализации модуля unit1 является директивой препроцессора. Директивы препроцессора - это служебные команды для среды разработки. Все директивы препроцессора имеют вид: {$директива}. Встретив такую директиву, компилятор среды разработки немедленно начинает выполнение каких-либо действий. Список таких директив не очень большой, и если у читателей появится желание узнать о них, мы рассмотрим их в отдельной статье. Указанная выше директива ($r) предназначена для связывания ресурсов. Таким образом, для создания файла ресурсов формы form1, генератор исходного кода добавил данную директиву, указывающую, что все свойства, касающиеся формы form1 (ширина, высота, положение, размер шрифта, заголовок и другие), связанной с модулем unit1 будут храниться в файле ресурсов unit1.dfm. Звездочка здесь обозначает имя модуля. Не рекомендуется удалять или изменять содержимое директив препроцессора, которые генерируются средой delphi самостоятельно. Так как это может привести к ошибкам компиляции приложения

В нашем примере генератором исходного кода не было создано еще два возможных (но не обязательных) раздела: инициализации (initialization) и завершения (finalization). В этих разделах можно размещать операторы и команды, которые должны выполняться, соответственно, в начале и конце работы приложения.

Ну и, естественно, каждый модуль заканчивается строкой
end.

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

Итак, первая форма у нас уже есть, добавим вторую. Для этого выберем пункт главного меню delphi Файл/Новая Форма (file/new form). delphi автоматически создаст новую форму с именем form2 и добавит новую закладку в окне редактора кода: unit2. Разместим на форме form1 две кнопки button1 и button2.

Для этого выберем на панели инструментов пиктограмму кнопки button, щелкнем на ней левой кнопкой мыши, а затем щелкнем левой кнопкой мыши на том месте формы, куда мы хотим поместить кнопку. Готово? Теперь в окне инспектора объектов (object inspector) выберем свойство кнопки caption (заголовок) и напишем вместо button1 слово Переход. Надпись на кнопке сразу изменится. Теперь точно также добавим вторую кнопку и назовем ее Выход. Посмотрим, какие изменения произошли в исходном коде модуля unit1:


unit1:  
unit unit1;  
interface  
uses  
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,  
stdctrls;  
  
type  
tform1 = class(tform)  
button1: tbutton;  
button2: tbutton;  
private  
{ private declarations }  
public  
{ public declarations }  
end;  
  
var  
form1: tform1;  
implementation  
uses unit2;  
{$r *.dfm}  
end.  

В описание uses в интерфейсной части модуля добавился еще один модуль: stdctrls. Данный модуль необходим для работы с компонентом button (кнопка). Кроме того, в описании типа tform1 появились две строки, объявляющие две кнопки button1 и button2, относящихся к типу tbutton.

Теперь добавим такие же кнопки на форму form2. Осталось написать код для обработки события нажатия кнопок. Щелкните дважды по кнопке Переход на форме form1. Генератор исходного кода delphi создаст заготовку для обработчика события нажатия кнопки:


procedure tform1.button1click(sender: tobject);  
begin  
end;  

Добавим между ключевыми словами begin и end следующие строки:


form1.hide; // "прячем" форму form1  
form2.show; // показываем форму form2  

Для кнопки Переход формы form2 напишем следующий код:


form2.hide; // "прячем" форму form2  
form1.show; // показываем форму form1  

Для кнопки Выход в обеих формах напишем следующий код:


procedure tform1.button2click(sender: tobject);  
begin  
application.terminate; // завершение работы приложения  
end;  

Осталось решить главную проблему - описать вызываемые формы в строках uses:


uses:  
implementation  
uses unit2;  
{$r *.dfm}  
для модуля unit1 и  
implementation  
uses unit1;  
{$r *.dfm}  

для модуля unit2.

Как видите, это делается в разделе реализации для каждого модуля. Теперь запустим наше приложение, для этого нажмем клавишу . Кнопка Переход позволяет переключаться между формами, а кнопка Выход - завершить выполнение приложения.

Наше первое приложение написано. На этом мы пока остановимся. В следующей статье мы рассмотрим часть стандартных компонентов delphi из палитры компонентов.

Вячеслав Понамарев

Добавлено: 02 Августа 2018 07:48:19 Добавил: Андрей Ковальчук

Работа с CSV файлами в Delphi

Введение
CSV-файл – простейший по организации файл-таблица, который понимает Microsoft Excel. CSV – Como Separated Value – данные, разделенные запятой. Это обычный текстовый файл, в котором каждая строка олицетворяет ряд таблицы, а разделение этого ряда на колонки осуществляется путем разделения значений специальным разделителем. Обычно роль этого разделителя, судя из названия, играет запятая. Однако, встречается и другой разделитель – точка с запятой. Даже в Microsoft не определились, с каким разделителем должен работать Excel. При сохранении какой-либо таблицы в формате CSV, в качестве разделителя используется точка с запятой. Но, при открытии такого файла с помощью Microsoft Excel, нужно быть очень внимательным, так как, не знаю, шутка это или нет, существует, как Вы знаете два способа открытия файла:

В главном меню программы выбрать пункт «Открыть» из меню «файл».
Найти на жестком диске нужный файл и два раза кликнуть на нем мышкой.
Так вот, при открытии CSV файла первым способом, Excel использует точку с запятой в качестве разделителя, а при открытии вторым способом Excel использует запятую в качестве разделителя. Правда в Microsoft Excel XP эта проблема(?) решена, и используется только точка с запятой, не смотря на название файла.

Работа с CSV файлами в Delphi
Для работы с CSV-файлами в Delphi Вам не понадобятся различные сторонние компоненты. Как я уже говорил, CSV-файл – это обычный текстовый файл. Следовательно, для работы с ним мы будем использовать стандартный тип TextFile определенный в модуле system.

Давайте напишем процедуру для загрузки CSV файла в таблицу TStringGrid. Это стандартный компонент Delphi для работы со строковыми таблицами. Находится он на странице Additional в палитре компонентов Delphi.

Вот код этой процедуры:


procedure LoadCSVFile (FileName: String; separator: char);  
var f: TextFile;  
    s1, s2: string;  
    i, j: integer;  
begin  
 i := 0;  
 AssignFile (f, FileName);  
 Reset(f);  
 while not eof(f) do  
 begin  
   readln (f, s1);  
   i := i + 1;  
   j := 0;  
   while pos(separator, s1)<>0 do  
    begin  
     s2 := copy(s1,1,pos(separator, s1)-1);  
     j := j + 1;  
     delete (s1, 1, pos(separator, S1));  
     StringGrid1.Cells[j-1, i-1] := s2;  
    end;  
   if pos (separator, s1)=0 then  
    begin  
     j := j + 1;  
     StringGrid1.Cells[j-1, i-1] := s1;  
    end;  
   StringGrid1.ColCount := j;  
   StringGRid1.RowCount := i+1;  
  end;  
 CloseFile(f);  
end;  

Теперь разберем этот код.


procedure LoadCSVFile (FileName: String; separator: char);  

Это заголовок нашей процедуры. В качестве параметров мы передаем ей имя файла и разделитель данных.


AssignFile (f, FileName);  
Reset(f);  

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


while not eof(f) do  
  begin  
   readln (f, s1);  

Пока не достигнут конец файла, читаем из него очередную строку.

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


while pos(separator, s1)<>0 do  
 begin  
  s2 := copy(s1,1,pos(separator, s1)-1);  
  j := j + 1;  
  delete (s1, 1, pos(separator, S1));  
  StringGrid1.Cells[j-1, i-1] := s2;  
 end;  
if pos (separator, s1)=0 then  
 begin  
  j := j + 1;  
  StringGrid1.Cells[j-1, i-1] := s1;  
 end;  
StringGrid1.ColCount := j;  
StringGRid1.RowCount := i+1;  

Ну вот, пожалуй, и все что я хотел написать.

Добавлено: 02 Августа 2018 07:46:55 Добавил: Андрей Ковальчук

Пишем компонент - окно выбора папки

Среди стандартных диалогов Delphi 6 (вкладка Dialogs) диалог выбора папки, как это не прискорбно, отсутствует. Но ничего, сейчас мы исправим данное упущение, написав соответствующий компонент.

Чтобы создать новый компонент, в Delphi IDE выберите пункт File > New > Other и затем в появившемся окне нажмите New Component. Появится диалоговое окно, в котором:

Ancensor type (класс-предок нового компонента) - введите TComponent;
Class Name (имя нового класса) - TBrowseFolderDlg;
Palette Page (имя вкладки: поместим наш диалог вместе со стандартными дельфийскими) - Dialogs.
Остальное оставьте без изменений и нажмите OK. Наш мегадиалог будет вызываться функцией, продекларированной в Public Declarations компонента:


function BrowseFolder(title: PChar; h: hwnd): String;  

Где title - заголовок диалога (поставьте любой на ваш вкус), h - хэндл окна-владельца (то есть вашей программы). А команды, использованные в коде, содержатся в ShlObj.pas, так что не забудьте указать этот модуль в разделе uses.


unit BrowseFolderDlg;  
   
interface  
   
uses  
Windows, Messages, SysUtils, Classes, Controls, ShlObj;  
   
type  
  TBrowseFolderDlg = class(TComponent)  
  private  
    { Private declarations }  
  protected  
    { Protected declarations }  
  public  
    { Public declarations }  
    function BrowseFolder(title: PChar; h: hwnd): String;  
  published  
    { Published declarations }  
end;  
   
procedure Register;  
   
implementation  
   
procedure Register;  
begin  
  RegisterComponents('Dialogs', [TBrowseFolderDlg]);  
end;  
   
function TBrowseFolderDlg.BrowseFolder(title: PChar; h: hwnd): String;  
var  
  lpItemID: PItemIDList;  
  path: array[0..Max_path] of char; //выбранная папка  
  BrowseInfo: TBrowseInfo; //настройки диалога  
begin  
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);  
  SHGetSpecialFolderLocation(h,csidl_desktop,BrowseInfo.pidlRoot);  
  //устанавливаем свойства диалогового окна  
  with BrowseInfo do  
    begin   
    hwndOwner := h; //окно-владелец  
    lpszTitle := title; //заголовок диалога  
    //не показываем некоторые системные папки: "Корзина", "Панель управления" и т.д  
    ulFlags := BIF_RETURNONLYFSDIRS+BIF_EDITBOX+BIF_STATUSTEXT;  
  end;  
  //выводим диалог  
  lpItemID := SHBrowseForFolder(BrowseInfo);  
  //папка, указанная юзером, существует?  
  if lpItemId <> nil then  
    begin   
    SHGetPathFromIDList(lpItemID, Path);  
    result:=path;  
    GlobalFreePtr(lpItemID); //освобождаем ресурсы  
  end;  
end;  
   
end.  

Готово? Сохранитесь и, выбрав Component > Install Component, проинсталлируйте наш диалог, указав в разделе Unit File Name путь к файлу BrowseFolderDlg.pas.

Осуществить вызов диалога из программы можно так (разумеется, предварительно бросив TBrowseFolderDlg на форму):


procedure TForm1.Button1Click(Sender: TObject);  
begin  
  Form1.Caption:= 'Выбрана следующая папка: '+  
  BrowseFolderDlg1.BrowseFolder('Укажите каталог:',Application.Handle);  
end;  

Конечно, это только "скелет" полноценного компонента, и просторы для модернизации безграничны.

Добавлено: 02 Августа 2018 07:45:21 Добавил: Андрей Ковальчук

Отображение округленного окошка подсказок для значка приложения в System Tray

В Windows 2000 и выше, формат структуры NotifyIconData, которая используется для работы с иконками в Трее (которая, кстати, называется "The Taskbar Notification Area") значительно отличается от предыдущий версий Windows. Однако, эти изменения НЕ отражены в юните ShellAPI.pas в Delphi 5.

Итак, нам понадобится преобразованный SHELLAPI.H, в котором присутствуют все необходимые объявления:


uses Windows;  
   
type  
  NotifyIconData_50 = packed record // определённая в shellapi.h  
  cbSize: DWORD;  
  Wnd: HWND;  
  uID: UINT;  
  uFlags: UINT;  
  uCallbackMessage: UINT;  
  hIcon: HICON;  
  szTip: array[0..MAXCHAR] of AnsiChar;  
  dwState: DWORD;  
  dwStateMask: DWORD;  
  szInfo: array[0..MAXBYTE] of AnsiChar;  
  uTimeout: UINT; // union with uVersion: UINT;  
  szInfoTitle: array[0..63] of AnsiChar;  
  dwInfoFlags: DWORD;  
end{record};  
   
const  
  NIF_INFO = $00000010;  
   
  NIIF_NONE = $00000000;  
  NIIF_INFO = $00000001;  
  NIIF_WARNING = $00000002;  
  NIIF_ERROR = $00000003;  

А это набор вспомогательных типов:

type  
  TBalloonTimeout = 10..30{seconds};  
  TBalloonIconType = (bitNone, // нет иконки  
  bitInfo, // информационная иконка (синяя)  
  bitWarning, // иконка восклицания (жёлтая)  
  bitError); // иконка ошибки (красная)  

Теперь мы готовы приступить к созданию округлённых подсказок! Для этого воспользуемся следующей функцией:

uses SysUtils, Windows, ShellAPI;  
   
function BalloonTrayIcon(const Window: HWND; const IconID: Byte;   
  
const Timeout: TBalloonTimeout; const BalloonText,  
BalloonTitle: String; const BalloonIconType: TBalloonIconType): Boolean;  
const  
  aBalloonIconTypes : array[TBalloonIconType] of Byte = (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);  
var  
  NID_50 : NotifyIconData_50;  
begin  
  FillChar(NID_50, SizeOf(NotifyIconData_50), 0);  
  with NID_50 do  
  begin  
    cbSize := SizeOf(NotifyIconData_50);  
    Wnd := Window;  
    uID := IconID;  
    uFlags := NIF_INFO;  
    StrPCopy(szInfo, BalloonText);  
    uTimeout := Timeout * 1000;  
    StrPCopy(szInfoTitle, BalloonTitle);  
    dwInfoFlags := aBalloonIconTypes[BalloonIconType];  
  end{with};  
  Result := Shell_NotifyIcon(NIM_MODIFY, @NID_50);  
end;  

Вызывается она следующим образом:

BalloonTrayIcon(Form1.Handle, 1, 10, 'this is the balloon text', 'title', bitWarning);  

Иконка, должна быть предварительно добавлена с тем же дескриптором окна и IconID (в данном примере Form1.Handle и 1).

Можете попробовать все три типа иконок внутри всплывающей подсказки.

Несколько заключительных замечаний:

Нет необходимости использовать большую структуру NotifyIconData_50 для добавления или удаления иконок, старая добрая структура NotifyIconData прекрасно подойдёт для этого.
Для callback сообщения можно использовать WM_APP + что-нибудь.
Используя различные IconID, легко можно добавить несколько различных иконок из одного родительского окна и работать с ними по их IconID.

Добавлено: 02 Августа 2018 07:43:52 Добавил: Андрей Ковальчук

Клонирование объектов

Создать копию объекта в Delphi очень просто. Конвертируем объект в текст, а затем - обратно. При этом будут продублированы все свойства, кроме ссылок на обработчики событий. Для преобразования компонента в файл и обратно нам понадобятся функции потоков WriteComponent(TComponent) и ReadComponent(TComponent). При этом в поток записывается двоичный ресурс. Последний с помощью функции ObjectBinaryToText можно преобразовать в текст.
Создадим на их основе функции преобразования:


function ComponentToString(Component: TComponent): string;   
var   
  ms: TMemoryStream;   
  ss: TStringStream;   
begin   
  ss := TStringStream.Create(' ');   
  ms := TMemoryStream.Create;   
  try   
    ms.WriteComponent(Component);   
    ms.position := 0;   
    ObjectBinaryToText(ms, ss);   
    ss.position := 0;   
    Result := ss.DataString;   
  finally   
    ms.Free;   
    ss.free;   
  end;   
end;   
   
procedure StringToComponent(Component: TComponent; Value: string);   
var   
  StrStream:TStringStream;   
  ms: TMemoryStream;   
begin   
  StrStream := TStringStream.Create(Value);   
  try   
    ms := TMemoryStream.Create;   
    try   
      ObjectTextToBinary(StrStream, ms);   
      ms.position := 0;   
      ms.ReadComponent(Component);   
    finally   
      ms.Free;   
    end;   
  finally   
    StrStream.Free;   
  end;   
end;  

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


object Form1: TForm1   
  Left = 262   
  Top = 129   
  Width = 525   
  Height = 153   
  Caption = 'Form1'   
  Color = clBtnFace   
  Font.Charset = DEFAULT_CHARSET   
  Font.Color = clWindowText   
  Font.Height = -11   
  Font.Name = 'MS Sans Serif'   
  Font.Style = []   
  OldCreateOrder = False   
  Scaled = False   
  PixelsPerInch = 96   
  TextHeight = 13   
  object Button1: TButton   
    Left = 16   
    Top = 32   
    Width = 57   
    Height = 49   
    Caption = 'Caption'   
    TabOrder = 0   
    OnClick = Button1Click   
  end   
end   
   
procedure TForm1.Button1Click(Sender: TObject);   
var   
  Button: TButton;   
  OldName: string;   
begin   
  Button := TButton.Create(self);   
   
  //...сохраняем имя компонента   
  OldName := (Sender as TButton).Name;   
   
  //...стираем имя компонента, чтобы избежать конфликта имен.  
  //...После этого Button1 станет = nil.   
  (Sender as TButton).Name := '';   
   
  //...преобразуем в текст и обратно   
  StringToComponent( Button, ComponentToString(Sender as TButton) );   
   
  //...дадим компоненту уникальное(?) имя   
  Button.Name := 'Button' + IntToStr(random(1000));   
   
  //...вернем исходному компоненту имя.  
  //...После этого Button1 станет снова указывать на объект.   
  (Sender as TButton).Name := OldName;   
   
  //...размещаем новую кнопку справа от исходной   
  Button.parent := self;   
  Button1.Tag := Button1.Tag + 1;   
  Button.Left := Button.Left + Button.Width * Button1.Tag + 1;   
end;  

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

Добавлено: 02 Августа 2018 07:42:51 Добавил: Андрей Ковальчук

Работа с HTML-справкой в программах

Удобно вендрять данную систему в самом начале разработки программы. Но я опишу способ внедрения в целом.

В раздел глобальных переменных добавьте следующие переменные для работы со справкой:


_HHwinHwnd: HWND = 0; HHCtrlHandle: THandle = 0; mHelpFile: String;  

Сразу после раздела глобальных переменных и перед implementation вставьте следующие строки кода:


var  
  HtmlHelpA: function(hwndCaller: HWND; pszFile: PAnsiChar; uCommand: UInt; dwData: DWORD): HWND; stdcall;  
  HtmlHelpW: function(hwndCaller: HWND; pszFile: PWideChar; uCommand: UInt; dwData: DWORD): HWND; stdcall;  
  HtmlHelp: function(hwndCaller: HWND; pszFile: PChar; uCommand: UInt; dwData: DWORD): HWND; stdcall;  
   
const  
  hhctrlLib = 'hhctrl.ocx';  
  HH_DISPLAY_TOPIC = $0000;  
  HH_HELP_CONTEXT = $000F;  
  HH_CLOSE_ALL = $0012;  

Где-нибудь в самом начале раздела implementation вставьте код:


const hhPathRegKey = 'CLSID\{adb880a6-d8ff-11cf-9377-00aa003b7a11}\InprocServer32';  
   
function GetPathToHHCtrlOCX: string;  
var Reg: TRegistry;  
begin  
  result := ''; //default return  
  Reg := TRegistry.Create;  
  Reg.RootKey := HKEY_CLASSES_ROOT;  
  if reg.OpenKeyReadOnly(hhPathRegKey) then  
    begin  
    result := Reg.ReadString(''); Reg.CloseKey;  
    if (result <> '') and (not FileExists(result)) then result := '';  
  end;  
  Reg.Free;  
end;  
   
procedure LoadHtmlHelp;  
var OcxPath: string;  
begin  
  if HHCtrlHandle = 0 then  
  begin  
    OcxPath := GetPathToHHCtrlOCX;  
    if (OcxPath <> '') and FileExists(OcxPath) then  
    begin  
      HHCtrlHandle := LoadLibrary(PChar(OcxPath));  
      if HHCtrlHandle <> 0 then  
      begin  
        @HtmlHelpA := GetProcAddress(HHCtrlHandle, 'HtmlHelpA');  
        @HtmlHelpW := GetProcAddress(HHCtrlHandle, 'HtmlHelpW');  
        @HtmlHelp := GetProcAddress(HHCtrlHandle, 'HtmlHelpA');  
      end;  
    end;  
  end;  
end;  
   
procedure UnloadHtmlHelp;  
begin  
  if HHCtrlHandle <> 0 then  
  begin  
    FreeLibrary(HHCtrlHandle);  
    HHCtrlHandle := 0;  
  end;  
end;  

В OnCreate главной формы приложения добавьте:


mHelpFile := ExtractFilePath(ParamStr(0)) + 'Help.chm';  
mHelpFile := ExpandFileName(mHelpFile);  
LoadHtmlHelp;  
if HHCtrlHandle = 0 then  
  ShowMessage('HTML-справка не поддерживается системой');  

В обработчике пункта меню для загрузки справки (например, Справка - Содержание) пишем:


if HHCtrlHandle = 0 then  
  showmessage('Справка не поддерживается')  
else  
  HtmlHelp(Handle,PChar(mHelpFile+'::/Pages/topic1.htm'),HH_DISPLAY_TOPIC,0);  

При выходе из программы необходимо закрыть все открытые окна справки, поэтому в OnClose главной формы добавляйте строку:


HtmlHelp(0, nil, HH_CLOSE_ALL, 0);  

Часто в программах делают другие пункты меню, соответствующие разделам справки. Вот как их загружать:


HtmlHelp(Handle,PChar(mHelpFile+'::/путь/страница.htm'),HH_DISPLAY_TOPIC,0);  

Аналогичным образом можно загружать любой необходимый раздел справки.

Добавлено: 02 Августа 2018 07:41:59 Добавил: Андрей Ковальчук