发信人: zrsoft()
整理人: (2000-04-22 10:57:10), 站内信件
|
这是一个密码的星号还原程序，它可以把屏幕上出现的星号还原成原来的密码。
这个程序由VB来编写，它用到了一个API函数，专门用来读出数据，还用到了几个
其它的API函数，可以使窗体浮在桌面上，可以实现无标题栏的托动等，具体请大
家看一下程序就明白了。这个程序的功能还非常有限，对于IE中的*还无能为力。
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTe
xtA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long)
As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As
Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAP
I) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam
As Any) As Long
Private Const EM_SETPASSWORDCHAR = &HCC
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long
, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByV
al cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_SHOWWINDOWS = &H40
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Sub Form_Load()
Dim retValue As Long
retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.Current
Y, 42, 42, SWP_SHOWWINDOWS)
End Sub
Private Sub cmdExit_Click()
End
End Sub
Private Sub Form_Activate()
Picture1.SetFocus
End Sub
Private Sub mnuAbout_Click()
Dim ss As String
ss = " 屏幕解密 1.0" & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "完全共
享版"
ss = ss & Chr(10) & Chr(13) & "作者：于爱武"
ss = ss & Chr(10) & Chr(13) & "更新日期：1999.10.6"
If LCase(App.Path) "d:\yu\unpwd" Then
ss = ss & Chr(10) & Chr(13) & "更新地址：http://yuaiwu.163.net"
ss = ss & Chr(10) & Chr(13) & "Email:[email protected]"
End If
MsgBox ss
End Sub
Private Sub mnuEnd_Click()
End
End Sub
Private Sub mnuHelp_Click()
Dim ss As String
ss = " 系 统 帮 助"
ss = ss & Chr(10) & Chr(13)
ss = ss & Chr(10) & Chr(13) & "起动后，在要显示的密码框中双击鼠标，密码
即可原形毕露！"
ss = ss & Chr(10) & Chr(13)
ss = ss & Chr(10) & Chr(13) & "如果选择暂停，可以暂停解密，稍候可以用“
继续”来继续你的工作。"
ss = ss & Chr(10) & Chr(13)
ss = ss & Chr(10) & Chr(13) & "警告：由于使用本程序而造成的后果，本人概
不负责。"
MsgBox ss
End Sub
Private Sub mnuPause_Click()
Timer1.Enabled = Not Timer1.Enabled
If mnuPause.Caption = "暂停" Then
mnuPause.Caption = "继续"
Else
mnuPause.Caption = "暂停"
End If
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
If Button = 1 Then
ReleaseCapture
Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
ElseIf Button = 2 Then
PopupMenu mnuPopup
End If
End Sub
Private Sub Timer1_Timer()
Dim s As String
Dim p As POINTAPI
s = Space(40)
Call GetCursorPos(p)
Call GetWindowText(WindowFromPoint(p.X, p.Y), s, 40)
Call SendMessage(WindowFromPoint(p.X, p.Y), EM_SETPASSWORDCHAR, 0, 0)
End Sub
--
峥嵘软件室
http://go.163.com/~zrsoft http://zrsoft.8u8.com
[email protected]
欢迎首页连接！
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.96.40.13]
|
|