3. СОЗДАНИЕ ПРОГРАММНЫХ ЛОВУШЕК В DELPHI
unit Loader_DLL_TSN;
…
var
Form1: TForm1;
procedure hook(switch : Boolean); stdcall; external 'hook_dll_tsn.dll';
const IDM_TSN=$C0;
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
var h: HWND; p, pp: HMENU;
begin
h:=FindWindow('SciCalc',nil); if h=0 then winexec('calc',SW_SHOW);
h:=FindWindow('SciCalc',nil); if h=0 then exit else SetForegroundWindow (h);
hook(true); // Устанавливаем наш перехватчик событий Windows
p:=GetMenu(h); // Верхнее меню
// Меняем название пункта в верхнем меню "Справка"
ModifyMenu(p, 2, MF_BYPOSITION, GetMenuItemID(p,2), '-TSN-' );
pp:= GetSubMenu(p,2); // Подпункты в верхнем меню (с нуля отсчет)
// Меняем название подпункта в подменю "Справка -> О программе"
ModifyMenu(pp, 2, MF_BYPOSITION, GetMenuItemID(pp,2) , 'About Sergius …' );
// Добавляем новый элемент подменю с идентификатором IDM_TSN
AppendMenu(pp, MF_STRING ,IDM_TSN, 'А это новый пункт !');
DrawMenuBar(h); // Прорисовываем модифицированное меню
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
{ при закрытии формы – освобождаем Hook }
var h: HWND;
begin
hook(false); // Деактивизируем наш перехватчик событий Windows
h:=FindWindow('SciCalc',nil);
h:=FindWindow('SciCalc',nil); if h<>0 then Postmessage(h,WM_QUIT,0,0);
end;
end.
library HOOK_DLL_TSN;
uses Windows, Messages, SysUtils;
var SysHook: HHook = 0; Wnd: Hwnd = 0;
const IDM_TSN=$C0;
function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;forward;
{Процедура установки HOOK-а}
procedure hook(switch : Boolean) export; stdcall;
begin
if switch=true then
// Устанавливаем хук на сообщения после их обработки в приложении
// Наша процедура захвата называется "SysHook", в данном модуле
SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMsgProc, HInstance, 0)
else UnhookWindowsHookEx(SysHook);
end;
function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
{ Обработчик перехвата }
label 1;
var dc: HDC; h, h2: HWND; x: cardinal; ss: string;
begin
{ Если нам не стоит обрабатывать это событие, то и не надо,
передадим упраление следующиму хуку }
if (code<0) or (code<>HC_ACTION) then goto 1;
// Ищем калькулятор, если он не запущен, но отдыхаем …
h:=FindWindow('SciCalc',nil); if h=0 then goto 1;
h2:=GetWindow(h,GW_CHILD); // Нашли окно отображения (табло) у кальулятора
// Если калькулятор не виден, то ничего не надо …
if not IsWindowVisible(h) then goto 1;
// Получаем указатель на текущее обрабатываемое окно, ждем калькулятор
Wnd:=TMsg(Pointer(lParam)^).hwnd;
// Механизм нашей прорисовки на калькуляторе для любого окна
ss:='Кликни правой по калку …';
dc:=GetDC(h); SetBkMode(dc, TRANSPARENT);
TextOut(dc,15,4,pansichar(ss),length(ss));
// –
x:=TMsg(Pointer(lParam)^).message; // Получаем код сообщения окна
// Запрещаем щелкать по окошку калькулятора
if (wnd=h2) and (x=WM_LBUTTONDOWN) then begin
MessageBox(0, 'Нельзя !!!', 'Щелкать по окошку',0 );
TMsg(Pointer(lParam)^).message:=0; // Анулируем сообщение
end;
// Механиз обработки "нашего" пункта меню в калькуляторе
if (wnd=h) and (x=WM_COMMAND)
and (lo(TMsg(Pointer(lParam)^).wParam) = IDM_TSN)
then MessageBox(0, 'Да!', 'Калькулятор говорит', 0);
{ Передаем сообщение дальше по цепочке hook-ов }
1: Result:=CallNextHookEx(SysHook, Code, wParam, lParam);
end;
exports hook;
begin
end.
ЛЕКЦИЯ №8
1. РАБОТА С ПРИЛОЖЕНИЕМ «MS WORD»
unit main;
uses … ComCtrls, WordXP, OleServer, Variants;
type TForm1 = class(TForm)
…
wa: TWordApplication;
wd: TWordDocument;
var Form1: TForm1; t, tt, vv: OleVariant; // параметры для передачи
implementation
…
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
wa := wa.Create(nil); // создаем экземпляр Word
wa.Visible := true; // делаем его видимым
t := 'Normal'; // шаблон
tt := false; // не создавть шаблон
wa.Documents.Add(t, tt, EmptyParam, EmptyParam); // добавляем документ
// подключаем к объекту WordDocument созданный документ
wd.ConnectKind := ckAttachToInterface; wd.ConnectTo(wa.ActiveDocument);
t := wd.Range; // переменная – параметр, шаблон для нового абзаца
// добавляем в документ 3 абзаца:
wd.Paragraphs.Add(t); wd.Paragraphs.Add(t); wd.Paragraphs.Add(t); // абзац #3
wd.Paragraphs.Item(1).Range.InsertBefore('Привет, TSN !!!'); // вставляем текст в абзац #1
// вставляем текст в абзац #2
wd.Paragraphs.Item(2).Range.InsertBefore('Переключившись в программу, можно программно менять текст ячеек !');
wd.Paragraphs.Item(1).Range.Font.ColorIndex := 11; // цвет зеленый в абзаце #1
wd.Paragraphs.Item(2).Range.Font.ColorIndex := 5; // цвет розовый в абзаце #2
wd.Paragraphs.Item(3).Range.Font.Bold := 1; // шрифт – жирный
wd.Paragraphs.Item(3).Range.Font.Italic := 1; // шрифт – рукописный
// добавляем таблицу
wd.Tables.Add(wd.Paragraphs.Item(3).Range, 5, 4, EmptyParam, EmptyParam); // 5-строк, 4- cтолбца
wd.Tables.Item(1).Range.Font.ColorIndex := 2; // цвет синий в таблице
// в цикле задаем значение ячеек, добавляем текст
for i := 1 to 5 do wd.Tables.Item(1).Cell(i, 1).Range.Text := IntToStr(i);
end;
procedure TForm1.FormDestroy(Sender: TObject);
var s: OleVariant; // для параметров
begin
try
s:=False; //изменения не сохранять
wd.Close(s,EmptyParam,EmptyParam); // закрыть сначала документ
wa.Quit(s,EmptyParam,EmptyParam); // а потом и ворд
except end; // ничего не предпринимаем, если ворд уже закрыт
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
// в соотв ячейку ставим соотв значение, а можно и наоборот
wd.Tables.Item(1).Cell(UpDown2.Position,UpDown1.Position).Range.Text:=Edit3.Text;
end;
end.