防止密码框内容被偷看

问题如下:
Option Explicit

Declare Function EnumChildWindows Lib "user32" ( _
        ByVal hWndParent As Long, _
        ByVal lpEnumFunc As Long, _
        ByVal lParam As Long) As Long
Declare Function EnumWindows Lib "user32" ( _
        ByVal lpEnumFunc As Long, _
        ByVal lParam As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
        ByVal hwnd As Long, _
        ByVal wMsg As Long, _
        ByVal wParam As Integer, _
        ByVal lParam As Long) As Long
Public Declare Function ShowWindow Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal nCmdShow As Long) As Long

Private Const EM_GETPASSWORDCHAR = &HD2
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const EM_SETMODIFY = &HB9
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
  EnumChildWindows hwnd, AddressOf EnumWindowsProc2, 1
  EnumWindowsProc = True
End Function
Private Function EnumWindowsProc2(ByVal hwnd As Long, ByVal lParam As Long) As Long
  If SendMessage(hwnd, EM_GETPASSWORDCHAR, 0, 1) Then
  UpdateWindow hwnd
  End If
  EnumWindowsProc2 = True
End Function

Private Sub UpdateWindow(hwnd As Long)
  SendMessage hwnd, EM_SETPASSWORDCHAR, 0, 1
  SendMessage hwnd, EM_SETMODIFY, True, 1
  ShowWindow hwnd, SW_HIDE
  ShowWindow hwnd, SW_SHOW
End Sub

Public Function UnmaskPasswords()
  EnumWindows AddressOf EnumWindowsProc, 1
End Function
然后加一个按钮:
Private Sub Command1_Click()
UnmaskPasswords
End Sub
这样VB的星号密码都会显示出来了!如何防止被搞?


我的回答是:

标准模块里
Option Explicit

Public Declare Function SetWindowLong Lib " user32 " Alias " SetWindowLongA " (ByVal hwnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long
Public 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
Public Const EM_SETPASSWORDCHAR = & HCC
Public Const EM_SETMODIFY = & HB9
Public Const WM_GETTEXT = & HD
Public Const WM_GETTEXTLENGTH = & HE

Public Const GWL_WNDPROC = ( - 4 )

Private m_lDefWindowProc As Long

' 子类处理窗口 hWndTarget
Public Sub Subclassing(ByVal hWndTarget As Long , Optional ByVal fUnsubclassing As Boolean = False )
    On Error Resume Next
   
    If hWndTarget = 0 Then Exit Sub
   
    If fUnsubclassing Then
        If m_lDefWindowProc <> 0 Then
            SetWindowLong hWndTarget, GWL_WNDPROC, m_lDefWindowProc
        End If
    Else
        m_lDefWindowProc = SetWindowLong(hWndTarget, GWL_WNDPROC, AddressOf WndProc)
    End If
End Sub

Public Function WndProc(ByVal hwnd As Long , ByVal uMsg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
    Select Case uMsg
    Case EM_SETMODIFY, EM_SETPASSWORDCHAR, WM_GETTEXT, WM_GETTEXTLENGTH
        WndProc = 1
    Case Else
        WndProc = CallWindowProc(m_lDefWindowProc, hwnd, uMsg, wParam, lParam)
    End Select
End Function

然后在窗体代码中

Private Sub Form_Load()
    Subclassing Text1.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Subclassing Text1.hwnd, True
End Sub

转载于:https://www.cnblogs.com/supergreenbean/archive/2008/06/20/1227111.html