232698424.xlsx/Sheet2
14:01 2014-9-14
请问InputBox输入密码时如何加掩码？
不行吧，输入密码的不如自己写一个窗体，因为密码应该会对应员工吧，写个修改密码窗体就行了。密码修改要有：姓名、原始密码、修改密码、确认密码。一个输入框不能完成吧。
InputBox 函数
在一对话框来中显示提示，等待用户输入正文或按下按钮，并返回包含文本框内容的 String。
语法
InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
InputBox 函数的语法具有以下几个命名参数：
部分描述
Prompt 必需的。作为对话框消息出现的字符串表达式。prompt 的最大长度大约是 1024 个字符，由所用字符的宽度决定。如果 prompt 包含多个行，则可在各行之间用回车符 (Chr(13))、换行符 (Chr(10)) 或回车换行符的组合 (Chr(13) & Chr(10)) 来分隔。
Title 可选的。显示对话框标题栏中的字符串表达式。如果省略 title，则把应用程序名放入标题栏中。
Default 可选的。显示文本框中的字符串表达式，在没有其它输入时作为缺省值。如果省略 default，则文本框为空。
Xpos 可选的。数值表达式，成对出现，指定对话框的左边与屏幕左边的水平距离。如果省略 xpos，则对话框会在水平方向居中。
Ypos 可选的。数值表达式，成对出现，指定对话框的上边与屏幕上边的距离。如果省略 ypos，则对话框被放置在屏幕垂直方向距下边大约三分之一的位置。
Helpfile 可选的。字符串表达式，识别帮助文件，用该文件为对话框提供上下文相关的帮助。如果已提供 helpfile，则也必须提供 context。
Context 可选的。数值表达式，由帮助文件的作者指定给某个帮助主题的帮助上下文编号。如果已提供 context，则也必须要提供 helpfile。
说明
如果同时提供了 helpfile 与 context，用户可以按 F1 来查看与 context 相应的帮助主题。某些主应用程序，例如，Microsoft Excel，会在对话框中自动添加一个 Help 按钮。如果用户单击 OK 或按下ENTER ，则 InputBox 函数返回文本框中的内容。如果用户单击 Cancel，则此函数返回一个长度为零的字符串 ( " ")。
注意如果还要指定第一个命名参数以外的参数，则必须在表达式中使用 InputBox。如果要省略某些位置参数，则必须加入相应的逗号分界符。
请问InputBox输入密码时如何加掩码？
============================================
'模块中：
Option Explicit
'==== API declarations ============================
Private Type CWPSTRUCT
lParam As Long
wParam As Integer
message As Long
hwnd As Long
End Type
Private Const WH_CALLWNDPROC = 4
Private Const WM_CREATE = &H1
Private 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 hook
Public 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 Function
Private 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 Function
Private 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
'请问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
'。。。。。。。。。。。。。。。。。。。
'上面两种方法只是作为一种纯技术上的尝试，没有什么实际的意义。。在实际应用中，同意楼上的小健兄的意见，自己做一个窗口，又美观又方便。。。。。。
Page 1