информационная безопасность
без паники и всерьез
 подробно о проектеRambler's Top100
Страшный баг в WindowsАтака на InternetПортрет посетителя
BugTraq.Ru
Русский BugTraq
 Анализ криптографических сетевых... 
 Модель надежности двухузлового... 
 Специальные марковские модели надежности... 
 Три миллиона электронных замков... 
 Doom на газонокосилках 
 Умер Никлаус Вирт 
главная обзор RSN блог библиотека закон бред форум dnet о проекте
bugtraq.ru / форум / programming
Имя Пароль
ФОРУМ
все доски
FAQ
IRC
новые сообщения
site updates
guestbook
beginners
sysadmin
programming
operating systems
theory
web building
software
hardware
networking
law
hacking
gadgets
job
dnet
humor
miscellaneous
scrap
регистрация





Легенда:
  новое сообщение
  закрытая нитка
  новое сообщение
  в закрытой нитке
  старое сообщение
  • Напоминаю, что масса вопросов по функционированию форума снимается после прочтения его описания.
  • Новичкам также крайне полезно ознакомиться с данным документом.
Кидаю 05.06.03 12:39  Число просмотров: 1371
Автор: ASJinx Статус: Незарегистрированный пользователь
<"чистая" ссылка>
dll - ка

library hook;

uses
SysUtils,
Windows,
Messages;

function CBTProc(code: integer; wparam: integer;lparam: integer):LRESULT; stdcall
begin
//пока ничего нету так как неработает с двумя
end;

function GetMsgProc(code: integer; wparam: integer;lparam: integer):LRESULT; stdcall
var pp: ^MSG;

begin
pp:=pointer(lparam);
if (pp.message=274) then pp.message:=0;
if (pp.message=80) then begin
SendMessage(FindWindow('TForm1','Form1'),WM_CHAR,97,0);
end;
Result:=0;
end;

exports
CBTProc,
GetMsgProc;

begin
end.

Фрагмент проги

type
TForm1 = class(TForm)
SLV: TShellListView;
PM1: TPopupMenu;
View1: TMenuItem;
Icons1: TMenuItem;
List1: TMenuItem;
SmallIcons1: TMenuItem;
Bevel1: TBevel;
BB1: TBitBtn;
Timer1: TTimer;
BB2: TBitBtn;
Exit1: TMenuItem;
Color1: TMenuItem;
CD1: TColorDialog;
Folder1: TMenuItem;
OD1: TOpenDialog;
Password1: TMenuItem;
CB1: TComboBox;
L1: TLabel;
BB3: TButton;
Button2: TButton;
Close1: TMenuItem;
Timer2: TTimer;
procedure FormCreate(Sender: TObject);
procedure Icons1Click(Sender: TObject);
procedure List1Click(Sender: TObject);
procedure SmallIcons1Click(Sender: TObject);
procedure BB1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BB2Click(Sender: TObject);
procedure SLVContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure Color1Click(Sender: TObject);
procedure Folder1Click(Sender: TObject);
procedure Password1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
function ChangeLayout(LANG: Integer): Boolean;
procedure BB3Click(Sender: TObject);
procedure CB1Select(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure MyPanelClk(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
start: boolean;
procedure ChrHook(var Mes: TWMChar); message WM_CHAR;
procedure WM_MouseActivateEvent(var Mes : TWMMouseActivate); message WM_MouseActivate;
procedure AddPanel(var i: byte; hi: hicon; Activ: boolean);
public
root: boolean;
reg: tregistry;
psw: string;
rus: boolean;
end;
var
Form1: TForm1;
h, h1:hhook;
libhandle:HINST;
hkprcKeyboard: TFNHookProc;
MPanel: array of TPanel;
PanelCount: byte;
implementation

procedure TForm1.FormCreate(Sender: TObject);
const
RSP_SIMPLE_SERVICE=1;
var tmp: string;
i: integer;
hInstKernel: LongWord;
AdrRegSerProc: function (dwProcessId: dword; dwType: dword): dword; stdcall;
begin
// это я из панели задач убираю
hInstKernel := LoadLibrary ('KERNEL32.DLL');
if (hInstKernel<>0) then begin
@AdrRegSerProc:=GetProcAddress(hInstKernel, 'RegisterServiceProcess');
if (@AdrRegSerProc<>nil) then
AdrRegSerProc(0,RSP_SIMPLE_SERVICE);
FreeLibrary (hInstKernel);
end;

// тут вешаю хуки. все отлично, пока не дойдет до конца процедуры и тогда глюки. Если ProcCBT или GetMsgProc оставить один, то работает
libhandle:=LoadLibrary('hook.dll');
hkprckeyboard:=GetProcAddress(libhandle, 'GetMsgProc');
h:=SetWindowsHookEX(WH_GETMESSAGE,hkprckeyboard,libhandle,0);
hkprckeyboard:=GetProcAddress(libhandle, 'CBTProc');
h1:=SetWindowsHookEX(WH_CBT,hkprckeyboard,libhandle,0);

start:=true;
Exit1Click(sender);
start:=false;


// Дальше чтение из реестра исходных параметров и установка
формы и всякой билиберды, я это пропущу

PanelCount:=0;
end;

// Эта фигня для обратной связи хука проц GetMsgProc с формой
procedure TForm1.ChrHook(var Mes: TWMChar);
begin
if mes.CharCode=97 then
if CB1.ItemIndex=0 then begin
cb1.ItemIndex:=1;
rus:=false;
end else begin
cb1.ItemIndex:=0;
rus:=true;
end;
end;

// Там еще много всякой фигни которая к хукам не имеет отношения



<programming> Поиск 






Rambler's Top100
Рейтинг@Mail.ru


  Copyright © 2001-2024 Dmitry Leonov   Page build time: 0 s   Design: Vadim Derkach