converting VBA password-masking code to 64-bit

[Mike Burnett]

Hi all,

I promise I'm not the guy that cross-posted a related question ~twenty times on this topic. Even after all of those posts though, a straightforward answer was not revealed (at least it wasn't clear to me). I simply need a nudge in the right direction. I can't figure out why the statement in red below causes Excel to crash and close.

In the process of troubleshooting, I switched hHook to long (and changed SetWindowsHookEx output to long and lngModHwnd to long after being prompted to do so by the compiler) to see what would happen. The program no longer crashed at the red line, but the program did not enter the masking routine either (did not jump into the NewProc_64 function).

I'm sure I just have some of the variables and parameters declared incorrectly as long when they should be longptr and vice versa. I probably also should be using LongLong in some places, but I'm not certain how to implement that.

I found examples of all the API declaration statements written to work in the 64-bit Office environment on a few sites. I'm pretty sure they are correct, but I can't be absolutely certain.

Thanks very much for any help you can provide!

Mike


Here are my declarations...

Option Explicit
Public hHook As LongPtr
Public Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
Public Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr
Public Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As LongPtr, ByVal uExitCode As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Public Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
Public Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

Public Const EM_SETPASSWORDCHAR = &HCC
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public Const HC_ACTION = 0
Here is the code...

Sub testInput64()
Dim test As String
test = InputBoxDK_64("Enter your SAP password.", "SAP Password")
End Sub

Function InputBoxDK_64(Prompt, Title) As String
Dim lngModHwnd As LongPtr, lngThreadID As Long
On Error Resume Next
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc_64, lngModHwnd, lngThreadID)
InputBoxDK_64 = InputBox(Prompt, Title)
UnhookWindowsHookEx hHook
End Function

Public Function NewProc_64(ByVal lngCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Dim RetVal
Dim strClassName As String, lngBuffer As Long
On Error Resume Next
If lngCode < HC_ACTION Then
NewProc_64 = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function