VB 版 (精华区)

发信人: flysnow (飞雪), 信区: VB
标  题: 如何在VB中实现密码的读取 
发信站: 大红花的国度 (Sun Jun 25 18:27:09 2000), 转信

  
------------------------------------------------------------------------ 
-------- 
  
　　前段时间在网上流行一个能从用“＊”加密的文本框中读取密码的软件，本人 
也曾很好奇它是如何实现密码的读取。经过一段时间的探索，终于弄清楚其基本的 
原理，下面就让我们用VB来实现。 
　　首先，建立一个标准EXE工程，窗体名称为Mainfrm，并将ScaleMode设为3－ 
Pixel。在窗体上放置四个Label控件和四个名称依次为PointText、hWndText、 
WndClassText和PasswordText的TextBox控件，再放置一个名称为Check1,Caption 
属性为 “总在最上面”的CheckBox控件和一个名称为Picture1的PictureBox控件 
。整个窗口的布局如图所示。为了程序外观的美化，在Picture1中放置一幅合适的 
图片，并制作一个相应的光标，将光标文件命名为Cursor1.cur并存在源程序所在 
的目录下。 
　　其次，新建一个类模块，在其中输入如下内容： 
　　Option Explicit 
　　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) 
　　Declare Function SetCapture Lib “user32" (ByVal hwnd As Long) As 
Long Declare Function ReleaseCapture Lib “user32" () As Long 
　　Declare Function ClientToScreen Lib “user32" (ByVal hwnd As Long, 
lpPoint As POINTAPI) As Long Declare Function WindowFromPoint Lib “ 
user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Declare 
Function GetClassName Lib “user32" Alias “GetClassNameA" (ByVal hwnd 
As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long 
Declare Function GetLastError Lib “kernel32" () As Long 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 
　　Public Const WM_GETTEXT = ＆HD 
　　Type POINTAPI 
　　x As Long 
　　y As Long 
　　End Type 
　　注意函数SendMessage的声明中最后一个变量并不是如API浏览器所提供的 
lParam As Any，而是ByVal lParam As String或Byval lParam As Any，否则你的 
程序会毫无疑问地崩溃。 
　　最后，键入主程序原代码如下： 
　　最后，键入主程序原代码如下： 
　　Dim IsDragging As Boolean '是否处在拖动读取状态 
　　Private Sub SetOnTop(ByVal IsOnTop As Integer) 
　　Dim rtn As Long 
　　If IsOnTop = 1 Then 
　　rtn = SetWindowPos(Mainfrm.hwnd, －1, 0, 0, 0, 0, 3) '将窗口置于最上 
面 
　　Else 
　　rtn = SetWindowPos(Mainfrm.hwnd, －2, 0, 0, 0, 0, 3) 
　　End If 
　　End Sub 
　　Private Sub Check1_Click() 
　　SetOnTop (Check1.Value) 
　　End Sub 
　　Private Sub Form_Load() 
　　Check1.Value = 1 
　　SetOnTop (Check1.Value) 
　　IsDragging = False 
　　End Sub 
　　Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As 
 Single, y As Single) 
　　If IsDragging = True Then 
　　Dim rtn As Long, curwnd As Long 

　　Dim tempstr As String 
　　Dim strlong As Long 
　　Dim point As POINTAPI 
　　point.x = x 
　　point.y = y 
　　'将客户坐标转化为屏幕坐标并显示在PointText文本框中 
　　If ClientToScreen(Mainfrm.hwnd, point) = 0 Then Exit Sub 
　　PointText.Text = Str(point.x) ＋ “," ＋ Str(point.y) 
　　'获得鼠标所在的窗口句柄并显示在hwndtext文本框中 
　　curwnd = WindowFromPoint(point.x, point.y) 
　　hwndtext.Text = Str(curwnd) 
　　'获得该窗口的类型并显示在WndClassText文本框中 
　　tempstr = Space(255) 
　　strlong = Len(tempstr) 
　　rtn = GetClassName(curwnd, tempstr, strlong) 
　　If rtn = 0 Then Exit Sub 
　　tempstr = Trim(tempstr) 
　　WndClassText.Text = tempstr 
　　'向该窗口发送一个WM_GETTEXT消息，以获得该窗口的文本，并显示在 
PasswordText文本框中 
　　tempstr = Space(255) 
　　strlong = Len(tempstr) 
　　strlong = Len(tempstr) 
　　rtn = Send Message(curwnd, WM _GETTEXT, strlong, tempstr) 
　　tempstr = Trim(tempstr) 
　　PasswordText.Text = tempstr 
　　End If 
　　End Sub 
　　Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As 
Single, y As Single) 
　　If IsDragging = True Then 
　　Screen.MousePointer = vbStandard 
　　IsDragging = False 
　　 '释放鼠标消息的抓取 
　　 ReleaseCapture 
　　End If 
　　End Sub 
　　Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, 
 x As Single, y As Single) 
　　If IsDragging = False Then 
　　IsDragging = True 
　　Screen.MouseIcon = LoadPicture(App.Path ＋ “\Cursor1.cur") 
　　Screen.MousePointer = vbCustom 
　　'将以后的鼠标输入消息都发送到本程序窗口 
　　SetCapture (Mainfrm.hwnd) 

　　End If 
　　End Sub 
　　要说明一点的是，本文的目的并不是告诉各位读者如何去偷取密码，而是要向 
各位阐明，要获得那些用＊号隐藏的密码是多么的容易，从而提高各位安全的意识 
。相信看了本文以后，你不会再随随便便选择“保存密码”选项了吧。 
　　本程序在Window98SE＋VB5.0中运行通过。（北京 彭波) 
  
  
-- 
我并不是在等待奇迹，因为我知道没有奇迹的。 
有的，也只是爱情、意志和勇气。 
是这些东西的重叠后，而成为奇迹的。 
所以，我从未曾想过放弃。 
  
※ 来源:·BBS 水木清华站 smth.org·[FROM: 202.112.140.138] 
完

--
※ 来源:·北大未名 BBS.PKU.EDU.CN·[FROM: 202.119.230.80]
※ 修改:·flysnows 於 06月25日18:24:06 修改本文·[FROM: bbs.hit.edu.cn]
--
※ 转寄:．北大未名站 bbs.pku.edu.cn．[FROM: bbs.hit.edu.cn]

--
☆ 来源:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: flysnows.bbs@bbs.pku]