请问InputBox中如何显示密码＊？

Question

我做了一个输入密码才能打开的软件，密码框是一个InputBox函数。但它的输入不能用＊号显示，请问怎样才能用＊号显示密码？
　　　谢谢！

Answer 1

 使用：EM_SETPASSWORDCHAR

Answer 2

建议用Form+TextBox做一个来代替InputBox，给TextBox.PasswordChar="*"就行了

Answer 3

暈~~~
登錄窗口怎么用InputBox這么草率呢? 
用Form吧! 不會費事的

Answer 4

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Public Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Public Const EM_SETPASSWORDCHAR = &HCCPublic g_bDone As Boolean
Public g_strTitle As String
Public Sub HookInputBoxThread()
    Do Until g_bDone
        Dim h As Long, hText As Long
        h = FindWindow("#32770", g_strTitle)
        If h <> 0 Then
            hText = GetDlgItem(h, &H1324)
            If hText <> 0 Then
            SendMessage hText, EM_SETPASSWORDCHAR, Asc("*"), 0
            g_bDone = True
            End If
        End If
    Loop
End Sub
---------------------------form1------------------------------------
Private Sub Command1_Click()
    Dim hThread As Long, lpThreadID As Long
    g_bDone = False
    g_strTitle = "测试程序"
    hThread = CreateThread(ByVal 0&, ByVal 0&, AddressOf HookInputBoxThread, ByVal 0&, 0, lpThreadID)
    Dim s As String
    s = InputBox("请输入数据", g_strTitle)
    MsgBox s
End Sub

Answer 5

转贴我以前一个回复：回复人： lsftest() ( ) 信誉：110  2004-6-23 19:05:34  得分:30  
 
 
  
请问InputBox输入密码时如何加掩码？
============================================'模块中：
Option Explicit'==== API declarations ============================
Private Type CWPSTRUCT
        lParam As Long
        wParam As Integer
        message As Long
        hwnd As Long
End TypePrivate Const WH_CALLWNDPROC = 4
Private Const WM_CREATE = &H1Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias _
    "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal _
    hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias _
    "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long
Private Const EM_SETPASSWORDCHAR = &HCC 'pw char code in wp
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'==== module =========================================Private Const EDIT_CLASS = "Edit" 'classname of the "TextBox" in an InputBox window
Dim m_hWinHook As Long 'stores handle to the installed hookPublic Function InputBoxPW(Prompt As String, Optional Title, Optional _
Default As String = "", Optional XPos, Optional YPos, Optional _
HelpFile As String = "", Optional Context As Long = 0) As String
    'Adds PasswordChar masking to the standard VB InputBox.
    'All args and return identical to InputBox.
    Dim sTitle As String
    
    If IsMissing(Title) Then
        sTitle = App.Title
    Else
        sTitle = Title
    End If
    
    'Bad InputBox arguments can cause a VB runtime error.
    'If that happens,we want to know about it, but we cannot
    'allow VB to raise the error while the hook is active or it
    'will crash the IDE and cause a system error.
    On Error GoTo EH_Proc
    
    'activate the hook...
    m_hWinHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf CallWndProc, 0&, App.ThreadID)
    
    If IsMissing(XPos) Or IsMissing(YPos) Then
        InputBoxPW = InputBox(Prompt, sTitle, Default, , , HelpFile, Context)
    Else
        InputBoxPW = InputBox(Prompt, sTitle, Default, XPos, YPos, HelpFile, Context)
    End If
    
    'should be unhooked by now, but just in case...
    Unhook
    
    Exit Function 'done (skip error handler) ======>>>EH_Proc: 'error occurred (bad InputBox argument)
    Unhook 'deactivate hook
    'now it's safe to raise the error
    Err.Raise Err.Number
End FunctionPrivate Function CallWndProc(ByVal ncode As Long, ByVal wParam As Long, Info As CWPSTRUCT) As Long
    Dim sCls As String * 6    'We want to be notified when Edit (TextBox) window is created.
    'WM_CREATE is sent as soon as it's created, but before it's visible.
    If Info.message = WM_CREATE Then
        'Other windows for the InputBox are also being created,
        'but we're only interested in the Edit window...
        GetClassName Info.hwnd, sCls, 5
        If Left$(sCls, 4) = EDIT_CLASS Then 'It's the Edit window
            'set it's password char..
            SendMessage Info.hwnd, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0
            Unhook 'deactivate hook
        End If
    End If
End FunctionPrivate Sub Unhook()
    If m_hWinHook <> 0& Then 'not already unhooked
        'No point testing return value here because
        'if it fails, we'll get a system error anyway :-)
        UnhookWindowsHookEx m_hWinHook
        m_hWinHook = 0& 'indicate unhooked
    End If
End Sub'程序中：
Private Sub Command1_Click()
InputBoxPW "ok?"
End Sub
 
Top 
 
 回复人： lsftest() ( ) 信誉：110  2004-6-23 19:37:39  得分:0  
 
 
  
'请问InputBox输入密码时如何加掩码？
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'“吃饱了撑”之《为inputbox添加密码功能》系列之二：'模块中：
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Const EM_SETPASSWORDCHAR = &HCC
Public lTimeID As Long'timeSetEvent的回调函数
Sub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, _
    ByVal dw1 As Long, ByVal dw2 As Long)
    '在这里捕捉inputbox
    hwd = FindWindow("#32770", "密码inputbox")
    If hwd <> 0 Then
        hwd = FindWindowEx(hwd, 0, "edit", vbNullString)
        SendMessage hwd, EM_SETPASSWORDCHAR, 42, 0
        timeKillEvent lTimeID
    End If
End Sub'程序中：
Private Sub Command1_Click()
Dim hwd As Long
lTimeID = timeSetEvent(10, 0, AddressOf TimeProc, 1, 1)
InputBox "请输入字符", "密码inputbox"
DoEvents
End Sub
'。
'上面两种方法只是作为一种纯技术上的尝试，没有什么实际的意义。。在实际应用中，同意楼上的小健兄的意见，自己做一个窗口，又美观又方便