MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

5 participantes

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    avatar
    cicero.meneses
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 32
    Registrado : 15/09/2014

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  cicero.meneses 7/10/2014, 15:16

    Bom dia,

    Copiei esse modulo ele funciona perfeitamente, mas quando executo no Office 64 bits dá erro, alguém pode me dizer onde devo alterá-lo para conseguir executar em 64 bits também.

    Obrigado

    Código:

    Option Compare Database
    '////////////////////////////////////////////////////////////////////
    '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

    #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

    #End If



    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

    '// 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

    End Function
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7310
    Registrado : 15/03/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  ahteixeira 7/10/2014, 15:39

    Olá, uma busca aqui no forum e encontra vários artigos.
    Veja o link abaixo do nosso grande mestre Avelino:
    http://www.usandoaccess.com.br/tutoriais/configurar-api-access-de-64-e-32-bits-ptrsafe.asp?id=1#inicio
    Abraço
    avatar
    cicero.meneses
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 32
    Registrado : 15/09/2014

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Alterar modulo para rodar em 32 e 64 bits

    Mensagem  cicero.meneses 7/10/2014, 16:02

    Já alterei em um monte de lugar e não consigo fazer rodar.

    Podem me ajudar
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7310
    Registrado : 15/03/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  ahteixeira 7/10/2014, 16:31

    Que erro é que está a dar?
    Qual a versao do SO?
    Qual a versao do office ?

    Veja recomendação do Mestre Avelino para desenvolvimento:
    http://maximoaccess.forumeiros.com/t19710-migracao-access-2003-para-2013#145640

    (actualização) Em especial esta parte
    [Resolvido]Alterar modulo para rodar em 32 e 64 bits 25sboys


    Última edição por ahteixeira em 7/10/2014, 18:36, editado 1 vez(es)
    avatar
    cicero.meneses
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 32
    Registrado : 15/09/2014

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Alterar modulo para rodar em 32 e 64 bits

    Mensagem  cicero.meneses 7/10/2014, 17:53

    O erro é O Código deve ser atualizado para uso em 64 bits. Analise e atualize as instruções Declare e, em seguida, marque-as com o atributo PtrSafe.

    O SO é Windows 7

    O Office é 2010 32 Bits, no Office 64 bits dá erro.

    Obrigado
    percoski
    percoski
    Avançado
    Avançado

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 319
    Registrado : 27/02/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  percoski 7/10/2014, 18:11

    Com a licença de todos pude verificar que existem alguns Public Declare PtrSafe, eles devem ser assim como descrevi

    Código:
    Option Compare Database
    '////////////////////////////////////////////////////////////////////
    '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

    #Else
    'Linhas normais
    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

    #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 PtrSafe 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
    Atualizai veja se vai funcionar.
    avatar
    cicero.meneses
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 32
    Registrado : 15/09/2014

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Alterar modulo para rodar em 32 e 64 bits

    Mensagem  cicero.meneses 7/10/2014, 19:12

    Essa parte está ficando em vermelho e dá erro de compilação

    Public PtrSafe Function NewProc(ByVal lngCode As Long, _
    ByVal wParam As Long, _
    ByVal LParam As Long) As Long
    percoski
    percoski
    Avançado
    Avançado

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 319
    Registrado : 27/02/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  percoski 7/10/2014, 19:17

    Retire o PtrSafe e tente novamente
    avatar
    cicero.meneses
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 32
    Registrado : 15/09/2014

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Alterar modulo para rodar em 32 e 64 bits

    Mensagem  cicero.meneses 7/10/2014, 19:56

    No office 32 bits roda, no 64 da erro de compilação.

    Essa parte que está entre os asteriscos está ficando amarelo com: erro de compilação: tipos incompatíveis.

    Esse código ficando em azul.  está na linha onde o início é hHook =  "AddressOf NewProc"


    '// 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

    End Function
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7310
    Registrado : 15/03/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  ahteixeira 8/10/2014, 12:06

    Olá, veja a referencia e comentários se ajuda:

    http://msdn.microsoft.com/en-us/library/windows/desktop/ms644990(v=vs.85).aspx



    Avelino Sampaio
    Avelino Sampaio
    Developer
    Developer

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3740
    Registrado : 04/04/2010

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  Avelino Sampaio 8/10/2014, 12:56

    Olá!

    Um detalhe que não está sendo observado é que todas as APIs devem ficar dentro da condicional #IF.  Por que somente a API Shell32 esta dentro da #IF ???

    #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

    O segundo detalhe é que não é só acrescentar ptrSafe.  É preciso saber se tem que trocar algumas variáveis de long para longptr

    Volte ao meu artigo e baixe o aquivo txt que possui as Api's com a escrita correta.

    Sucesso!


    .................................................................................
    Vídeos, livros, kit MontaRibbons e acesso irrestrito ao site UsandoAcces  
    Clique AQUI e analise o custo beneficio do material oferecido.
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7310
    Registrado : 15/03/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  ahteixeira 8/10/2014, 14:08

    Olá Mestre Avelino, obrigado pela ajuda.

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits 2ia4b9j

    No meu teste esta a dar Type mismatch, efetivamente, vai ser necessário ajustar as variaveis long.
    Na minha opinião, criando a condição conforme exemplificado na imagem da mensagem nº 4, ficando assim a funcionar para 32 ou 64 bit.
    Abraço
    avatar
    Claudemir P
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 177
    Registrado : 27/06/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  Claudemir P 1/10/2016, 03:02

    Boa noite a todos, estou tendo o mesmo problema, sempre funcionou no access 32 agora no 64 esta gerando erro, após colocar ptrsafe gera erro na linha AddressOf NewProc.
    avatar
    Claudemir P
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 177
    Registrado : 27/06/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  Claudemir P 2/10/2016, 21:28

    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?
    Avelino Sampaio
    Avelino Sampaio
    Developer
    Developer

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3740
    Registrado : 04/04/2010

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  Avelino Sampaio 3/10/2016, 14:02

    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


    .................................................................................
    Vídeos, livros, kit MontaRibbons e acesso irrestrito ao site UsandoAcces  
    Clique AQUI e analise o custo beneficio do material oferecido.
    avatar
    Claudemir P
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 177
    Registrado : 27/06/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  Claudemir P 7/10/2016, 00:25

    Boa noite Avelino, não apressando vi o artigo
    [Removido o link - Não é permitido links externos]

    Mas não achei, conseguiu solução para este caso?

    Grato
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7310
    Registrado : 15/03/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  ahteixeira 7/10/2016, 08:50

    Olá, o link que postou estava errado e foi eliminado por ser link externo.
    Verifique na mensagem nº 10 do tópico abaixo o link correcto:
    https://www.maximoaccess.com/t28022-funcionar-em-32-e-64-bits-addressof-newproc-com-erro

    Abraço
    avatar
    Claudemir P
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 177
    Registrado : 27/06/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  Claudemir P 9/10/2016, 17:13

    Boa tarde à todos, obrigado ahteixeira pela orientação das regras e dica. Me ajudou a melhorar.
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7310
    Registrado : 15/03/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  ahteixeira 10/10/2016, 15:41

    Olá a todos,
    O que foi aqui apresentado como solução foi aplicada no tópico abaixo:
    https://www.maximoaccess.com/t344-login-com-mascara-de-password-na-inputbox

    Abraço
    avatar
    Claudemir P
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 177
    Registrado : 27/06/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  Claudemir P 11/10/2016, 02:32

    Obrigado à todos por solucionar esta questão
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7310
    Registrado : 15/03/2013

    [Resolvido]Alterar modulo para rodar em 32 e 64 bits Empty Re: [Resolvido]Alterar modulo para rodar em 32 e 64 bits

    Mensagem  ahteixeira 11/10/2016, 14:38

    Olá a todos,
    Obrigado pelo retorno.

    Para os membros menos atentos, o nosso colega Avelino Sampaio também apresentou outra solução para o mesmo problema, que podem consultar na mensagem nº 10 do tópico abaixo:
    https://www.maximoaccess.com/t28022-resolvido-funcionar-em-32-e-64-bits-addressof-newproc-com-erro
    cheers

      Data/hora atual: 23/9/2021, 01:14