InputBox as password character(*)? 12

[shanmugham]

Hello, expert

Is there any way to make the text entered in the InputBox as password character(*)?

thanks in advance

shan

 

[krinid]

Hypetia,
Cheers for a brilliant explanation (are you a teacher?), and a star.

I see now that this changes the attributes of a given inputbox, rather than the attributes of all inputboxes! (I missed that on my first read through).

 

[strongm]

My favoured varinat of this is to use a CBT hook. I've posted it on a number of occassions, and here it is again (the principal is similar to that of the timer, except it responds to the activation of the inputbox window rather than waiting for a timer event):

Option Explicit

' Necessary constants  for hooking
Private Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5

' Constants for password masking
Public Const EM_SETPASSWORDCHAR = &HCC

' Working variables that require global scope in hooking module
Private hHook As Long

' The API declarations we need
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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
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 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

' Wrapper for the normal InputBox function
Public Function vbInputBox(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Single, Optional YPos As Single, Optional Helpfile As String, Optional Context As Long) As String 'Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String, Optional HelpFile As String, Optional Context As Long) As Long
    hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.hInstance, 0)
    vbInputBox = InputBox(Prompt, Title, Default, Xpos, YPos, Helpfile, Context)
End Function

Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim hwndEditControl As Long
    
    If lMsg = HCBT_ACTIVATE Then
        hwndEditControl = FindWindowEx(wParam, 0, "Edit", "") ' get the edit control
        If hwndEditControl Then SendMessage hwndEditControl, EM_SETPASSWORDCHAR, Asc("*"), 0 ' Do your stuff here to modify the window
        UnhookWindowsHookEx hHook ' Immediately unhook
    End If
    CBTProc = 0 ' allow operation to continue
End Function

 

[Hypetia]

krinid
No I am not. Thanks for the star.

strongm
This variant is realy nice and more appropriate alternative. I believe that this hook mechanism is really better than the timer mechanism.
Have a star!

 

[krinid]

strongm,
(Crossing the forum topics here, but would like to use this in VBA as well as VB) Could that be ported to VBA? I changed App.hInstance to Application.hInstance but it doesn't seem to be able to find the window (FindWindowEx always returns 0).

 

[Hypetia]

There is no object in VBA that can return the instance handle of the current application (not even the Application object). The App object which we use in VB belongs to the VB library but not VBA.

If you want to port this code to VBA, you need to obtain the current instance handle to pass it to SetWindowsHookEx function.

Add the following declarations in the declarations section of the module (below the FindWindowEx declaration).
___
[tt]
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Const GWL_HINSTANCE = (-6)[/tt]
___

Now modify the SetWindowHookEx function call from this:
___
[tt]
hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, [tt]App.hInstance[/tt], 0)[/tt]
___

to this:
___
[tt]
hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, [tt]GetWindowLong(GetActiveWindow, GWL_HINSTANCE)[/tt], 0)[/tt]
___

The GetWindowLong function obtains the instance handle of the active window handle passed to it and passes it to SetWindowsHookEx function.

I tested it in Word VBA and it worked fine.

Note that all of the code must go in a standard module, not in a class module.

 

[krinid]

Can't seem to get in working. I added the 3 lines (2 Private Declare's, 1 Const) below the FindWindowEx declaration and replaced the hHook line, but hwndEditControl still ends up being 0 every time. I'm calling the function using Debug.Print vbInputBox("Prompt", "Title", "Default").

 

[strongm]

I'm betting you are testing the function by invoking from VBA's Immediate window. This will appear to fail because opening a dialog box (which is what the inputbox is) switches focus away from the IDE back to the owning application (e.g Word or Excel). This switch in focus causes the application's window to activate before the inputbox window activates - and the simple hook we have in place merely responds to the very first window that activates after the hook has been put into place.

In other words, in Word or Excel, if you try testing the function from the IDE then the actual window the hook function intercepts is that of the current active document. This isn't an issue for VB, so we don't have to program defensively for this scenario.

To get it to work correctly you need to either invoke from the application (eg a button on an Excel form or Word document) - or make some minor modifications to the code (the defensive programming mentioned above):

Option Explicit

' Necessary constants  for hooking
Private Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5

' Constants for password masking
Public Const EM_SETPASSWORDCHAR = &HCC

' Working variables that require global scope in hooking module
Private hHook As Long

' The API declarations we need
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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
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 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
[b]Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long[/b]


' Wrapper for the normal InputBox function
Public Function vbInputBox(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Single, Optional YPos As Single, Optional Helpfile As String, Optional Context As Long) As String 'Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String, Optional HelpFile As String, Optional Context As Long) As Long
    hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, [b]GetModuleHandle(vbNullString)[b], 0)
    vbInputBox = InputBox(Prompt, Title, Default, Xpos, YPos, Helpfile, Context)
End Function

Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim hwndEditControl As Long
    [b]Dim strClassname As String
    Dim result As Long
    
    strClassname = Space(1024)
    result = GetClassName(wParam, strClassname, Len(strClassname))[/b]

    If lMsg = HCBT_ACTIVATE [b]And Left(strClassname, result) = "#32770"[/b] Then
        hwndEditControl = FindWindowEx(wParam, 0, "Edit" , "") ' get the edit control
        If hwndEditControl Then SendMessage hwndEditControl, EM_SETPASSWORDCHAR, Asc("*"), 0 ' Do your stuff here to modify the window
        UnhookWindowsHookEx hHook ' Immediately unhook
    End If
    CBTProc = 0 ' allow operation to continue
End Function

 

[krinid]

strongm,
Thanks once again, it's working fine now. You are an incredibly helpful person to have around on these forums.

 

[iwantavr4]

I realize this thread is rather old. But is there any way you can do the same thing listed here in a VBScript? VB is very new to me i have a script written but the only options i have to 'protect' the password is to either have the user copy the password to clipboard and have the script paste into password box, or have the user type in cleartext into a inputbox.

Any help would be appreciated.

 

[iwantavr4]

Oh also. Im using windows 2000. I have found some documents on how to create the box within html but i cant figure out how to traverse the password from the ie section back to the vbs section... Heres the script i had tried for that:

DIM PWD
Function PasswordBox() 
  set oIE = CreateObject("InternetExplorer.Application") 
  With oIE 
    .RegisterAsDropTarget = False 
    .Resizable = False : .FullScreen = True 
    .width = 400 : .height = 100 
    .Navigate "about:blank" 
    Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop 
    .document.open 
    .document.write _ 
             "<html><head><" & "script>bboxwait=true;</" _ 
           & "script><title>Password _</title></head>"_ 
           & "<body bgColor=White scroll=no" _ 
           & " style='border-Style:outset;border-" _ 
           & "Width:3px'>" _ 
           & "<center><b>Please enter the password: </b>" _ 
           & "<input type=password id=pass><p>" _ 
           & "<button onclick='bboxwait=false;'>" _ 
           & " Submit </button>" _ 
           & "</center></body></html>" 
    .document.close 
    Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop 
    .Visible = True 
    CreateObject("Wscript.Shell").Appactivate "Password _" 
    With .document 
      oIE.left = .parentWindow.screen.width \ 2 - 200 
      oIE.top = .parentWindow.screen.height\ 2 - 100 
      .all.pass.focus 
      PasswordBox = "CANCELLED" 
      On Error Resume Next 
      Do While .parentWindow.bBoxWait 
        if Err Then Exit Function 
        WScript.Sleep 500 
      Loop 
      oIE.Visible = False 
       PasswordBox = .all.pass.value 

    End With ' document 
  End With ' IE 
End Function 

If PasswordBox = "" Then 
        msgbox "You did not enter a password." 
Else 
        msgbox "Press enter to continue.  "  & Trim(PWD) & " is your password"
End If 

PWD = Request.Form("passwordbox")

I must admit i really dont understand it though... I would like to use the passwordbox results as something i can use for a sendkeys command...

Thanks again.

 

[strongm]

Unfortunately VBScript cannot make API calls. So what you'd have to do is use something like VB to create a class that VBScript can then instantiate.

 

[iwantavr4]

It took me about 2 hours to learn how to write my script in VBS... I downloaded vb5cce but i have no clue how to use it. I tried pasting the code you all had put in the beginning of this post, but it kept giving me errors saying constants could not be.. lemme get the exact error...

"Compile error:
Constants, fixed-length strings, arrays, and Declare statements not allowed as Public members of object modules."

Perhaps I am doing something wrong? I go to view/code and paste it in, then 'run'.

 

[iwantavr4]

I actually found someone here at work who is proficient with VBS and he gave me the following code, theres only one problem and its when i click the submit button, the window does not respond or close...

'************************************************************************************
'Sub to get account name and password.  Calls "PasswordBox" function:
'************************************************************************************
Get_Account
Dim Pwd
Sub Get_Account()

   Pwd = PasswordBox("Enter your password")

End Sub


'************************************************************************************
'This function is for creating a Password input box which masks the input with "******"
'A WSH/VB InputBox is not recommended for password input because what the user
'types in is visible on the console. This function uses IE for the window.
'************************************************************************************

Function PasswordBox(sTitle)
  Set oIE = CreateObject("InternetExplorer.Application")
  'Modified (added), used by AppActivate
  sIETitle = "Password Input"

  With oIE
    .FullScreen = True
    .ToolBar   = False : .RegisterAsDropTarget = False
    .StatusBar = False : .Navigate("about:blank")

    'Modified
    'While .Busy : WScript.Sleep 100 : Wend
    Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop

    With .document
      With .ParentWindow
        .resizeto 400,100
        .moveto .screen.width/2-200, .screen.height/2-50
      End With
      'Modified (added)
      .WriteLn "<HTML><TITLE>" & sIETitle & "</TITLE>"
      .WriteLn("<html><body bgColor=Silver><center>")
      .WriteLn("&nbsp;<b>" & sTitle & "<b>&nbsp;<p>")
      .WriteLn("Password <input type=password id=pass> &nbsp; " & _
               "<button id=but0>Submit</button>")
      .WriteLn("</center></body></html>")
      With .ParentWindow.document.body
        .scroll="no"
        .style.borderStyle = "outset"
        .style.borderWidth = "3px"
      End With
      .all.but0.onclick = GetRef("PasswordBox_Submit")
      .all.pass.focus
      oIE.Visible = True

      'Modified (added)
      Set oShell = CreateObject("WScript.Shell")
      oShell.AppActivate sIETitle

      bPasswordBoxOkay = False : bPasswordBoxWait = True
      On Error Resume Next
      While bPasswordBoxWait
        WScript.Sleep 100
        If oIE.Visible Then bPasswordBoxWait = bPasswordBoxWait
        If Err Then bPasswordBoxWait = False
      Wend
      'Modified (added)
      PasswordBox = .all.pass.value
    End With ' document
    .Visible = False
    'Modified (added)
    .Quit
  End With   ' IE
End Function

Sub PasswordBox_Submit()
  bPasswordBoxWait = False