Kvracing
11-14-2014, 04:01 PM
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:
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:
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:
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 miss match on AddressOf TimerProc. But I know its also needs converting to 64 bit. Don't know how tough.
I know its 1000 times easier to just make an new form and pwd mask the input mask, but this is not the case here. I 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? :)
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:
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:
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:
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 miss match on AddressOf TimerProc. But I know its also needs converting to 64 bit. Don't know how tough.
I know its 1000 times easier to just make an new form and pwd mask the input mask, but this is not the case here. I 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? :)