Легенда:
 новое сообщение
 закрытая нитка
 новое сообщение
 в закрытой нитке
 старое сообщение
|
- Напоминаю, что масса вопросов по функционированию форума снимается после прочтения его описания.
- Новичкам также крайне полезно ознакомиться с данным документом.
Кидаю 05.06.03 12:39 Число просмотров: 1404
Автор: 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;
// Там еще много всякой фигни которая к хукам не имеет отношения
|
|
|
подробно о проекте
Анализ криптографических сетевых...
