+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Şifre ile Form Açma Hakkında (/konu-sifre-ile-form-acma-hakkinda.html)
Şifre ile Form Açma Hakkında - notrino - 09/05/2016
Merhabalar,
Daha önce bir buton tıkladığımda şifre ekranı çıksın ve doğru şifre girdiğimde istenilen form açılsın şeklindeki talebime aşağıdaki kodlarla yanıt vermiştiniz;
Dim Sifre, DogruSifre As Variant
Sifre = InputBox("Şifreyi Yazınız", "Şifre?", , , , "", 0)
DogruSifre = "accesstr.net"
Select Case Len(Sifre)
Case 0
Exit Sub
Case Else
If Sifre = DogruSifre Then
DoCmd.OpenForm "Form1", acNormal
Else
MsgBox ("hatalı şifre yazdınız")
Exit Sub
End If
End Select
Sistem gayet güzel çalışıyor. Ancak şifre girişi için açılan Inputbox ta şifreyi girerken **** şeklinde veri girişi olmalı. Aksi halde şifre görünür oluyor. Bu penceredeki veri giriş şekline maalesef müdahale edemedim. Bu kodun içine nasıl gömebiliriz bu detayı? Tşk..
Cvp: Şifre ile Form Açma Hakkında - atoz112 - 09/05/2016
sayın notrino,
bahsettiğiniz talebinize yönelik olarak;
aşağıdaki kodları,yeni bir modül oluşturup ekleyiniz.
Kod:
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
RetVal = GetClassName(wParam, strClassName, lngBuffer)
'~~> Class name of the Inputbox
If Left$(strClassName, RetVal) = "#32770" Then
'~~> 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 FunctionKod:
Sifre = InputBox("Şifreyi Yazınız", "Şifre?", , , , "", 0)Kod:
Sifre = InputBoxDK("Şifreyi Yazınız", "Şifre?", , , , "", 0)Cvp: Şifre ile Form Açma Hakkında - notrino - 10/05/2016
Teşekkürler