Option Explicit



''/////////////////////////////////////////////////////////////////

''//  25 May 2003 //

''// Amended Ivan F Moala

''/////////////////////////////////////////////////////////////////



Public Declare Function GetActiveWindow _

    Lib "user32" () _

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 SetTimer _

    Lib "user32" ( _

        ByVal hwnd As Long, _

        ByVal nIDEvent As Long, _

        ByVal uElapse As Long, _

        ByVal lpTimerFunc As Long) _

As Long



Public Declare Function KillTimer _

    Lib "user32" ( _

        ByVal hwnd As Long, _

        ByVal nIDEvent As Long) _

As Long



Public Declare Function GetForegroundWindow _

    Lib "user32" () _

As Long





Private Const nIDE As Long = &H100

Private Const EM_SETPASSWORDCHAR = &HCC



Private hdlEditBox As Long

Private Fgrndhdl As Long



Public Function TimerFunc( _

    ByVal hwnd As Long, _

    ByVal wMsg As Long, _

    ByVal nEvent As Long, _

    ByVal nSecs As Long) As Long

  

    Dim hdlwndAct As Long

    

    '// Do we have a handle to the EditBox

    If hdlEditBox > 0 Then Exit Function

  

    '// Get the handle to the ActiveWindow

    hdlwndAct = GetActiveWindow()

  

    '// Get the Editbox handle

    hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")

  

    '// Set the password character for the InputBox

    SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0



End Function



Public Function InPutBoxPwd(fPrompt As String, _

    Optional fTitle As String, _

    Optional fDefault As String, _

    Optional fXpos As Long, _

    Optional fYpos As Long, _

    Optional fHelpfile As String, _

    Optional fContext As Long) As String

    

    Dim sInput As String

    

    '// Initialize

    hdlEditBox = 0

    Fgrndhdl = GetForegroundWindow

    '// Windows-Timer

    SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc

    

    '// Main InputBox

    If fXpos Then

        sInput = InputBox(fPrompt, fTitle, fDefault, fXpos, fYpos, fHelpfile, fContext)

    Else

        sInput = InputBox(fPrompt, fTitle, fDefault, , , fHelpfile, fContext)

    End If

    

    '// Kill the correct Timer

    KillTimer Fgrndhdl, nIDE

    '// Pass result

    InPutBoxPwd = sInput

    

End Function



'////////////////////////////////////////////////////

'// This is The main routine

'// where we test it

'////////////////////////////////////////////////////



Sub GetPassWord()

Dim x As String



x = InPutBoxPwd("Please enter password", "Sentry")

If x = vbNullString Then

    MsgBox "User Cancelled"

Else

    MsgBox "User entered " & x

End If



End Sub