Форум: "Основная";
Текущий архив: 2004.02.06;
Скачать: [xml.tar.bz2];
ВнизПочему не работает следующий код... Найти похожие ветки
← →
pasha_golub (2004-01-21 15:18) [40]В догонку, 4 окно - это окно формы в режиме дизайна.
← →
Юрий Зотов (2004-01-21 16:11) [41]> AKul © (21.01.04 14:02) [37]
Конечно, сама переменная GlobalData будет для каждого процесса своя и будет располагаться в его АП по своему собственному адресу. Но это и не важно, а важно лишь то, чтобы общим для всех процессов было ее содержимое GlobalData ^ и чтобы именно оно адресовало к разделяемым данным.
> AKul © (21.01.04 14:15) [38]
Это уже, скорее, из области реинжеиринга (как сейчас почему-то стало модно говорить). Ломать собственную программу, конечно, можно, а иногда даже и нужно, но в данном случае - зачем? Разве в ней есть что-то такое, что требует именно таких технологий? Вроде как, ничего особенного в ней нет.
> WED
Короче говоря, привожу реально работающий пример Shell Hook. В нем нет проверки на повторный запуск, но ее несложно добавить.
Это полный код DLL (код EXE см. в следующем посте).
library DLL;
uses
Windows, Messages;
const
MapID = "Global Hook Demo";
type
PData = ^TData;
TData = record
AppWnd: HWND;
OldHook: HHOOK
end;
var
HMap: THandle = 0;
Data: PData = nil;
procedure DLLEntryPoint(dwReason: DWORD); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
HMap := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TData), MapID);
Data := MapViewOfFile(HMap, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TData))
end;
DLL_PROCESS_DETACH:
begin
UnMapViewOfFile(Data);
CloseHandle(HMap)
end
end
end;
function ShellHook(Code: Integer; ParamW: WPARAM; ParamL: LPARAM): LRESULT; stdcall;
begin
if Code in [HSHELL_WINDOWCREATED, HSHELL_WINDOWDESTROYED, HSHELL_REDRAW] then
SendMessage(Data^.AppWnd, WM_USER + 100, ParamW, Code);
Result := CallNextHookEx(Data^.OldHook, Code, ParamW, ParamL)
end;
function SetShellHook(Wnd: HWND): BOOL; stdcall;
begin
if Data <> nil then
begin
Data^.AppWnd := Wnd;
Data^.OldHook := SetWindowsHookEx(WH_SHELL, @ShellHook, HInstance, 0);
Result := Data^.OldHook <> 0
end
else Result := False
end;
function RemoveShellHook: BOOL; stdcall;
begin
Result := UnhookWindowsHookEx(Data^.OldHook)
end;
exports
SetShellHook,
RemoveShellHook;
begin
if DLLProc = nil then
DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH)
end.
← →
Юрий Зотов (2004-01-21 16:16) [42]А это код главной формы EXE (код DPR - стандартный). Текст DFM к ней см. в следующем посте.
unit AppUnit;
interface
uses
Windows, Messages, Classes, Controls, Forms, StdCtrls;
type
TAppMainForm = class(TForm)
WndList: TListBox;
ClearButton: TButton;
procedure ClearButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure WMUserPlus100(var Message: TMessage); message WM_USER + 100;
protected
procedure CreateWnd; override;
end;
var
AppMainForm: TAppMainForm;
implementation
{$R *.DFM}
const
DLLName = "DLL.dll";
function SetShellHook(Wnd: HWND): BOOL; stdcall; external DLLName name "SetShellHook";
function RemoveShellHook: BOOL; stdcall; external DLLName name "RemoveShellHook";
function GetWndText(Wnd: HWND): string;
var
L: Integer;
begin
L := GetWindowTextLength(Wnd) + 1;
if L > 1 then
begin
SetLength(Result, L);
GetWindowText(Wnd, @Result[1], L);
end
else Result := "???"
end;
{ TAppMainForm }
procedure TAppMainForm.WMUserPlus100(var Message: TMessage);
var
I: Integer;
begin
case Message.LParam of
HSHELL_WINDOWCREATED:
WndList.Items.AddObject(GetWndText(Message.WParam), TObject(Message.WParam));
HSHELL_WINDOWDESTROYED:
begin
I := WndList.Items.IndexOfObject(TObject(Message.WParam));
if I >= 0 then WndList.Items.Delete(I)
end;
HSHELL_REDRAW:
begin
I := WndList.Items.IndexOfObject(TObject(Message.WParam));
if I >= 0 then WndList.Items[I] := GetWndText(Message.WParam)
end
end
end;
procedure TAppMainForm.ClearButtonClick(Sender: TObject);
begin
WndList.Clear
end;
procedure TAppMainForm.CreateWnd;
begin
inherited;
if not SetShellHook(Handle) then
MessageBox(Handle, "Unable to set hook", PChar(Application.Title), MB_OK or MB_ICONHAND)
end;
procedure TAppMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not RemoveShellHook then
MessageBox(Handle, "Unable to remove hook", PChar(Application.Title), MB_OK or MB_ICONHAND)
end;
end.
← →
Юрий Зотов (2004-01-21 16:17) [43]И, наконец, текст DFM.
object AppMainForm: TAppMainForm
Left = 298
Top = 140
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = "AppMainForm"
ClientHeight = 456
ClientWidth = 583
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = "MS Sans Serif"
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
PixelsPerInch = 120
TextHeight = 16
object WndList: TListBox
Left = 9
Top = 8
Width = 565
Height = 405
ItemHeight = 16
TabOrder = 0
end
object ClearButton: TButton
Left = 254
Top = 424
Width = 75
Height = 25
Caption = "Clear"
TabOrder = 1
OnClick = ClearButtonClick
end
end
← →
WED (2004-01-22 10:43) [44]2 Юрий Зотов:
В твоем коде в DLL в строке
if DLLProc = nil then
ругается:
Not enough actual parameters
Вот так.
← →
pasha_golub (2004-01-22 10:46) [45]WED © (22.01.04 10:43) [44]
Хм, странно.
← →
WED (2004-01-22 10:56) [46]Попробовал убрать эту строку, т.е. сделать вот так:
begin
DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
Результат: При открытие какого-нть окна всё ок. А при закрытии
RunTime Error
← →
WED (2004-01-22 10:58) [47]гм. Ошибся - при создании окна (при запуске какой-нть проги) тоже ошибка...
← →
WED (2004-01-22 14:12) [48]2 Юрий Зотов: Не могли бы Вы, уважаемый, глянуть в чем проблема?
← →
Юрий Зотов (2004-01-22 14:28) [49]> WED © (22.01.04 10:43) [44]
> WED © (22.01.04 10:56) [46]
> WED © (22.01.04 10:58) [47]
Код писался уже давно, в D5, и там компилировался без проблем. Компилятор D7 (только что проверил) действительно ругается на строку if DLLProc = nil then. Посмотрел в исходники. Причина в том, что Borland изменила объявление переменной DLLProc - раньше она была просто Pointer, а теперь стала TDLLProc (объявления TDLLProc в исходниках нет, но и так ясно, что это процедурный тип для DLLEntryPoint). Кстати, интересно, что в справке D7 по-прежнему написано - Pointer.
Решение очевидно - операция взятия адреса. Всего один символ:
if @DLLProc = nil then
после чего все компилируется без проблем.
А также без проблем запускается, без проблем работает и без проблем завершается. Только что проверил (D7, W2K Server).
А до этого проверял при разработке этого примера (D5, W98, ME, NT4+SP6, W2K). А после его первой публикации (здесь же, года два назад) он проверялся уже не одним человеком (а может, и не одним десятком человек). И тоже без вопросов (правда, пара-тройка человек все же ругалась, но потом выяснилось, что они сначала изменили код, а потом начали говорить, что он не работает).
Поэтому очень похоже, что либо Вы тоже изменили код, либо что-то у Вас не так в системе.
> All
Просьба к тем, у кого установлена XP - проверьте код. Кто его знает, может быть, он и правда несовместим с XP. Хотя и слабо в это верится, но чем черт не шутит...
Страницы: 1 2 вся ветка
Форум: "Основная";
Текущий архив: 2004.02.06;
Скачать: [xml.tar.bz2];
Память: 0.55 MB
Время: 0.079 c