VB模拟出的按键精灵大部分功能

原贴：[原创帖]VB模拟出的按键精灵大部分功能
http://www.52pojie.cn/thread-46719-1-1.html (出处: 吾爱破解论坛)

模块部分:

 

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName
As String)

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long

Private Declare Function WindowFromPoint& Lib "user32" (ByVal x As Long, ByVal y As Long)

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long

Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long

Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long

Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal Hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Function GetClientRect Lib "user32" (ByVal Hwnd As Long, lpRect As rect) As Long

Private Declare Function SetForegroundWindow Lib "user32" (ByVal Hwnd As Long) As Long

Private Declare Function ShowWindow Lib "user32" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Declare Function MoveWindow Lib "user32" (ByVal Hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Declare Function SetForegroundWindow Lib "user32" (ByVal Hwnd As Long) As Long

Private Type rect

top As Long

left As Long

endtop As Long

endleft As Long

End Type

Private Type PROCESSENTRY32

dwSize As Long

cntUsage As Long

th32ProcessID As Long

th32DefaultHeapID As Long

th32ModuleID As Long

cntThreads As Long

th32ParentProcessID As Long

pcPriClassBase As Long

dwFlags As Long

szExeFile As String * 1024

End Type

Private Type MODULEENTRY32

dwSize As Long

th32ModuleID As Long

th32ProcessID As Long

GlblcntUsage As Long

ProccntUsage As Long

modBaseAddr As Byte

modBaseSize   As Long

hModule As Long

szModule As String * 256

szExePath As String * 1024

End Type

Private Const TH32CS_SNAPPROCESS = &H2

Private Const TH32CS_SNAPMODULE = &H8

Private Type POINTAPI

x As Long

y As Long

End Type

功能实现部分:

Public Function KeyDown(jm) '按下某键

keybd_event jm, 0, 0, 0

End Function

Public Function KeyUp(jm) '弹起某键

keybd_event jm, 0, &H2, 0

End Function

Public Function KeyPress(jm, cs)  '按某键

For c = 1 To cs

keybd_event jm, 0, &H1, 0

Next

End Function

Public Function MouseMove(x, y)        '移动鼠标

mouse_event &H8000 Or &H1, 0, 0, 0, 0

mouse_event &H1, x, y, 0, 0

End Function

Public Function MousePressL(cs)        '按鼠标左键

For c = 1 To cs

mouse_event &H2 Or &H4, 0, 0, 0, 0

Next

End Function

Public Function MouseDownL()   '按下鼠标左键

mouse_event &H2, 0, 0, 0, 0

End Function

Public Function MouseUpL()    '弹起鼠标左键

mouse_event &H4, 0, 0, 0, 0

End Function

Public Function MousePressR(cs)          '按鼠标右键

For c = 1 To cs

mouse_event &H8 Or &H10, 0, 0, 0, 0

Next

End Function

Public Function MouseDownR()   '按下鼠标右键

mouse_event &H8, 0, 0, 0, 0

End Function

Public Function MouseUpR()  '弹起鼠标右键

mouse_event &H10, 0, 0, 0, 0

End Function

Public Function MousePressM(cs)        '按鼠标中键

For c = 1 To cs

mouse_event &H20 Or &H40, 0, 0, 0, 0

Next

End Function

Public Function MouseDownM()   '按下鼠标中键

mouse_event &H20, 0, 0, 0, 0

End Function

Public Function MouseUpM()  '弹起鼠标中键

mouse_event &H40, 0, 0, 0, 0

End Function

Public Function MouseXY() '返回现在鼠标位置

Dim p As POINTAPI

GetCursorPos p

MouseXY = p.x & "/" & p.y

End Function

Public Function Delay(sj) '等待一定时间

Sleep sj

End Function

Public Function DLGetPixel(x, y) '返回指定坐标的16进制颜色

DLGetPixel = GetPixel(GetDC(0), x, y)

DLGetPixel = Hex(DLGetPixel)

End Function

Public Function HMouseClickL(Hwnd, x, y) '后台发送鼠标左键命令

Dim lParam As Long

lParam = (y * &H10000) + x

PostMessage Hwnd, &H201, 0&, ByVal lParam

  PostMessage Hwnd, &H202, 0&, ByVal lParam

End Function

Public Function HMouseClickR(Hwnd, x, y) '后台发送鼠标右键命令

Dim lParam As Long

lParam = (y * &H10000) + x

PostMessage Hwnd, &H204, 0&, ByVal lParam

  PostMessage Hwnd, &H205, 0&, ByVal lParam

End Function

Public Function HMouseClickM(Hwnd, x, y) '后台发送鼠标中命令

Dim lParam As Long

lParam = (y * &H10000) + x

PostMessage Hwnd, &H207, 0&, ByVal lParam

  PostMessage Hwnd, &H208, 0&, ByVal lParam

End Function

Public Function HKeyPress(Hwnd, jm) '后台发送键盘命令

PostMessage Hwnd, &H101, jm, 0

End Function

Public Function DLDir(path)    '判断文件或文件夹是否存在

If Dir(path) = "" Then

DLDir = 0

Else

DLDir = 1

End If

End Function

Public Function INIRead(xj As String, zhi As String, lj As String) '读INI

Dim zs As String * 255

INIRead = left(zs, GetPrivateProfileString(xj, zhi, "", zs, Len(zs), lj))

End Function

Public Function INIWhile(xj As String, zhi As String, nr As String, lj As String) As String '写INI

INIWhile = WritePrivateProfileString(xj, zhi, nr, lj)

End Function

Public Function DLMouseHwnd() '返回鼠标现在指向的窗口句柄

Dim lRet As Long

Dim ptAPI As POINTAPI

GetCursorPos ptAPI

lRet = WindowFromPoint(ptAPI.x, ptAPI.y)

DLMouseHwnd = lRet

End Function

Public Function DLQTHwnd() '返回现在激活窗口的句柄

DLQTHwnd = GetForegroundWindow

End Function

Public Function FindWin(lei, name) As Long  '返回指定窗口标题或类名的窗口句柄

If lei = 0 Then

lei = vbNullString

End If

FindWin = FindWindow(lei, name)

End Function

Public Function FindWinEx(hWnd1, hWnd2, lei, name) As Long   '查找一个父窗口的子窗口句柄

If lei = 0 Then

lei = vbNullString

End If

If name = 0 Then

name = vbNullString

End If

FindWinEx = FindWindowEx(hWnd1, hWnd2, lei, name)

End Function

Public Function DLPdWin(name) As Long   '判断窗口是否存在

DLPdWin = FindWindow(vbNullString, name)

If DLPdWin = 0 Then

DLPdWin = "no"

Else

DLPdWin = "yes"

End If

End Function

Public Function GetText(ByVal Hwnd As Long) As String     '得到指定句柄的标题

longs = SendMessage(Hwnd, &HE, 0, 0)

Dim Data As String

Data = String(longs, 0)

SendMessage Hwnd, &HD, longs + 1, ByVal Data

GetText = Data

End Function

Public Function GetCName(Hwnd) As String '得到指定句柄的类名

Dim sf As String * 254

Dim zf As String

zf = GetClassName(Hwnd, sf, 255)

GetCName = Trim$(sf)

End Function

Public Function GetPath(Hwnd As Long) As String   '返回指定句柄的路径

hWindow = Hwnd

GetWindowThreadProcessId ByVal hWindow, pidWindow

Dim process As PROCESSENTRY32

Dim module As MODULEENTRY32

Dim hpSnapshot As Long

Dim hmSnapshot As Long

hpSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)

If hpSnapshot > 0 Then

process.dwSize = Len(process)

If Process32First(hpSnapshot, process) Then

Do

If process.th32ProcessID = pidWindow Then

hmSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, process.th32ProcessID)

If hmSnapshot > 0 Then

module.dwSize = Len(module)

If Module32First(hmSnapshot, module) Then

GetPath = left(module.szExePath, InStr(module.szExePath, Chr(0)) - 1)

End If

CloseHandle (hmSnapshot)

End If

Exit Do

End If

Loop Until (Process32Next(hpSnapshot, process) < 1)

End If

CloseHandle (hpSnapshot)

End If

End Function

Public Function GetDX(Hwnd) '返回指定窗口客服区大小

Dim dx As rect

Dim x

x = GetClientRect(Hwnd, dx)

GetDX = dx.top & "\" & dx.left & "\" & dx.endtop & "\" & dx.endleft

End Function

Public Function DLActiveWindows(Hwnd As Long)   '激活后台窗口（不能激活最小化的窗口）

SetForegroundWindow Hwnd

End Function

Public Function DLWindowMax(Hwnd As Long)  '把已经最小化的窗口最大话并激活

ShowWindow Hwnd, 3

End Function

Public Function DLWindowMIX(Hwnd As Long)  '最小化一个窗口

ShowWindow Hwnd, 6

End Function

Public Function DLHideWindow(Hwnd As Long)    '隐藏一个窗口

SetWindowPos Hwnd, 0, 0, 0, 0, 0, &H80

End Function

Public Function DLShowWindow(Hwnd As Long)     '显示一个隐藏的窗口

SetWindowPos Hwnd, 0, 0, 0, 0, 0, &H40

End Function

Public Function DLMoveWindow(Hwnd As Long, x As Long, y As Long)  '保持大小移动一个窗口到指定坐标

SetWindowPos Hwnd, 0, x, y, 0, 0, &H1

End Function

Public Function DLCloseWindow(Hwnd As Long)  '关闭指定窗口

SendMessage Hwnd, &H10, 0, 0

End Function

Public Function DLMoveWindowH(Hwnd As Long, x As Long, y As Long, MaxX As Long, MaxY As Long)   '移动一个窗口 可以改变大小

MoveWindow Hwnd, x, y, MaxX, MaxY, 1

End Function

Public Function DLSetWindowActive(Hwnd As Long) '置一个窗口为前台窗口 但不弹出

SetForegroundWindow Hwnd

End Function