Создание COM-сервера

Всем привет!

Чем отличается программист от другого типа человека разумного?
Я думаю, постоянным желанием подшутить над братом меньшим - Человеком нормальным, благо способов для этого - великое множество. В реестре Windows неограниченное количество мест для автоматического запуска программ - сейчас нас интересует расширение оболочки - контекстное меню Эксплорера. Займемся созданием +СОМ-сервера который будет запускаться при вызове контекстного меню.
Сразу оговорюсь - на компе потенциального испытуемого должна стоять звуковая карта и, желательно, антивирус Касперского, чтобы испытуемому был хорошо известен вопль AVP при обнаружении вируса.

Для начала, создадим файл ресурса содержащего нужный нам вопль.
Создаем текстовый файл, пишем в нем на одной строке:

MYWAVE RCData C:\Temp\Infected.wav

(вместо C:\Temp\Infected.wav пишете реальный путь к *.wav файлу)
Сохраняем файл с именем WAVE.RC. Далее выполняем команду:

brcc32.exe C:\Temp\Wave.rc

(вместо C:\Temp\Wave.rc пишете реальный путь к Wave.rc файлу)
У нас получился файл ресурсов Wave.res который мы будем использовать дальше.

В примерах Delphi есть почти все, что нам нужно:
..:\Program Files\Borland\Delphi7\Demos\ActiveX\ShellExt\ContextM.pas

Немножко редактируем этот файл (в смысле выбрасываем ненужное - добавляем нужное) и получаем примерно это:

unit Unit1;

interface

uses
Windows, ActiveX, ComObj, Classes,
Dialogs, StdCtrls,
ShlObj;

type
TInitWormHook = class(TComObject, IShellExtInit, IContextMenu)
protected
{ IShellExtInit }
function IShellExtInit.Initialize = SEIInitialize;
function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
{ IContextMenu }
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
end;

function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
function DllCanUnloadNow: HResult; stdcall;

const
Class_ContextMenu: TGUID = ‘{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}’;

implementation

uses ComServ, SysUtils, ShellApi, Registry, Graphics, mmSystem;

//Цепляем наш ресурс
{$R wave.res}

function TInitWormHook.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
begin
Result := NOERROR;
end;

function TInitWormHook.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
idCmdLast, uFlags: UINT): HResult;
begin
Result := 0;
end;

function TInitWormHook.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
Result := NOERROR;
end;

function TInitWormHook.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
Result := NOERROR;
end;

type
TInitWormHookFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;

//А это - наша процедура по извлечению звука из файла ресурса
procedure RUNWAV;
var
WaveHandle: THandle;
WavePointer: pointer;
begin
WaveHandle:= FindResource(hInstance, ‘MYWAVE’, RT_RCDATA);
if WaveHandle <> 0 then
begin
WaveHandle := LoadResource(hInstance, WaveHandle);
if WaveHandle <> 0 then
begin;
WavePointer:= LockResource(WaveHandle);
sndPlaySound(WavePointer, snd_Memory or SND_ASYNC);
UnlockResource(WaveHandle);
FreeResource(WaveHandle);
end;
end;
end;

procedure TInitWormHookFactory.UpdateRegistry(Register: Boolean);
var
ClassID: string;
begin
if Register then begin
inherited UpdateRegistry(Register);
ClassID := GUIDToString(Class_ContextMenu);
CreateRegKey(’Directory\shellex\ContextMenuHandlers\WAV’, ”, ClassID);
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey(’SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions’, True);
OpenKey(’Approved’, True);
WriteString(ClassID, ‘FTP simple client’);
finally
Free;
end;
end
else begin
DeleteRegKey(’Directory\shellex\ContextMenuHandlers\WAV’);
inherited UpdateRegistry(Register);
end;
end;

function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;
begin
Result:=ComServ.DllGetClassObject(CLSID, IID, Obj);
if Result = S_OK then begin
try
RUNWAV;
except
end;
end;
end;

function DllCanUnloadNow: HResult;
begin
Result := ComServ.DllCanUnloadNow;
if Result = S_OK then begin
try
RUNWAV;
except
end;
end;
end;

initialization
TInitWormHookFactory.Create(ComServer, TInitWormHook, Class_ContextMenu,
”, ‘FTP simple client’, ciMultiInstance,
tmApartment);
end.

Теперь нам нужно скомпилировать из этого модуля DLL-ку. Пишем проект ShWave.dpr:

library ShWave;

uses
ComServ,
Unit1 in ‘Unit1.pas’;

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
begin
end.

После компиляции получаем ShWave.dll

Мы получили +СОМ-сервер, теперь осталось его подключить к контекстному меню. Пишем файл реестра Install.reg:

REGEDIT4

[HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}\InprocServer32]
@=”ShWave.dll”
“ThreadingModel”=”Apartment”

[HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\WAV]
@=”{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}”

[HKEY_CLASSES_ROOT\Directory\shellex\ContextMenuHandlers\WAV]
@=”{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}”

Закидываем файл ShWave.dll в %SystemRoot%\System32, запускаем Install.reg и при попытке использования контекстного меню будет звучать вопль AVP или тот, который вы сами зашили в ресурс.

Вместо \*\ можно использовать любое расширение файлов и СОМ-сервер будет активизироваться только при щелчке правой кнопкой мыши на файлах выбранного типа.

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

REGEDIT4

[-HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}\InprocServer32]

[-HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}]

[-HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\WAV]

[-HKEY_CLASSES_ROOT\Directory\shellex\ContextMenuHandlers\WAV]

Вот и все.

Июль 28, 2008 — Рубрика: Delphi
Метки: ,

Web-страничка внутри приложения

Многие спрашивают: как сделать, чтобы приложение могло содержать в себе различные компоненты в Web-стиле, включая HTML-ресурсы и картинки, которые являются частью проекта… Данная статья показывает, как можно легко добавить в Delphi-приложение HTML-страницу и связанные с ней файлы (в данном случае картинки).

1. Создание HTML страницы

Для начала мы должны создать простую страницу HTML. Для этого можно использовать любой HTML-редактор. Создадим, к примеру, страничку с одним изображением и назовём этот файл aboutindex.htm. Обратите внимание, что при добавлении картинки внутрь html-страницы, в её исходнике появляется следующая строка:

Нам необходимо подправить тэг IMG так, чтобы атрибут SRC совпадал с именем, которое мы укажем в ресурсах:

Вот пример небольшой страницы:

HTML inside a Delphi exe

This is a HTML Delphi resource test:

2. Создание и компиляция файла ресурсов

Запомните: для того, чтобы создать новый скрипт-файл ресурсов, необходимо:
1. Создать новый текстовый файл в директории Вашего проекта.
2. Переименовать его в *.rc-файл (у нас будет AHTMLDelphi.rc).
3. Добавить следующие две строки текста в созданный файл *.rc (AHTMLDelphi.rc):

DELPHIINDEX HTML “c:\Delphi\projects\aboutindex.htm”
ABOUTDP GIF “c:\library\graphics\adp.gif”

Таким образом, мы подготовили одну HTML-страницу и одну картинку GIF, которые будут включены в исполняемый EXE-модуль.

Следующий шаг - это компиляция .rc файла. Для компиляции файла AHTMLDelphi.rc в файл .res, выполните следующую команду из командной строки (в директории Вашего проекта):

BRCC32 AHTMLDelphi.RC

Заключительный шаг - это добавление директивы компилятора в unit Вашего проекта. Следующая строка заставляет компилятор включить в проект файл RES:

{$R AHTMLDelphi.RES}

3. Отображение внутри Web-браузера

После того, как Вы получите exe-файл приложения (назовём его, например, myhtmldelphi.exe), то HTML ресурсы, содержащиеся в нём, могут быть доступны через протокол RES: . Запустите Internet Explorer и в адресной строке напишите следующее:

res://c:\myhtmldelphi.exe/DELPHIINDEX

В самом приложении отображать страницы можно, например, с помощью TWebBrowser.

Июль 15, 2008 — Рубрика: Delphi
Метки: ,

Создание своего диалога выбора цвета

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

В общем приступим! Сначала создаём форму и помещаем туда всё необходимое:

7 компонентов типа TImage и назовём их так:

• MainViewer – экран вывода градиента;

• ScalKontr – определяет присутствие изменяемого компонента RGB цвета в градиенте (если выбран R _ GB - то красного, если G _ RB – то зелёного, если B _ RG – то синего) от 0 до 255, путем нажатия курсора на нужную область.

• Yarcost – шкала яркости выбранного оттенка.

• Proba 1 – для выода цвета, находящегося под курсором при выборе насыщенности компонентом ScalKontr.

• Proba 2 – для вывода оттенка, находящегося под курсором при выборе результата и яркости с помощью MainViewer или Yarcost.

• ImageZahvat – для вывода выбранной в ScalKontr насыщенности.

• Itog – для вывода выбранного оттенка.

12 Edit-ов , 3 RadioButton и 2 кнопки . Их оставим в покое (в смысле не переименовываем).

Теперь нам необходимо определиться с необходимыми процедурами.

Во-первых – это процедура генерирования шкалы контраста.
Во-вторых – это процедура генерирования градиента в MainViewer (в соответствии с выбранным типом градиента и выбранной насыщенностью).
В-третьих – процедура генерирования шкалы яркости, в соответствии с выбранным оттенком.

Начнём с первого. Сам нижеприведённый код я поместил в обработчик OnCreate формы.

Пояснения смотрите в комментариях к коду:

var
LineColor, ViewColor: TColor;
ColR, ColG, ColB, i, j:integer;
begin
{Если выбран баланс Красного с Синим и Зелёным (R_GB)}
if RadioButton1.Checked then
begin
ColR:=255;
ColG:=0;
ColB:=0;
for j:=0 to 255 do
begin
LineColor:=RGB(255-j, 0, 0); //Изменяем значение красного цвета
for i:=0 to 17 do
begin
ScalKontr.Canvas.Pixels[i, j]:=LineColor; //рисуем точку
end;
end;
end;
{Если выбран баланс Зелёного с Красным и Синим (G_RB)}
if RadioButton2.Checked then
begin
ColR:=0;
ColG:=255;
ColB:=0;
for j:=0 to 255 do
begin
LineColor:=RGB(0, 255-j, 0); //Изменяем значение зелёного цвета
for i:=0 to 17 do
begin
ScalKontr.Canvas.Pixels[i,j]:=LineColor; //рисуем точку
end;
end;
end;

{Если выбран баланс Синего с Красным и Зелёным (B_RG)}
if RadioButton3.Checked then
begin
ColR:=0;
ColG:=0;
ColB:=255;
for j:=0 to 255 do
begin
LineColor:=RGB(0, 0, 255-j); //Изменяем значение синего цвета
for i:=0 to 17 do
begin
ScalKontr.Canvas.Pixels[i,j]:=LineColor; //рисуем точку
end;
end;
end;

Думаю здесь всё понятно. Далее приступим к основной процедуре рисования градиента в MainViewer. Вот код:

{========================================================== Процедура генерации RGB-градиента}
procedure GenerateRGBInOutGrad(ClrOutR, ClrOutG, ClrOutB: Integer);
var
i, j: Integer; //счётчики
PixelColor: TColor; //цвет пиксела
Holst: TBitMap; //Объект для записи пикселей
begin
Holst:=TBitMap.Create; //создаём объект типа TBitMap
Holst.Width:=256; //указываем ширины
Holst.Height:=256; //указываем высоту

if ClrDialog.RadioButton1.Checked then //если выбрана RadioButton1
begin
{Палитра красного с зелёным и синим}
for j:=0 to 255 do //цикл по оси Y
begin
for i:=0 to 255 do //цикл по оси X
begin
PixelColor:=RGB(ClrOutR, j, i); {привязываем значения зелёного и синего к
изменениям координат и переводим из RGB в
TColor}
Holst.Canvas.Pixels[i, j]:=PixelColor; //Рисуем точку
end;
end;
end;

if ClrDialog.RadioButton2.Checked=true then //если выбрана RadioButton2
begin
{Палитра зелёного с красным и синим}
for j:=0 to 255 do //цикл по оси Y
begin
for i:=0 to 255 do //цикл по оси X
begin
PixelColor:=RGB(j, ClrOutG, i); {привязываем значения красного и синего к
изменениям координат и переводим из RGB в
TColor}
Holst.Canvas.Pixels[i, j]:=PixelColor; //Рисуем точку
end;
end;
end;

if ClrDialog.RadioButton3.Checked=true then //если выбрана RadioButton3
begin
{Палитра синего с красным и зелёным}
for j:=0 to 255 do //цикл по оси Y
begin
for i:=0 to 255 do //цикл по оси X
begin
PixelColor:=RGB(j, i, ClrOutB); {привязываем значения красного и зелёного к
изменениям координат и переводим из RGB в
TColor}
Holst.Canvas.Pixels[i, j]:=PixelColor; //Рисуем точку
end;
end;
end;
ClrDialog.MainViewer.Canvas.Draw(0,0,Holst); //рисуем всю картину на компонент TImage
Holst.Free; //освобождаем память, занимаемую объёктом Holst
end;

Вот!

Ну и, наконец, код вывода шкалы яркости:

{========================================================== Процедура генерации полосы яркости выбранного оттенка}
procedure GenerYarkost(ColR, ColG, ColB: Real);
var
i, j: integer; //счётчики
LineColor: TColor; //цвет TColor
StepR, StepG, StepB: Real; {шаг изменения для каждого цвета,
необходимы для равномерного смешивания
цветов по всей длине линии яркости . }
begin
ClrDialog.Edit4.Text:=IntToStr(round(ColR)); {Эти строки}
ClrDialog.Edit5.Text:=IntToStr(round(ColG)); {нужны лишь в моём}
ClrDialog.Edit6.Text:=IntToStr(round(ColB)); {примере. В Вашем
может и не понадобятся.}

{+++++++++++++++++++++++++++++++++++++++}

{Генерация шкалы яркости для выбранного оттенка}
StepR:=(256-ColR)/256; //определение шага для красного
StepG:=(256-ColG)/256; //определение шага для зелёного
StepB:=(256-ColB)/256; //определение шага для синего

j:=256; //здесь счётчику по Y-ку присваивается начальное значение
repeat j:=j-1; {Цикл по Y-ку организован с помощью repeat until чтобы
организовать обратный отсчёт от 256 до 1. Это сделано
для того, чтобы заполнять шкалу не с верху вниз, а снизу
вверх (т.к. начальная точка экранных координат
расположена в верхнем правом углу.)}

ColR:=ColR+StepR; {В каждом переходе цикла по Y}
ColG:=ColG+StepG; {увеличиваем значение соответствующего цвета}
ColB:=ColB+StepB; {на соответствующий ему шаг.}
for i:=0 to 17 do
begin
{На всякий случай проверим значения цветов на вхождение
в пределы 255}
if ColR>255 then ColR:=255;
if ColG>255 then ColG:=255;
if ColB>255 then ColB:=255;

LineColor:=RGB(round(ColR), round(ColG), round(ColB)); //Записываем оттенок
ClrDialog.Yarcost.Canvas.Pixels[i, j]:=LineColor; //Рисуем точку в компонент TImage
end;
until j=1;
end;

Вот в принципе все необходимые процедуры для написания такого диалога. Всё остальное – дело техники и это вы найдёте в примере к статье. Правда есть ещё один момент, который необходимо описать – это перевод из TColor в RGB формат. Чисто для примера сделаем 3 переменные типа integer (пусть это будут ColR , ColG и ColB ) и одну переменную типа TColor (Например, ColTColor). Далее присвоим значение переменной ColTColor. Пусть это будет зелёный (clGreen). Ну и, наконец, выделим из этой переменной значения RGB компонентов в соответствующие переменные типа integer. Весь код :

procedure TestTColorToRGB;
var
ColR, ColG, ColB: integer;
ColTColor: TColor;
begin
ColTColor:=clGreen; //присваиваем зелёный цвет

ColR:= ColTColor mod $100; //выделяем красный
ColG:=( ColTColor div $100) mod $100; //выделяем зелёный
ColB:= ColTColor div $10000; //выделяем синий
end;

У переменных должны получиться следующие значения:

ColR = 0;
ColG = 255;
ColB = 0.

Вот и всё. Конечно, для крутого графического редактора этого мало, но ведь можно и дополнить чем-нибудь ещё!

Июль 4, 2008 — Рубрика: Delphi
Метки: , ,

Дополнительные функции обработки строк:

В модуле StrUtils.pas содержатся полезные функции для обработки строковых переменных. Чтобы подключить этот модуль к программе, нужно добавить его имя (StrUtils) в раздел Uses.

1) PosEx(SubStr, Str: String; Offset: Integer) - функция аналогична функции Pos(), но позволяет задать отступ от начала строки для поиска. Если значение Offset задано (оно не является обязательным), то поиск начинается с символа Offset в строке. Если Offset больше длины строки Str, то функция возратит 0. Также 0 возвращается, если подстрока не найдена в строке. Пример:

uses StrUtils;
{ … }
var Str1, Str2: String; P1, P2: Integer;
{ … }
Str1:=’Hello! How do you do?’;
Str2:=’do’;
P1:=PosEx(Str2, Str1, 1); { P1 = 12 }
P2:=PosEx(Str2, Str1, 15); { P2 = 19 }

2) Функция AnsiReplaceStr(Str, FromText, ToText: String) - производит замену выражения FromText на выражение ToText в строке Str. Поиск осуществляется с учётом регистра символов. Следует учитывать, что функция НЕ изменяет самой строки Str, а только возвращает строку с произведёнными заменами. Пример:

uses StrUtils;
{ … }
var Str1, Str2, Str3, Str4: String;
{ … }
Str1:=’ABCabcAaBbCc’;
Str2:=’abc’;
Str3:=’123′;
Str4:=AnsiReplaceStr(Str1, Str2, Str3); { Str4 = “ABC123AaBbCc” }

3) Функция AnsiReplaceText(Str, FromText, ToText: String) - выполняет то же самое действие, что и AnsiReplaceStr(), но с одним исключением - замена производится без учёта регистра. Пример:

uses StrUtils;
{ … }
var Str1, Str2, Str3, Str4: String;
{ … }
Str1:=’ABCabcAaBbCc’;
Str2:=’abc’;
Str3:=’123′;
Str4:=AnsiReplaceText(Str1, Str2, Str3); { Str4 = “123123AaBbCc” }

4) Функция DupeString(Str: String; Count: Integer) - возвращает строку, образовавшуюся из строки Str её копированием Count раз. Пример:

uses StrUtils;
{ … }
var Str1, Str2: String;
{ … }
Str1:=’123′;
Str2:=DupeString(Str1, 5); { Str2 = “123123123123123″ }

5) Функции ReverseString(Str: String) и AnsiReverseString(Str: AnsiString) - инвертируют строку, т.е. располагают её символы в обратном порядке. Пример:

uses StrUtils;
{ … }
var Str1: String;
{ … }
Str1:=’0123456789′;
Str1:=ReverseString(Str1); { Str1 = “9876543210″ }

6) Функция IfThen(Value: Boolean; ATrue, AFalse: String) - возвращает строку ATrue, если Value = True и строку AFalse если Value = False. Параметр AFalse является необязательным - в случае его отсутствия возвращается пустая строка.

uses StrUtils;
{ … }
var Str1, Str2: String;
{ … }
Str1:=IfThen(True, ‘Yes’); { Str1 = “Yes” }
Str2:=IfThen(False, ‘Yes’, ‘No’); { Str2 = “No” }

Мы рассмотрели функции, позволяющие выполнять со строками практически любые манипуляции. Как правило, вместо строки с указанным типом данных, можно использовать и другой тип - всё воспринимается одинаково. Но иногда требуются преобразования. Например, многие методы компонент требуют параметр типа PChar, получить который можно из обычного типа String функцией PChar(Str: String):

uses ShellAPI;
{ … }
var FileName: String;
{ … }
FileName:=’C:\WINDOWS\notepad.exe’;
ShellExecute(0, ‘open’, PChar(FileName), ”, ”, SW_SHOWNORMAL);

Тип Char представляет собой один-единственный символ. Работать с ним можно как и со строковым типом. Для работы с символами также существует несколько функций:

Chr(Code: Byte) - возвращает символ с указанным кодом (по стандарту ASCII):

var A: Char;
{ … }
A:=Chr(69); { A = “E” }

Ord(X: Ordinal) - возвращает код указанного символа, т.е. выполняет противоположное действие функции Chr():

var X: Integer;
{ … }
X:=Ord(’F'); { X = 70 }

Из строки можно получить любой её символ - следует рассматривать строку как массив. Например:

var Str, S: String; P: Char;
{ … }
Str:=’Hello!’;
S:=Str[2]; { S = “e” }
P:=Str[5]; { P = “o” }

В этой статье описаны основные приёмы работы со строковыми типами данных. Как правило, этих данных достаточно для написания любого алгоритма.

Июль 1, 2008 — Рубрика: Delphi
Метки: , ,