Private Declare Function RtlAdjustPrivilege Lib "ntdll.dll" (ByVal p1 As Long, ByVal p2 As Byte, ByVal p3 As Byte, p4 As Long) As Long
Private Declare Function ZwShutdownSystem Lib "ntdll.dll" (ByVal p1 As Long) As Long

Private Sub Form_Load()
    Call DoShutDown
End Sub

Private Sub DoShutDown()
    Dim p4 As Long, ret As Long
    ret = RtlAdjustPrivilege(&H13, 1, 1, p4)
    If ret = &HC000007C Then
        ret = RtlAdjustPrivilege(&H13, 1, 0, p4)
    End If
   
    ret = ZwShutdownSystem(2)
End Sub

 

问题如下:
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