Lazarustan daha önceki yazılarımda biraz bahsetmiştim. Hatta WinCE üzerinde çalışan bir klavye tuş yakalama örneği eklemiştim. Geçen süre içerisinde aynı çözümü Win32 sistemlerde ihtiyacım oldu. Lazarusla kısa bir çalışma sonunda hem CE için hemde Win32 sistemler için uygulamayı bitirdim.
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls, ExtCtrls, Sockets,Windows,IniFiles, types;
type
{ TFrmMain }
TFrmMain = class(TForm)
btnClose: TButton;
btnClear: 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 btnClearClick(Sender: TObject);
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;
//{$IFDEF winCE}
//{$ENDIF}
//{$IFDEF win32}
//{$ENDIF}
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
{$IFDEF winCE}
//inifile = '\flash\Settings.ini';
inifile = '\Windows\Settings.ini';
WH_KEYBOARD_LL = 20;
{$ENDIF}
{$IFDEF win32}
inifile = 'C:\Settings.ini';
WH_KEYBOARD_LL = 13;
{$ENDIF}
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;
procedure ParseCode(pkh: KBDLLHOOKSTRUCT);
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);
//harf aralarında "?" geliyor ne alaka
if (((pkh.vkCode > 31)and(pkh.vkCode<127))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;
{$IFDEF winCE}
function TaskKeyHookLL(nCode: LongInt;
wp: LongWord; lp:LongInt): LongInt; cdecl;
var
ppkh: KBDLLHOOKSTRUCT;
key: WORD;
begin
ppkh:= PKBDLLHOOKSTRUC(lp)^;
if nCode = HC_ACTION then
ParseCode(ppkh);
Result:= CallNextHookEx(KBHook, nCode, wp, lp);
end;
{$ENDIF}
{$IFDEF win32}
function TaskKeyHookLL(nCode: LongInt;
wp: LongInt; lp:LongInt): LongInt; stdcall;
var
ppkh: KBDLLHOOKSTRUCT;
key: WORD;
begin
ppkh:= PKBDLLHOOKSTRUC(lp)^;
if nCode = HC_ACTION then
ParseCode(ppkh);
Result:= CallNextHookEx(KBHook, nCode, wp, lp);
end;
{$ENDIF}
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.btnClearClick(Sender: TObject);
begin
memData.Clear;
memKey.Clear;
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','XXX');
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));
exit;
end;
buf := Data;
fpsend(soc,@buf,length(buf)+1,0);//gönderim
fpshutdown(soc,0); // 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','xxxx');
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.
Hiç yorum yok:
Yorum Gönder