Ele é utilizado para capturar senhas onde não é necessário prescionar teclas. Um exemplo são os teclados virtuais, onde o cliente apenas clica nos caracteres e é preenchido na caixa de texto.
Devemos pegar a tela do usuário depois pegar somente a área onde o mouse se encontra.
Para pegarmos a tela e copiar para algum DC usamos.
Public Sub CaptureScreen(Left As Long, Top As Long, Width As Long, Height As Long) Dim srcDC As Long Dim dm As DEVMODE srcDC = CreateDC("DISPLAY", "", "", dm) BitBlt Me.hdc, 0, 0, Width, Height, srcDC, Left, Top, SRCCOPY End Sub |
CaptureScreen 0, 0, 800, 600 |
Depois disso usamos a função BitBlt essa função ela copia de um DC para outro DC, ou seja criamos um DC de toda a tela que será copia para o DC do form, poderia ser de uma PictureBox, também.
Podemos passar alguns parâmetros para essa função como a posição Left "X" e Top "Y", e também a largura "Width" e altura "Height" da área que queremos copiar.
Podemos então pegar a posição do mouse e passar para a função CaptureScreen para podermos" "filtrar a imagem".
A função GetCursorPos retorna a posição do mouse na estrutura que passada como parâmetro.
O código abaixo imprime no Immediate a posição do mouse.
No código abaixo crie um timer e adicione a ele um intervalo.
Bem agora o código completo de um mouse logger.
Option Explicit Private Const SRCCOPY = &HCC0020 ' (DWORD) destination = source Private Type POINTAPI X As Long Y As Long End Type Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Sub Timer1_Timer() Dim cursor As POINTAPI GetCursorPos cursor Debug.Print "X: " & cursor.X Debug.Print "Y: " & cursor.Y End Sub |
Option Explicit Private Const SRCCOPY = &HCC0020 ' (DWORD) destination = source Private Const CCHDEVICENAME = 32 Private Const CCHFORMNAME = 32 Private Type POINTAPI X As Long Y As Long End Type Private Type DEVMODE dmDeviceName As String * CCHDEVICENAME dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * CCHFORMNAME dmUnusedPadding As Integer dmBitsPerPel As Long dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type 'API Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As DEVMODE) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Sub CaptureScreen(Left As Long, Top As Long, Width As Long, Height As Long) Dim srcDC As Long Dim dm As DEVMODE srcDC = CreateDC("DISPLAY", "", "", dm) BitBlt Me.hdc, 0, 0, Width, Height, srcDC, Left, Top, SRCCOPY End Sub Private Sub Form_Load() End Sub Private Sub Timer1_Timer() Dim cursor As POINTAPI Me.Cls GetCursorPos cursor CaptureScreen cursor.X - 100, cursor.Y - 100, 200, 200 End Sub |