Windows CE Keyboard Hook (Win Ce Tuş Yakalama)

WinCe kullanan bir sistemde basılan tuşları yakalayıp belli bir formatta olanları soket üzerinden  gönderen bir uygulamaya ihtiyacım oldu. Kullanılan pc endüstriyel bir bilgisayardı ve oldukça kısıtılı ayarları olan bir bilgisayardı. İlk önce .ne compact framework ile bir uygulama geliştirmek istedim. Geliştirdiğim uygulama klavye hareketlerini yakaladı. Fakat seçim formdan ayrıldıktan sonra tuş yakala duruyor ve daha sonra çalışmıyordu. Bunun üzerine benzer bir örneği LAZARUS ile geliştirdim. 

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses

  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,

  ComCtrls, ExtCtrls, Sockets, IniFiles, types;

type

  { TFrmMain }

  TFrmMain = class(TForm)

    btnClose: TButton;

    btnMin: TButton;

    btnOpen: TButton;

    btnSaveIni: TButton;

    btnWriteDefault: TButton;

    edtPort: TEdit;

    edtMacID: TEdit;

    lblIp: TEdit;

    edtIP: TEdit;

    lblIp1: TEdit;

    lblIp2: TEdit;

    lblIp3: TEdit;

    edtBarcodeStart: TEdit;

    memData: TMemo;

    memKey: TMemo;

    memError: TMemo;

    pageMain: TPageControl;

    Panel1: TPanel;

    Panel2: TPanel;

    tbSettings: TTabSheet;

    tbDebug: TTabSheet;

    tmrHide: TTimer;

    procedure btnOpenClick(Sender: TObject);

    procedure btnCloseClick(Sender: TObject);

    procedure btnMinClick(Sender: TObject);

    procedure btnSaveIniClick(Sender: TObject);

    procedure btnWriteDefaultClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure lblIp3DblClick(Sender: TObject);

    procedure tmrHideTimer(Sender: TObject);

  private

    { private declarations }

    function SendData(Data:String):Boolean;

    function LoadIniFiles():Boolean;

    function WriteIniFile():Boolean;

    procedure LogYaz(Data:String);

  public

    { public declarations }

  end;

  type

  PKBDLLHOOKSTRUC = ^KBDLLHOOKSTRUCT;

  KBDLLHOOKSTRUCT = packed record

    vkCode: DWORD;

    scanCode: DWORD;

    flags: DWORD;

    time: DWORD;

    dwExtraInfo: Pointer;

  end;

  type

  HOOKPROC = function (_para1:longint; _para2:PtrInt; _para3:PtrInt):PtrInt;

  {$include F:\lazarus\fpc\2.6.0\source\rtl\wince\wininc\coredll.inc}

  {$include F:\lazarus\fpc\2.6.0\source\rtl\wince\wininc\base.inc}

  {$include F:\lazarus\fpc\2.6.0\source\rtl\wince\wininc\defines.inc}

  function CallNextHookEx(hhk:THandle; nCode:longint; wParam:PtrInt; lParam:PtrInt):PtrInt;  external 'coredll.dll' name 'CallNextHookEx';

  //function CallNextHookEx(hhk:HHOOK; nCode:longint; wParam:WPARAM; lParam:LPARAM):LRESULT; external KernelDLL name 'CallNextHookEx';

  function SetWindowsHookEx(idHook:longint; lpfn:HOOKPROC; hmod:THandle; dwThreadId:DWORD):THandle; external 'coredll.dll'  name 'SetWindowsHookExW';

  //function SetWindowsHookEx(idHook:longint; lpfn:HOOKPROC; hmod:HINST; dwThreadId:DWORD):HHOOK; external KernelDLL name 'SetWindowsHookExW';

  function UnhookWindowsHookEx(hhk:THandle):LongBool; external 'coredll.dll' name 'UnhookWindowsHookEx';

  //function UnhookWindowsHookEx(hhk:HHOOK):WINBOOL; external 'user32' name 'UnhookWindowsHookEx';

  function SetWindowLong(hWnd:THandle; nIndex:longint; dwNewLong:longint):longint;  external 'coredll.dll' name 'SetWindowLongW';

  //function SetWindowLong(hWnd:HWND; nIndex:longint; dwNewLong:LONG):LONG; external KernelDLL name 'SetWindowLongW';

  function ShowWindow(hWnd:THandle; nCmdShow:longint):Boolean; external KernelDLL name 'ShowWindow';

  //function ShowWindow(hWnd:HWND; nCmdShow:longint):WINBOOL; external KernelDLL name 'ShowWindow';

var

  FrmMain: TFrmMain;

  KBHook: Cardinal = 0;

  srvip: String;

  srvport: String;

  startchr: String;

  machid: String;

  Barcode_Islem: Integer;

  Barcode_Start_i: Integer;

  Barcode_Data: String;

  Barcode_Detect: Boolean;

  ChrKeyPress: DWORD;

  ChrKeyUp: DWORD;

const

  inifile = '\flash\Settings.ini';

  WH_KEYBOARD_LL = 20;

  HC_ACTION = 0;

  GWL_EXSTYLE = -20;

  WS_EX_TOOLWINDOW = $80;

  { ShowWindow  }

     SW_HIDE = 0;

     SW_MAXIMIZE = 3;

     SW_MINIMIZE = 6;

     SW_NORMAL = 1;

     SW_RESTORE = 9;

     SW_SHOW = 5;

     SW_SHOWDEFAULT = 10;

     SW_SHOWMAXIMIZED = 3;

     SW_SHOWMINIMIZED = 2;

     SW_SHOWMINNOACTIVE = 7;

     SW_SHOWNA = 8;

     SW_SHOWNOACTIVATE = 4;

     SW_SHOWNORMAL = 1;

     WPF_RESTORETOMAXIMIZED = 2;

     WPF_SETMINPOSITION = 1;

implementation

procedure ParseKeyboard(Key: DWORD);

begin

     if FrmMain.tbDebug.TabVisible then

        FrmMain.memKey.Lines.Insert(0,chr(Key));

     case Barcode_Islem of

       0: begin

          Barcode_Start_i:= 1;

          if chr(Key) = startchr[1] then begin

             Barcode_Start_i:= 2;

             Barcode_Islem:= 1;

             Barcode_Data:= chr(Key);

             Barcode_Detect:= True;

          end;

       end;

       1: begin

          if (Barcode_Start_i <= Length(startchr)) then begin

             if chr(Key) = startchr[Barcode_Start_i] then begin

                 Barcode_Start_i:= Barcode_Start_i + 1;

                 Barcode_Data:= Barcode_Data + chr(Key);

                 Barcode_Islem:= 1;

             end else begin

                 Barcode_Detect:= False;

                 Barcode_Islem:= 0;

             end;

          end else begin

              Barcode_Data:= Barcode_Data + chr(Key);

              Barcode_Islem:= 2;

          end;

       end;

       2:begin

              if Key = 13 then begin//enter

                 Barcode_Detect:= False;

                 Barcode_Islem:= 0;

                 if FrmMain.tbDebug.TabVisible then

                    FrmMain.memKey.Lines.Insert(0,Barcode_Data);

                 FrmMain.SendData('MACHID:' + machid + 'BRCD:'+ Barcode_Data+ '@');

              end else begin

                  Barcode_Data:= Barcode_Data + chr(Key);

              end;

       end;

     end;

  ////

end;

procedure MemWrite(Data:String);

begin

  FrmMain.memData.Lines.Insert(0,Data);

end;

function TaskKeyHookLL(nCode: Integer;

  wp: PtrInt; lp:PtrInt): PtrInt; stdcall;

var

  pkh: KBDLLHOOKSTRUCT;

  key: WORD;

begin

  pkh:= PKBDLLHOOKSTRUC(lp)^;

  if nCode = HC_ACTION then

  begin

       if FrmMain.tbDebug.TabVisible then

          MemWrite(chr(pkh.vkCode)+':'+IntToStr(pkh.vkCode)+'-'+inttostr(pkh.scanCode)+'-'+inttostr(pkh.flags)+'-'+inttostr(pkh.time));

       if pkh.vkCode = 36 then

           ShowWindow(FrmMain.Handle,SW_NORMAL);

       if ((pkh.vkCode > 31)or(pkh.vkCode = 13)) then begin

          //Tuş Yakalama

          if  ChrKeyPress = 0 then

              ChrKeyPress:= pkh.vkCode

          else if  ((ChrKeyPress <> 0) and (ChrKeyUp = 0)) then

               ChrKeyUp:=pkh.vkCode;

          //Tuş Kontrol

          if  ((ChrKeyPress <> 0) and (ChrKeyUp <> 0)) then begin

            if   ChrKeyPress = ChrKeyUp then

                 ParseKeyboard(ChrKeyUp);

            ChrKeyPress:= 0;

            ChrKeyUp:= 0;

          end;

       end;

  end;

  Result:= CallNextHookEx(KBHook, nCode, wp, lp);

end;

function KeyboardHook(ADisable: Boolean): Boolean;

begin

  if ADisable then

  begin

    if KBHook = 0 then

      KBHook:= SetWindowsHookEx(WH_KEYBOARD_LL,

            @TaskKeyHookLL, HInstance, 0);

  end else

    if KBHook <> 0 then

    begin

      UnhookWindowsHookEx(KBHook);

         KBHook:= 0;

    end;

  Result:= KBHook <> 0;

end;

{ TFrmMain }

procedure TFrmMain.btnOpenClick(Sender: TObject);

begin

 if KeyboardHook(True) then

    LogYaz('System Hooked')

 else

     LogYaz('System Not Hooked');

end;

procedure TFrmMain.btnCloseClick(Sender: TObject);

begin

  KeyboardHook(False);

end;

procedure TFrmMain.btnMinClick(Sender: TObject);

begin

  //FrmMain.WindowState:= wsMinimized;

 ShowWindow(FrmMain.Handle,SW_HIDE);

end;

procedure TFrmMain.btnSaveIniClick(Sender: TObject);

begin

  WriteIniFile();

end;

procedure TFrmMain.btnWriteDefaultClick(Sender: TObject);

var

  MyFile: TIniFile;

begin

  MyFile := TIniFile.Create(inifile);

  try

    MyFile.WriteString('Program', 'IP','192.168.100.1');

    MyFile.WriteString('Program', 'PORT','509');

    MyFile.WriteString('Program', 'MACID','');

    MyFile.WriteString('Program', 'BARCODESTART','K1');

  finally

    MyFile.Free;

  end;

end;

procedure TFrmMain.FormCreate(Sender: TObject);

begin

 pageMain.ActivePage:= tbSettings;

 pageMain.Pages[1].TabVisible:= false;

 LoadIniFiles();

   if not KeyboardHook(True) then

     LogYaz('Err: System Not Hooked');

  Barcode_Islem := 0;

  Barcode_Data:= '';

  Barcode_Detect:= False;

  ChrKeyPress:= 0;

  ChrKeyUp:= 0;

end;

procedure TFrmMain.FormShow(Sender: TObject);

begin

     tmrHide.Enabled:= True;

end;

procedure TFrmMain.lblIp3DblClick(Sender: TObject);

begin

  pageMain.Pages[1].TabVisible:= not pageMain.Pages[1].TabVisible;

end;

procedure TFrmMain.tmrHideTimer(Sender: TObject);

begin

     ShowWindow(FrmMain.Handle,SW_HIDE);

     tmrHide.Enabled:= false;

end;

function TFrmMain.SendData(Data: String): Boolean;

var

 adr : TInetSockAddr;

 soc : Tsocket;

 buf : String[255];

 Sin,Sout : Text;

begin

 soc := fpsocket(AF_INET,SOCK_STREAM,IPPROTO_TCP);

 if soc=-1 then begin

      LogYaz('Socket hatası');

      exit;

 end;

 adr.sin_family := AF_INET;

 adr.sin_port := htons(StrToInt(srvport));

 if srvip='' then

    adr.sin_addr := StrToNetAddr('127.0.0.1')

 else

     adr.sin_addr := StrToNetAddr(srvip);

 if not  Connect (soc,adr,Sin,Sout) then

 begin

   LogYaz('Bağlantı hatası : '+NetAddrToStr(adr.sin_addr));   //ip canlı değilse

   exit;

 end;

 buf := Data;

 fpsend(soc,@buf,length(buf)+1,0);//gönderim adımı

 fpshutdown(soc,0);                                 //bağlantıyı kapat

 CloseSocket(soc);

end;

function TFrmMain.LoadIniFiles(): Boolean;

var

  MyFile: TIniFile;

begin

  MyFile := TIniFile.Create(inifile);

  try

    srvip:= MyFile.ReadString('Program', 'IP','127.0.0.1');

    edtIp.Text:= srvip;

    srvport:= MyFile.ReadString('Program', 'PORT','509');

    edtPort.Text:= srvport;

    machid:= MyFile.ReadString('Program', 'MACID','');

    edtMacID.Text:= machid;

    startchr:= MyFile.ReadString('Program', 'BARCODESTART','K1');

    edtBarcodeStart.Text:= startchr;

  finally

    MyFile.Free;

  end;

end;

function TFrmMain.WriteIniFile(): Boolean;

var

  MyFile: TIniFile;

begin

  MyFile := TIniFile.Create(inifile);

  try

    MyFile.WriteString('Program', 'IP',edtIp.Text);

    MyFile.WriteString('Program', 'PORT',edtPort.Text);

    MyFile.WriteString('Program', 'MACID',edtMacID.Text);

    MyFile.WriteString('Program', 'BARCODESTART',edtBarcodeStart.Text);

  finally

    MyFile.Free;

  end;

end;

procedure TFrmMain.LogYaz(Data: String);

begin

  memError.Lines.Insert(0,Data);

end;

{$R *.lfm}

end.