vb做一个前置的能后台识别键盘的程序

vb做一个前置的能后台识别键盘的程序,第1张

这个有两个部分,一个是窗口置顶,这个容易:

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

程序load时:

SetWindowPos MeHWnd, -1, 0, 0, 0, 0, 2 Or 1

就可以了,但拦截按键并显示出来不是很困难,问题是这种情况都被杀毒软件干掉,除非你不装杀毒软件,否则,无法实现啊。

以上为个人看法,手打很辛苦,希望采纳,谢谢您的支持。

谢谢您的支持,有任何疑问欢迎您再次通过此渠道提问,让大家共同解决,共同进步!

以上回答仅为“百度规则”,没有任何违法行为,请楼主采纳,谢谢!

’添加一个按钮Command1、文本框Text1和Text2到Form1

Dim UserName As String,PassWord As String

Private Sub Form_Load()

UserName="test123" '预设的用户名

PassWord="2011-10-01" ‘预设的密码

End Sub

Private Command1_Click()

If Text1Text=UserName And Text2Text=PassWord Then

'密码正确;创建一个新的文件夹在C:\

MKDir "C:\VbTest"

Shell "Explorerexe C:\VbTest" '打开资源管理器到这个目录

Else

Msgbox "Sorry!用户名或者密码不正确。",16,"错误"

End If

End Sub

我感觉这应该是从进程的角度去看这问题应该通过检测进程去查看。

事实上当U盘(实际上不局限于U盘,所有能在系统中获得逻辑卷标的设备都适用)插入视窗系统的机器后 *** 作系统将发送一个WM_DEVICECHANGE的广播消息,因此只要在相应的消息处理过程中拦截该信息并加以处理就能实时检测到U盘的插拔,之后即可进行预设的有关处理动作了。

听说现在网络上流传着一些能实时检测到U盘插拔消息并能在其插入后伺机拷贝其中文档资料的恶意程序,而日前在CSDN论坛也看到有网友询问这类程序的实现原理,为此我想通过一个简单的VB程序演示一下核心 *** 作过程并借机把实现原理作一个简洁的说明。

事实上当U盘(实际上不局限于U盘,所有能在系统中获得逻辑卷标的设备都适用)插入视窗系统的机器后 *** 作系统将发送一个WM_DEVICECHANGE的广播消息,因此只要在相应的消息处理过程中拦截该信息并加以处理就能实时检测到U盘的插拔,之后即可进行预设的有关处理动作了。

熟悉WINDOWS消息处理过程的人都知道, *** 作系统发送有关消息时还会附带上两个重要的参数:wParam、lParam,因此 WM_DEVICECHANGE也不例外,当该消息发生时,wParam里的内容是指示设备变化的具体事件类别,在我们的演示程序里只需要关心 DBT_DEVICEARRIVAL和DBT_DEVICEREMOVECOMPLETE这两个事件,前者表示新设备已经插入机器并能正常使用了,后者表示设备已经被物理移除了;lParam的内容实际上是一个地址,指向一个结构体,该结构的具体细节由插入系统的设备类型决定,这里有个需要注意的地方,即不论设备类型是什么,该结构的前面三个LONG型成员是固定的,因此我们可以先取得这三个成员的内容,再根据第二个成员的数值来确定新设备类型,然后再获取全部成员的内容。

以下是这个VB演示程序的代码,效果就是检测到设备插入后即把该设备根目录下的全部文件名显示在LISTBOX里面。

模块代码:

Option Explicit

‘子类化窗体消息处理函数时需要使用的API,很常见,不作过多说明。

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd

As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc

As Any, ByVal ByteLen As Long)

Const GWL_WNDPROC = -4

Const WM_DEVICECHANGE As Long = &H219

Const DBT_DEVICEARRIVAL As Long = &H8000&

Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&

'设备类型:逻辑卷标

Const DBT_DEVTYP_VOLUME As Long = &H2

'与WM_DEVICECHANGE消息相关联的结构体头部信息

Private Type DEV_BROADCAST_HDR

lSize As Long

lDevicetype As Long '设备类型

lReserved As Long

End Type

'设备为逻辑卷时对应的结构体信息

Private Type DEV_BROADCAST_VOLUME

lSize As Long

lDevicetype As Long

lReserved As Long

lUnitMask As Long '和逻辑卷标对应的掩码

iFlag As Integer

End Type

Public info As DEV_BROADCAST_HDR

Public info_volume As DEV_BROADCAST_VOLUME

Public PrevProc As Long ‘原来的窗体消息处理函数地址

Public Sub HookForm(F As Form)

PrevProc = SetWindowLong(Fhwnd, GWL_WNDPROC, AddressOf WindowProc)

End Sub

Public Sub UnHookForm(F As Form)

SetWindowLong Fhwnd, GWL_WNDPROC, PrevProc

End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam

As Long, ByVal lParam As Long) As Long

Select Case uMsg

'插入USB DISK 则接收到此消息

Case WM_DEVICECHANGE

If wParam = DBT_DEVICEARRIVAL Then

'若插入USBDISK或者映射网络盘等则

'infolDevicetype =2

'即DBT_DEVTYP_VOLUME

‘利用参数lParam获取结构体头部信息

CopyMemory info, ByVal lParam, Len(info)

If infolDevicetype = DBT_DEVTYP_VOLUME Then

CopyMemory info_volume, ByVal lParam, Len(info_volume)

'检测到有逻辑卷添加到系统中,则显示该设备根目录下全部文件名

ListFiles Chr(GetDriveName(info_volumelUnitMask)) & ":\",

Form1List1

End If

End If

If wParam = DBT_DEVICEREMOVECOMPLETE Then

'若移走USBDISK或者映射网络盘等则

'infolDevicetype =2

'即DBT_DEVTYP_VOLUME

‘利用参数lParam获取结构体头部信息

CopyMemory info, ByVal lParam, Len(info)

If infolDevicetype = DBT_DEVTYP_VOLUME Then

CopyMemory info_volume, ByVal lParam, Len(info_volume)

'清除LIST中的内容

Form1List1Clear

End If

End If

End Select

' 调用原来的窗体消息处理函数

WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)

End Function

'根据输入的32位LONG型数据(只有一位为1)返回对应的卷标的ASCII数值

'规则是1:A、2:B、4:C等等

Function GetDriveName(ByVal lUnitMask As Long) As Byte

Dim i As Long

i = 0

While lUnitMask Mod 2 <> 1

lUnitMask = lUnitMask \ 2

i = i + 1

Wend

GetDriveName = Asc("A") + i

End Function

'显示插入逻辑卷根目录的文件名列表,需要在工程里引用Microsoft Scripting Runtime库。

Function ListFiles(strPath As String, ByRef list As ListBox)

Dim fso As New ScriptingFileSystemObject

Dim objFolder As Folder

Dim objFile As File

Set objFolder = fsoGetFolder(strPath)

For Each objFile In objFolderFiles

listAddItem objFileName

Next

End Function

窗体Form1代码:

Option Explicit

Private Sub Form_Load()

'子类化窗体的消息处理函数

HookForm Me

End Sub

Private Sub Form_Unload(Cancel As Integer)

'程序退出时恢复原窗体处理函数

UnHookForm Me

End Sub

效果图:

备注:本示例程序不仅仅能检测U盘的插入,对CDROM、网络映射盘等设备也会作出同样的反应,如果需要只检测U盘,则需要在If infolDevicetype =

DBT_DEVTYP_VOLUME

处再对iFlag结构成员作检测,其数值为0时表示设备为U盘。另外根据微软的解释,软盘的插拔是不会有引发该消息的,原因是只有支持软d出技术的设备才会引发该消息。(原文:Messages

for media arrival and removal are sent only for media in devices that support a

soft-eject mechanism )

本演示程序在WINDOWS98、XP系统下调试通过。

在文本框的keypress事件里写代码。

private sub text1_keypress(KeyAscii As Integer)

if keyascii = vblf then

c=text1text

endif

end sub

上面 if keyascii = vblf then 的条件判断,是否可行,需要你试一下。vblf可能要改成vbcr或者vbcrlf。

在vb里,常量vbcr对应回车键的ascii,就是10;常量vblf对应换行键的ascii,就是13;vbcrlf是回车加换行。

以上就是关于vb做一个前置的能后台识别键盘的程序全部的内容,包括:vb做一个前置的能后台识别键盘的程序、怎样用VB编写一个能识别用户名和密码的程序,如果用户名和密码正确就d出一个空的新的文件夹、vb如何识别对U盘进行读写的进程等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/zz/9731250.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-01
下一篇 2023-05-01

发表评论

登录后才能评论

评论列表(0条)

保存