Şifre ile Form Açma Hakkında

09/05/2016, 15:17

notrino

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..
09/05/2016, 15:28

atoz112

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 Function
ardından,
Kod:
Sifre = InputBox("Şifreyi Yazınız", "Şifre?", , , , "", 0)
kod satırını,
Kod:
Sifre = InputBoxDK("Şifreyi Yazınız", "Şifre?", , , , "", 0)
ile değiştiriniz.bilginize...iyi çalışmalar,saygılar.
10/05/2016, 09:16

notrino

Teşekkürler