[Resolvido] Funcionar em 32 e 64 bits - "AddressOf NewProc" com erro

Boa noite, duas dúvidas?
1) vi vários tópicos, tentei todas opções sem êxito. Pergunto nos tópicos já encerrados ou abro novo tópico?
2) Este código não esta funcionando no 64 bits:

Código:

Public Function InputBoxDK(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)

    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, CONTEXT)
    UnhookWindowsHookEx hHook

End Function


Com mensagem: Erro de compilação - Tipos incompatíveis.
Fica selecionado azul: AddressOf NewProc
Fica selecionado amarelo: Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
                       Optional YPos, Optional HelpFile, Optional CONTEXT) As String

Após converter para 64 bits, sistema esta apresentando erro.

Ao digitar usuário, fica azul a seleção: AddressOf NewProc
fica amarelo a seleção:  Public Function InputBoxDK(Prompt As String, Optional Title As String, _
Optional Default As String, _
Optional Xpos As Long, _
Optional Ypos As Long, _
Optional Helpfile As String, _
Optional CONTEXT As Long) As String

Código:

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003

'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// http://www.xcelfiles.com
'// April 2003
'// Works for Xl2000+ due the AddressOf Operator
'////////////////////////////////////////////////////////////////////

'******************** CALL FROM FORM *********************************
' Dim pwd As String
'
' pwd = InputBoxDK("Please Enter Password Below!", "Database Administration Security Form.")
'
' 'If no password was entered.
' If pwd = "" Then
' MsgBox "You didn't enter a password! You must enter password to 'enter the Administration Screen!" _
' , vbInformation, "Security Warning"
' End If
'**************************************



'API functions to be used

#If VBA7 Then
'Linhas com ptrSafe
Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'Todas as APIs aqui para a versão 2010 ou superior - 32 ou 64 bits
#Else
'Linhas normais
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'Todas as Apis Aqui para versão 2007 e inferiores - 32 bits
#End If



Private Declare PtrSafe Function CallNextHookEx _
Lib "user32" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long

Private Declare PtrSafe Function GetModuleHandle _
Lib "kernel32" _
Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String) _
As Long

Private Declare PtrSafe 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 PtrSafe Function UnhookWindowsHookEx _
Lib "user32" ( _
ByVal hHook As Long) _
As Long

Private Declare PtrSafe 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 PtrSafe Function GetClassName _
Lib "user32" _
Alias "GetClassNameA" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long

Private Declare PtrSafe 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

'// Make it public = avail to ALL Modules
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, _
Optional Default As String, _
Optional Xpos As Long, _
Optional Ypos As Long, _
Optional Helpfile As String, _
Optional CONTEXT As Long) As String

Dim lngModHwnd As Long, lngThreadID As Long

'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)

hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
If Xpos Then
InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, CONTEXT)
Else
InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, CONTEXT)
End If

ExitProperly:
UnhookWindowsHookEx hHook



Amigo você abriu dois tópicos com o mesmo assunto, por favor reveja.

Abraços

consegui fazer funcionar depois de muito procurar na internet juntei várias partes de instruções e ficou assim:

Código:

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
#If VBA7 Then
    Private Declare PtrSafe Function CallNextHookEx Lib "User32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

    Private Declare PtrSafe Function SetWindowsHookEx Lib "User32" Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As Long, _
    ByVal dwThreadId As Long) As Long

    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As Long) As Long

    Private Declare PtrSafe 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 PtrSafe Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long

    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

    Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Declare PtrSafe Function apiGetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

#Else
    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
#End If
'~~> 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

'este procedimento aparentemente faz funcionar em 32 e 64, porém no 64 só funcionou sem IF na última linha
'#If VBA7 Then
'    Private hHook As LongPtr
'#Else
'    Private hHook As Long
'#End If
    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 InputBoxDK(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)

InputBoxDK = InputBox(Prompt, title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook

End Function

o único problema ainda não resolvido foi que não aparece asterisco ao digitar a senha, para este problema alguém tem alguma solução?

consegui fazer funcionar depois de muito procurar na internet juntei várias partes de instruções e ficou assim:

Código:

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
#If VBA7 Then
    Private Declare PtrSafe Function CallNextHookEx Lib "User32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

    Private Declare PtrSafe Function SetWindowsHookEx Lib "User32" Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As Long, _
    ByVal dwThreadId As Long) As Long

    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As Long) As Long

    Private Declare PtrSafe 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 PtrSafe Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long

    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

    Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Declare PtrSafe Function apiGetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

#Else
    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
#End If
'~~> 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

'este procedimento aparentemente faz funcionar em 32 e 64, porém no 64 só funcionou sem IF na última linha
'#If VBA7 Then
'    Private hHook As LongPtr
'#Else
'    Private hHook As Long
'#End If
    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 InputBoxDK(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)

InputBoxDK = InputBox(Prompt, title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook

End Function

o único problema ainda não resolvido foi que não aparece asterisco ao digitar a senha, para este problema alguém tem alguma solução?

Olá a todos.

Claudemir Pastora, tenha atenção com as REGRAS DO FÓRUM:

1. Tenha paciência com quem coloca aqui as suas duvidas.
2. Clareza nos títulos dos tópicos e duvidas, evite a linguagem MSN.
3. Não colocar diversas vezes a mesma dúvida.
4. Explicar detalhadamente o problema e informar a versão do seu Office + Sistema Operativo.
5. Retorne sempre se deu certo, esse retorno é muito importante.
6. Respeite toda a equipe Staff e demais membros deste fórum.
7. Use sempre o botão Busca, sempre que tiver uma dúvida e antes de abrir tópicos.
8. Não usar palavras como "Urgente". O fórum é livre e ninguém é obrigado a responder com urgência.
9. A publicidade é proíbida e só pode ser feita pelo Administrador ou depois de aprovada pelo Administrador.
10. Se o seu tópico não for respondido, tem o direito de fazer um Up ao final de 24horas!
11. A colocação de Códigos ou Exemplos, devem constar sempre os créditos de quem o elaborou.
12. Fale, não GRITE! Só letras Maiúsculas, na Internet é o mesmo que gritar!
13. É proibido tirar duvidas nas Salas de Repositório, devem abrir um novo tópico nas salas de duvidas, relacionando o Exemplo em causa.

O tópico foi fundido, não se esqueça de dar como resolvido.

Aproveito para solicitar que reveja os tópicos que abriu e não deu continuidade.
Os utilizadores do fórum merecem e agradecem o retorno.
Abraço a todos

Claudemir,

estarei lançando um artigo amanhã, com uma solução no próprio Access. Sem uso de Api's.

Cadastre-se no meu site para receber o meu newsletter

Aguarde

Bom dia.
Obrigado Teixeira por ter fundido os tópicos, parece que o amigo Claudemir P não deu a mínima pro que falei pra ele.

Olá Cláudio Machado, obrigado pelo alerta.
Parece que sim, ... no entanto espero que o colega inicie uma nova conduta após a minha última mensagem.
Abraço

Conforme combinado, segue link do novo artigo:

http://www.usandoaccess.com.br/tutoriais/inputbox-com-entrada-para-senha.asp?id=1#inicio

Bom estudo!

Boa tarde à todos, obrigado ahteixeira e Cláudio Machado me ajudaram a melhorar com as dicas/orientações.

Embora, os tópicos se tratem de problemas distintos (um fala da função InputBoxDk e outro fala do comando AddressOf NewProc). Mesmo o comando estando contido na função, no momento em que solucionei parte da função e descobri o comando que estava com erro, facilitei/agilizei a leitura/solução criando um tópico do comando com erro já que noutro tópico da mesma função ainda não foi solucionado  Alterar modulo para rodar em 32 e 64 bits desde 2014! Minha intenção foi focar e facilitar e não bagunçar e atrapalhar, desculpa se atrapalhei.

Desculpa a demora em responder é que com o término da greve dos bancos o serviço aumentou e estou em período de provas na faculdade.

Olá a todos,
Avelino Sampaio, obrigado pela partilha do artigo, excelente alternativa, é preferível em prol do código, eu pessoalmente adotava a sua solução.

Claudemir,
O que foi aqui proposto para alteração do codigo foi efetuado no tópico abaixo:
https://www.maximoaccess.com/t344-login-com-mascara-de-password-na-inputbox
Abraço

Obrigado, principalmente ao Avelino Sampaio que me garantiu a solução e de, fato resolveu melhor do que esperado.

E também ao ahteixeira que solucionou um problema que perdurou por anos sem solução.

Obrigado a todos pelo empenho, tempo e paciência.

Olá a todos,
Obrigado pelo retorno.