Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Система";
Текущий архив: 2002.02.04;
Скачать: [xml.tar.bz2];

Вниз

Проблема с Hook !!!!!!!   Найти похожие ветки 

 
PavelS   (2001-10-18 10:48) [0]

Есть клиент и сервер.
Посылаю на клиент команду установить хук на клавиатуру (у меня это процедура HookOn), но хук почему-то не ставится. Еще если например добавить в обработчик хука вывод showmessage, то он начинает работать пока не закрыт showmessage.

Если же я в клиенте например кнопке на событие клик ставлю HookOn - то срабатывает.

Использую компоненты Indy.


 
Виктор Щербаков   (2001-10-18 11:44) [1]

Еще если например добавить в обработчик хука вывод showmessage,
то он начинает работать пока не закрыт showmessage.

Если хук глобальный, то это вполне естественно, ведь ловушка присоединяется ко всем процессам, которые получают клав. ввод: в одном процессе - ShowMessage висит, в остальных - нет.

Для полной ясности всё равно исходник нужен.


 
PavelS   (2001-10-18 13:22) [2]

Немного уточну - мне необходимо клавиатуру блокировать. Пробовал вместо хука использовать BlockInput – тоже самое – при посылке от клиента (на другом компе) к серверу блокирования клавиатуры не происходит.
Вот исходники клиента, сервера и библиотеки

Бибилиотека: hook.dpr


library Project1;
uses Windows,
Messages;
var
HookDeTeclado:HHook;

function CallBackDelHook(Code:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
beep(100,100);
Result:=1;
//CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;

procedure HookOn;stdcall;
begin
HookDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelHook, HInstance , 0);
end;

procedure HookOff; stdcall;
begin
UnhookWindowsHookEx(HookDeTeclado);
end;
exports
HookOn,
HookOff;
begin
end.


Сервер: Server.dpr


program Server;
uses
Forms,
ServerMain in "ServerMain.pas" {frmServer};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TfrmServer, frmServer);
Application.Run;
end.


ServerMain.pas:


unit ServerMain;
interface
uses
SysUtils,Classes,forms,windows,IdBaseComponent,IdComponent,IdTCPServer;
const
HookDLL="hook.dll";
type
THookKeyboard=procedure;stdcall;
type
TfrmServer = class(TForm)
TCPServer: TIdTCPServer;
procedure FormCreate(Sender: TObject);
procedure TCPServerExecute(AThread: TIdPeerThread);
procedure FormDestroy(Sender: TObject);
private
HandleDLL:THandle;
HookOn,HookOff:THookKeyboard;
public
end;
var
frmServer:TfrmServer;

implementation
{$R *.dfm}

procedure TfrmServer.FormCreate(Sender: TObject);
begin
HandleDLL:=LoadLibrary(PChar(ExtractFilePath(Application.Exename)+HookDLL ) );
if HandleDLL = 0 then raise Exception.Create("NO DLL");
@HookOn :=GetProcAddress(HandleDLL, "HookOn");
@HookOff:=GetProcAddress(HandleDLL, "HookOff");

IF not assigned(HookOn) or not assigned(HookOff) then
raise Exception.Create("Cannot find the required DLL functions");
TCPServer.Active := True;
end;

procedure TfrmServer.TCPServerExecute(AThread: TIdPeerThread);
var s:string;
begin
with AThread.Connection do
begin
s:=ReadLn;
if s="Стоп" then
begin
hookon;
end;
if s="Старт" then
begin
hookoff;
end;
Disconnect;
end;
end;

procedure TfrmServer.FormDestroy(Sender: TObject);
begin
hookoff;
if HandleDLL<>0 then FreeLibrary(HandleDLL);
end;
end.


ServerMain.dfm


object frmServer: TfrmServer
Left = 359
Top = 227
BorderStyle = bsSingle
Caption = "RemoteServer"
ClientHeight = 98
ClientWidth = 205
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object TCPServer: TIdTCPServer
Bindings = <>
DefaultPort = 9999
OnExecute = TCPServerExecute
Left = 16
Top = 8
end
end


Клиент: client.dpr


program Client;
uses
Forms,
Unit1 in "Unit1.pas" {Form1};
{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.


Unit1.pas


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient;

type
TForm1 = class(TForm)
TCPClient: TIdTCPClient;
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;

var
Form1: TForm1;
implementation
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
TCPClient.Host:=Edit1.Text;
with TCPClient do
begin
try
Connect;
try
TCPClient.WriteLn("Стоп");
finally
Disconnect;
end;
except
ShowMessage("Компьютер не доступен или неверно введен адрес");
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TCPClient.Host:=Edit1.Text;
with TCPClient do
begin
try
Connect;
try
TCPClient.WriteLn("Старт");
finally
Disconnect;
end;
except
ShowMessage("Компьютер не доступен или неверно введен адрес");
end;
end;
end;
end.


Unit1.dfm – создайте сами, а то сообщение слишком большое



 
Knight   (2001-10-18 17:18) [3]

Спасибо, пригодится!


 
PavelS   (2001-10-19 16:00) [4]

ПОМОГИТЕ ПЛЗ !!!

Если я напрямую(например при щелчке на кнопку) из программы сервера ставлю хук, то все ОК. а если программа сама ставит (послаю команду на установку), то ничего не происходит. ХОТЯ процедура установки одна и таже


 
PavelS   (2001-10-23 19:33) [5]

HELP !!



Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2002.02.04;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.004 c
3-8787
Андре
2002-01-08 10:24
2002.02.04
dbiRegenIndexes


3-8776
roman001
2002-01-05 21:15
2002.02.04
SQL


14-8973
Fay
2001-12-10 06:50
2002.02.04
Что означает слово


1-8891
Unholy()
2002-01-16 00:39
2002.02.04
Помогите найти следующие компоненты...


14-8975
Вячеслав_
2001-10-10 05:13
2002.02.04
1C:Предприятие





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский