(تمت الاجابة) اريد وضع كلمة مرور لفتح النماذج

[فرهاد كريم]

بسم الله الرحمن الرحيم

تحية طيبة للجميع

اساتذة لدية برنامج للمثال و قمت بتصميم نموذجين الاول ( Form Book) و الثانى ( Form Employees ) و قمت بتصميم فورم الرئيسى ( Main Form )

فى نموذج الرئيسى ( Main Form ) قمت بوضع الزر Book و الزر Employees

المطلوب : اريد فتح فورم Book بكلمة مرور و كذالك فى فورم Employees بكلمة مرور اخر

Sample.rar

[أبو آدم]

أخي العزيز

إستخدم الكود التالي

Private Sub Form_Open(Cancel As Integer)

 Dim x As String

 x = "password"

 Dim y As String

 y = InputBox("Enter Password for form")

 If x <> y Then

 MsgBox ("Invalid password")

 DoCmd.CancelEvent


 End If

 End Sub

قم باستبدال password بكلمة المرور التي تريد في كل نموذج

ووافني بالنتيجة

...

[فرهاد كريم]

تمام استاذى العزيز ان شاء الله دائما موفق

[العارف بالله]

ولكن اذا اردنا ان تظهر نجوم عند كتابة الباسورد

حتى لا يراها احد؟

[أبو آدم]

إخوتي الأعزاء

هذا ايضا متاح

قم بفتح وحدة نمطية جديدة وأدرج بها :

Option Explicit

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


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)


        If Left$(strClassName, RetVal) = "#32770" Then


            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0

        End If


    End If


    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

وفي حدث عند التحميل للنموذج أدرج الكود التالي:

Private Sub Form_Open(Cancel As Integer)

Dim x As String

x = "123"

Dim y As String

y = InputBoxDK("Enter Password for form")

If x <> y Then

MsgBox ("Invalid password")

DoCmd.CancelEvent

End If

End Sub

وننال المراد بإذن الله

وللتطبيق اليك المرفق (كلمة المرور 123)

والله من وراء القصد ....

.....

NA_PasswordMaskedInputbox.rar

[ahmed saif]

بارك الله فيكم

[khaled-acc]

جزاكم الله خيراً على هذه الفكرة .

هل يمكن تطبيقها عند تغيير طريقة العرض إلى وضع التصميم .

[الضياء2008]

جزاكم الله خيرا

هل بالمكان جعل المستخدم يستطيع تغيير الباسوورد؟

[محمود ادريس]

السلام عليكم

حدد المربع الذى توريد كتابة كلمة السر فيه واذهب الى خصائص المربع وقم بتغيير قناع الادخال الى كلمة سر  

[omarahmed1424]

السلام عليكم ورحمة الله وبركاته 

أعضاء المنتدى الكرام حفظكم الله 

أستخدم الكود التالي لطلب كلمة مرور لفتح النموذج وحاولت أن أستخدم معه الوحدة النمطية المعروضة في هذا الموضوع لتظهر كلمة المرور على شكل نجوم فلم أستطيع التعديل على الوحدة النمطية وعدد النماذج التي أستخدم لها كلمة مرور كبير جدا يصعب التعديل على كودها فهل من معين بعد الله يعدل لي الوحدة النمطية مع بقاء الكود للنماذج كما هو في التالي 

Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
      Dim intinput As Integer
    intinput = InputBox("فضلاً ادخل الرقم السري", "دخول")
    If intinput = 12011 Then
        Cancel = False
    Else
        MsgBox "عفواً كلمة المرور غير صحيحة", vbOKOnly + vbMsgBoxRight, "تنبيه"
        Cancel = True
    End If
End Sub

تم تعديل مايو 2, 2017 بواسطه omarahmed1424

[moamen salem]

اشكرك جدااا يا غالي 💐 

تم تعديل ديسمبر 1, 2020 بواسطه moamen salem

[moamen salem]

في ٢‏/٥‏/٢٠١٧ at 13:20, omarahmed1424 said:

السلام عليكم ورحمة الله وبركاته 

أعضاء المنتدى الكرام حفظكم الله 

أستخدم الكود التالي لطلب كلمة مرور لفتح النموذج وحاولت أن أستخدم معه الوحدة النمطية المعروضة في هذا الموضوع لتظهر كلمة المرور على شكل نجوم فلم أستطيع التعديل على الوحدة النمطية وعدد النماذج التي أستخدم لها كلمة مرور كبير جدا يصعب التعديل على كودها فهل من معين بعد الله يعدل لي الوحدة النمطية مع بقاء الكود للنماذج كما هو في التالي 

Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
      Dim intinput As Integer
    intinput = InputBox("فضلاً ادخل الرقم السري", "دخول")
    If intinput = 12011 Then
        Cancel = False
    Else
        MsgBox "عفواً كلمة المرور غير صحيحة", vbOKOnly + vbMsgBoxRight, "تنبيه"
        Cancel = True
    End If
End Sub

غير InputBox ب lnputboxdk فقط