Results 1 to 14 of 14
  1. #1
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9

    *** mask password in inputbox

    Hello!



    I am trying to get this code to work.
    It's for making **** in the field of an inputbox, so the password cant be seen.

    I's originally a code for a 32 bit system, so the real challenge here is converting it to 64 bit.



    The code are:



    Code:
    Public sPwd As String
    Public gMsgTitle As String
    Public gMsgType As String
    Public gMsgText As String
    Public gStatusText As String
    
    "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias _
    "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
    ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    
    Public Declare PtrSafe Function SetTimer& Lib "user32" _
    (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
    lpTimerFunc&)
    
    Public Declare PtrSafe Function KillTimer& Lib "user32" _
    (ByVal hwnd&, ByVal nIDEvent&)
    
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, _
    ByVal wParam As LongPtr, lParam As Any) As LongPtr
    
    Const EM_SETPASSWORDCHAR = &HCC
    Public Const NV_INPUTBOX As Long = &H5000&
    And Function:

    Code:
    Public Function TimerProc(ByVal lHwnd&, ByVal uMsg&, _
    ByVal lIDEvent&, ByVal lDWTime&) As LongPtr
    
    Dim lTemp As Long
    Dim lEditHwnd As Long
    lTemp = FindWindowEx(FindWindow("#32770", "gMsgText"), 0, "Edit", "")
    lEditHwnd = FindWindowEx(FindWindow("#32770", "gMsgTitle"), 0, "Edit", "")
    
    Call SendMessage(lEditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)
    
    KillTimer lHwnd, lIDEvent
    End Function
    Input box:

    Code:
    Private Sub OpnAdm_Click()
    
    gMsgTitle = "Begrenset Omrde"
    gMsgType = vbOKOnly + vbInformation
    gMsgText = "Tast inn passord"
      
    
    lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
    sPwd = InputBox(gMsgText, gMsgTitle)
    
    
    If strPasswd = "" Or strPasswd = Empty Then
    Exit Sub
    End If
    
    If strPasswd = "yslg53481" Then
    DoCmd.OpenForm "frmBatchReg"
    Else
    MsgBox "Beklager, du har ikke tilgang til denne delen av programmet", vbOKOnly, "Sikkerhetssjekk"
    Exit Sub
    End If
    
    
    End Sub
    Missing anything? The error I get is type missmatch on AddressOf TimerProc. But I know its also needs converting to 64 bit. Don't know how though.



    I know its 1000 times easier to just make a new form and pwd mask the inputmask, but this is not the case here. I'd rather have more code and less forms, and it get's on my nerves that I cant find it out, so just need see this through, especially when so many other 32 bit users got it to work


    Anyone know what to do here?

  2. #2
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,822
    What is AddressOf TimerProc? Why is there a space?
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9
    TimerProc is a function declared in the modDeclarations. For allowing a mask character on the inputbox. This code is not my writing btw, so I don not fully understand it.

  4. #4
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,822
    Okay, I see the TimerProc function. It has 4 required arguments. No arguments are provided when the function is called in OpnAdm_Click()

    SetTimer() also has 4 required arguments. AddressOf ProcTimer is in the 4th argument position. Maybe this argument fails.

    Need to know what 4 values should be passed to ProcTimer.

    Also need to know what AddressOf is.

    Where did this code come from?
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  5. #5
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9
    Posted this on other forums; Just for information (got some angry moderators breathing down my neck:
    I have posted this issue on several forums, simply because I don't think it's an easy fix, and most likely it's just a few people who can solve this. Where they are is hard to know, so I have multiplied the chances of finding them by going wide on the internet Do not worry on dobbelt solving this problem, the minute we find a solution it's out on every forum. I do not want others to use as much time on this as I have. In fact I hope to maybe make a youtube video But first the problem needs solving So thx anyway for reading, I am quite out of my depth here now, so ain't getting further here without anyone with a little more experience

    Regards
    -Kv

  6. #6
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9
    Quote Originally Posted by June7 View Post
    Okay, I see the TimerProc function. It has 4 required arguments. No arguments are provided when the function is called in OpnAdm_Click()

    SetTimer() also has 4 required arguments. AddressOf ProcTimer is in the 4th argument position. This argument fails.

    Need to know what 4 values should be passed to ProcTimer.

    Also need to know what AddressOf is.

    Where did this code come from?

    Found it here http://www.access-programmers.co.uk/...d.php?t=176711

    I am not good at explaining so I do believe it is more effectively to just post this:
    http://msdn.microsoft.com/en-us/libr...ffice.15).aspx
    Than explaining

    Have also tried looking at this:
    http://msdn.microsoft.com/en-us/libr...ffice.15).aspx
    But getting nowhere :/

  7. #7
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,822
    Wow - new stuff!

    The example in the MS article is to iterate through fonts collection and add them into a listbox.

    Not sure how that applies to InputBox entry.

    Unfortunately the download for the demo db in that thread is not working for me. Did you download it? If so, want to attach it here?
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  8. #8
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9

  9. #9
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9
    Got some angry mod at this forum ( http://www.utteraccess.com/forum/Mas...7#entry2501377 ) tipsing about API declarations for 64 bit Office/VBA7 So trying to loock at that closer tomorrow Now it's 02.00 and way past my bedtime at 18.00 Haha, just kidding, cya^^

  10. #10
    amrut is offline Expert
    Windows 7 64bit Access 2010 32bit
    Join Date
    Jun 2012
    Location
    Dubai
    Posts
    614
    Here is one I am using -
    Code:
    Option Compare Database
    Option Explicit
    '////////////////////////////////////////////////////////////////////
    'Password masked inputbox
    'Allows you to hide characters entered in a VBA Inputbox.
    '
    'Code written by Daniel Klann
    'March 2003
    '////////////////////////////////////////////////////////////////////
    
    
    'API functions to be used
    Private Declare Function CallNextHookEx Lib "User32" (ByVal hHook As Long, _
                                                          ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) 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 UnhookWindowsHookEx Lib "User32" (ByVal hHook As Long) As Long
    
    Private Declare Function SendDlgItemMessage Lib "User32" Alias "SendDlgItemMessageA" _
                                                (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
                                                ByVal wParam As Long, ByVal lParam 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 Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    
    'Constants to be used in our API functions
    Private Const EM_SETPASSWORDCHAR = &HCC
    Private Const WH_CBT = 5
    Private Const HCBT_ACTIVATE = 5
    Private Const HC_ACTION = 0
    
    Private hHook As Long
    
    Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Dim RetVal
        Dim strClassName As String, lngBuffer As Long
    
        If lngCode < HC_ACTION Then
            NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
            Exit Function
        End If
    
        strClassName = String$(256, " ")
        lngBuffer = 255
    
        If lngCode = HCBT_ACTIVATE Then    'A window has been activated
    
            RetVal = GetClassName(wParam, strClassName, lngBuffer)
    
            If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox
    
                'This changes the edit control so that it display the password character *.
                'You can change the Asc("*") as you please.
                SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
            End If
    
        End If
    
        'This line will ensure that any other hooks that may be in place are
        'called correctly.
        CallNextHookEx hHook, lngCode, wParam, lParam
    
    End Function
    
    Public Function InputBoxMasked(Prompt, Optional Title, Optional Default, Optional XPos, _
                            Optional YPos, Optional HelpFile, Optional Context) As String
        
        Dim lngModHwnd As Long, lngThreadID As Long
    
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
    
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    
        InputBoxMasked = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
        UnhookWindowsHookEx hHook
    
    End Function

  11. #11
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,822
    Okay, that works. So I guess AddressOf is available.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  12. #12
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9
    Quote Originally Posted by amrut View Post
    Here is one I am using -
    Code:
    Option Compare Database
    Option Explicit
    '////////////////////////////////////////////////////////////////////
    'Password masked inputbox
    'Allows you to hide characters entered in a VBA Inputbox.
    '
    'Code written by Daniel Klann
    'March 2003
    '////////////////////////////////////////////////////////////////////
    
    
    'API functions to be used
    Private Declare Function CallNextHookEx Lib "User32" (ByVal hHook As Long, _
                                                          ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) 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 UnhookWindowsHookEx Lib "User32" (ByVal hHook As Long) As Long
    
    Private Declare Function SendDlgItemMessage Lib "User32" Alias "SendDlgItemMessageA" _
                                                (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
                                                ByVal wParam As Long, ByVal lParam 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 Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    
    'Constants to be used in our API functions
    Private Const EM_SETPASSWORDCHAR = &HCC
    Private Const WH_CBT = 5
    Private Const HCBT_ACTIVATE = 5
    Private Const HC_ACTION = 0
    
    Private hHook As Long
    
    Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Dim RetVal
        Dim strClassName As String, lngBuffer As Long
    
        If lngCode < HC_ACTION Then
            NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
            Exit Function
        End If
    
        strClassName = String$(256, " ")
        lngBuffer = 255
    
        If lngCode = HCBT_ACTIVATE Then    'A window has been activated
    
            RetVal = GetClassName(wParam, strClassName, lngBuffer)
    
            If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox
    
                'This changes the edit control so that it display the password character *.
                'You can change the Asc("*") as you please.
                SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
            End If
    
        End If
    
        'This line will ensure that any other hooks that may be in place are
        'called correctly.
        CallNextHookEx hHook, lngCode, wParam, lParam
    
    End Function
    
    Public Function InputBoxMasked(Prompt, Optional Title, Optional Default, Optional XPos, _
                            Optional YPos, Optional HelpFile, Optional Context) As String
        
        Dim lngModHwnd As Long, lngThreadID As Long
    
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
    
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    
        InputBoxMasked = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
        UnhookWindowsHookEx hHook
    
    End Function

    This was the original code my code was made out of. The problem is that I have 64bit access (aparantly). When I type in the code The first thing I get is:
    Click image for larger version. 

Name:	Compile error.PNG 
Views:	32 
Size:	8.4 KB 
ID:	18746

    Then:

    Click image for larger version. 

Name:	Type Missmatch.PNG 
Views:	33 
Size:	15.5 KB 
ID:	18747

    But got som tips from another forum to ake a loock at this: http://msdn.microsoft.com/en-us/libr...ffice.14).aspx


  13. #13
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9

  14. #14
    Kvracing is offline Novice
    Windows 7 64bit Access 2013
    Join Date
    Nov 2014
    Posts
    9
    Ty for answers, but this took to much time. So I converted to 32 bit. Solved the whole problem

Please reply to this thread with any new information or opinions.

Similar Threads

  1. 'InputBox' Field Size
    By BenPala in forum Access
    Replies: 1
    Last Post: 08-31-2014, 08:25 AM
  2. Web Database: Input Mask for Password
    By besuchanko in forum Forms
    Replies: 3
    Last Post: 07-25-2013, 03:28 PM
  3. Inputbox
    By mladen273 in forum Programming
    Replies: 8
    Last Post: 12-29-2012, 05:32 AM
  4. Inputbox on programming? :(
    By radicrains in forum Programming
    Replies: 7
    Last Post: 11-05-2010, 10:58 PM
  5. Query & InputBox
    By RemusRigo in forum Queries
    Replies: 1
    Last Post: 03-25-2009, 08:21 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums