كيف يمكن جعل كلمة السر على شكل نجوم

[الحلبي]

السلام عليكم 

فى المثال المرفق الذى قام بعمله استاذى الفاضل ومعلمى / @ابو جودي

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

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

عدد المستخدمين.accdb

تم تعديل أغسطس 29 بواسطه الحلبي

[ابو جودي]

فى خاضية اسمها input mask  للحقل فى الجدول

كل ما عليك انك تغيرها وتخليها : Password

وبرضو ده موجود فى خصائص مربع النص فى النموذج

كمان لو اردت اضافة مرع اختيار check box بحيث لما تخليه صح يظهر الباسور ولما تغيره يظهر النجوم تانى 

افترض ان مربع الاختيار ده اسمه: Checkbox
وافترض ان مربع نص الذى يستخدم لكلمة المرور اسمه: pass

استخد الكود التالي فى حدث بعد التحديث ل checkbox

Private Sub Checkbox_AfterUpdate()
    If Me.Checkbox.Value = True Then: Me.pass.InputMask = "": Else: Me.pass.InputMask = "Password"
End Sub

 

[الحلبي]

استاذى ومعلمى الفاضل @ابو جودي

انت غير منتبه حضرتك الذى صمم الكود انظر الى المثال المرفق

الرسالة التى تظهر بكتابة باص وورد  خارجية كيف يتم ذلك فيها وتكون على شكل نجوم

معلش استاذى انظر للمثال المرفق

 

[الحلبي]

افكرك بهذا 

انا اريد عند ادخال كلمة السر وهى 123 ان تكون هذه الارقام على شكل نجوم

[ابو جودي]

1 ساعه مضت, الحلبي said:

انا اريد عند ادخال كلمة السر وهى 123 ان تكون هذه الارقام على شكل نجوم

 

مش تقول يا دكتور ان انت عاوز كلمة السر مع inputbox

[الحلبي]

باشمهندس @ابو جودي

نعم استاذى  عاوز كلمة السر مع inputbox

الله يفتح عليك يا ابنى

[ابو جودي]

مبدئيا اعمل وحدة نمطية جديدة وسميها مثلا: basInputBoxWithMask
ضع الاكواد الاتية بالوحدة النمطية

Option Compare Database
Option Explicit

'**********************************************************************
' Module:    MaskedInputBox
' Purpose:   This module provides functionality to create an InputBox
'            with masked input, displaying characters as asterisks (*)
'            typically used for password entry.
'
' API Declarations:
'   - CallNextHookEx: Passes the hook information to the next hook procedure in the current hook chain.
'   - GetModuleHandle: Retrieves a module handle for the specified module.
'   - SetWindowsHookEx: Installs a hook procedure into the hook chain.
'   - UnhookWindowsHookEx: Removes a hook procedure installed in a hook chain.
'   - SendDlgItemMessage: Sends a message to a control in a dialog box.
'   - GetClassName: Retrieves the name of the class to which the specified window belongs.
'   - GetCurrentThreadId: Retrieves the thread identifier of the calling thread.
'
' Constants:
'   - EM_SETPASSWORDCHAR: Used to specify the character to be displayed when text is entered in a password field.
'   - WH_CBT: Hook type for monitoring and modifying Computer-Based Training (CBT) events.
'   - HCBT_ACTIVATE: Hook code that is sent when a window is about to be activated.
'   - HC_ACTION: Indicates a valid action has taken place, allowing processing to continue.
'
' Author:    Officena.net, Mohammed Essm, soul-angel@msn.com
' Date:      August 2024
'**********************************************************************

#If VBA7 Or Win64 Then
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) 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
#Else
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal 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

#If VBA7 Or Win64 Then
    Private hHook As LongPtr
#Else
    Private hHook As Long
#End If


'**********************************************************************
' Function:  NewProc
' Purpose:   This function is the hook procedure that processes CBT
'            events, specifically to mask input characters in an InputBox.
' Inputs:
'           - lngCode: The code of the event (Long).
'           - wParam: A handle to the window related to the event (Long).
'           - lParam: Pointer to an event-specific structure (Long).
' Returns:   - LongPtr: The result from the next hook procedure or 0 if handled.
' Notes:
'           - Only processes events with code >= HC_ACTION.
'           - Checks for dialog box activation and sets the password character.
'
' Author:    Officena.net, Mohammed Essm, soul-angel@msn.com
' Date:      August 2024
'**********************************************************************
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
    Dim strClassName As String
    Dim lngBuffer As Long
    Dim result As Long

    ' Proceed only if the message code is an action code
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
    
    ' Get the class name of the window being activated
    strClassName = String$(256, " ")
    lngBuffer = 255
    
    If lngCode = HCBT_ACTIVATE Then
        result = GetClassName(wParam, strClassName, lngBuffer)
        ' Check if the class name is a dialog box ("#32770")
        If Left$(strClassName, result) = "#32770" Then
            ' Set the character for password masking
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
    End If
    
    ' Call the next hook in the chain and return its value
    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
End Function

'**********************************************************************
' Function:  InputBoxDK
' Purpose:   Displays an InputBox with masked input, showing each character
'            as an asterisk (*) instead of the actual character.
' Inputs:
'           - Prompt: The prompt string displayed in the InputBox (String).
'           - Optional Title: The title of the InputBox window (String).
'           - Optional Default: The default string displayed in the InputBox (String).
'           - Optional XPos: The x-coordinate of the InputBox (Long).
'           - Optional YPos: The y-coordinate of the InputBox (Long).
'           - Optional HelpFile: The name of the Help file for the InputBox (String).
'           - Optional Context: The Help context number for the InputBox (Long).
' Returns:  - String: The string entered by the user in the InputBox.
' Notes:
'           - Hooks into the CBT events to mask the input as the user types.
'           - The hook is removed after the InputBox is closed to prevent resource leaks.
'
' Author:    Officena.net, Mohammed Essm, soul-angel@msn.com
' Date:      August 2024
'**********************************************************************
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
    On Error GoTo ExitProperly

    Dim lngModHwnd As LongPtr
    Dim lngThreadID As Long

    ' Get the current thread ID and module handle
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    
    ' Set the hook for CBT (Computer-Based Training) to monitor and modify dialog box creation
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    
    ' Show the InputBox
    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)

ExitProperly:
    ' Ensure the hook is removed to prevent resource leaks
    If hHook <> 0 Then UnhookWindowsHookEx (hHook)
End Function

 

بالنسبة للنموذج دى الاكواد 

وطبعا لا انصح باستخدام اللغة العربية داخل المحرر 
 

Option Compare Database
Option Explicit


Private Sub Command4_Click()
    DoCmd.GoToRecord , , acNewRec
End Sub


'**********************************************************************
' Subroutine: Checkbox_AfterUpdate
' Purpose:    Toggles the InputMask property of a password input field based on the state of a checkbox.
'             When the checkbox is checked, the password is displayed as plain text;
'             when unchecked, the password is masked with the "Password" mask.
' Inputs:
'           - None (uses the current state of the form's controls).
' Outputs:
'           - None (modifies the InputMask property of the "pass" control).
' Notes:
'           - This subroutine assumes that "Checkbox" is a control on the form and is tied to
'             the user's action of toggling the checkbox.
'           - If the checkbox is checked (True), the password will be shown in plain text.
'           - If unchecked (False), the password will be masked.
'
' Author:    Officena.net, Mohammed Essm, soul-angel@msn.com
' Date:      August 2024
'**********************************************************************
Private Sub Checkbox_AfterUpdate()
    ' Check the value of the checkbox and update the InputMask of the "pass" field accordingly
    If Me.Checkbox.Value = True Then
        Me.pass.InputMask = ""          ' Show the password as plain text
    Else
        Me.pass.InputMask = "Password"  ' Mask the password with the "Password" input mask
    End If
End Sub


'**********************************************************************
' Subroutine: jop_AfterUpdate
' Purpose:    Validates the job role entered by the user and enforces role-specific constraints.
'             If the job role is "مستخدم" (User), it checks if the maximum allowed number of
'             users has been reached. If so, it prompts for a password to allow adding more users.
' Inputs:
'           - None (uses the current state of the form's controls).
' Outputs:
'           - None (may prevent form submission based on validation checks).
' Notes:
'           - The subroutine assumes "jop" is a control on the form where the user selects their job role.
'           - If the job role is not "محاسب" (Accountant) or "مستخدم" (User), an error message is shown,
'             and the action is canceled.
'           - If the job role is "مستخدم", the subroutine checks the number of existing users in the database.
'             If there are already 3 users, the subroutine prompts for a password before allowing more users to be added.
'           - The password required to add more users is hardcoded as "123". This should be secured in a production environment.
'
' Author:    Officena.net, Mohammed Essm, soul-angel@msn.com
' Date:      August 2024
'**********************************************************************
Private Sub jop_BeforeUpdate(Cancel As Integer)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim UserCount As Integer
    Dim PasswordInput As String
    
    ' Get the current database
    Set db = CurrentDb()
    
    ' Validate the job role entered by the user
    If Me.jop.Value <> "محاسب" And Me.jop.Value <> "مستخدم" Then
        MsgBox "برجاء إدخال كلمة محاسب أو مستخدم فقط.", vbExclamation, "قيمة غير صحيحة"
        Cancel = True
        Exit Sub
    End If
    
    ' If the job role is "مستخدم", check the number of existing users
    If Me.jop.Value = "مستخدم" Then
        Set rs = db.OpenRecordset("SELECT COUNT(*) AS CountOfUsers FROM tblUsers WHERE jop = 'مستخدم'")
        UserCount = rs!CountOfUsers
        
        ' If the maximum number of users has been reached, prompt for a password
        If UserCount >= 3 Then
            PasswordInput = InputBoxDK("لقد تم إدخال 3 سجلات لمستخدمين. يرجى إدخال كلمة السر لإضافة مستخدم جديد:")
            
            ' Validate the entered password
            If PasswordInput = "" Or PasswordInput <> "123" Then
                MsgBox "كلمة السر غير صحيحة. لا يمكن إضافة مستخدم جديد.", vbExclamation
                Cancel = True
            End If
        End If
        
        rs.Close
        Set rs = Nothing
    End If
    
    ' Clean up
    Set db = Nothing
End Sub

 

[الحلبي]

استاذى الفاضل / @ابو جودي

ايوه كده هو المطلوب اثباته

جزاك الله كل خير وبارك فيك وبارك الله فى علمك وزرقك رزقا واسعا

واعطاك الله الصحة والعافية ورحم الله والديك فى الدنيا وفى الآخرة

كل الاحترام والتقدير لشخصكم الكريم

تم تعديل أغسطس 29 بواسطه الحلبي

[ابوخليل]

السلام عليكم

عند ابي جودي لا تجد بابا مغلقا.. ما شاء الله لا قوة الا بالله

وحقيقة بالنسبة لي اتحسس من كثرة الوحدات النمطية والاكواد في البرنامج 

وحينما تصفحت المرفق جت على بالي فكرة بدائية بسيطة وايضا هي تلغي الصندوق inputbox

وهذه الفكرة كالتالي :

لو وضعنا كلمة مرور المسؤول في حقل اساسي ظاهر

بمعنى : قبل تسجيل مستخدم جديد يكون في الأعلى حقل باسوورد خاص بالمسؤول عن الاضافة يتم ادخاله قبل التسجيل .

اذا هو باسوورد المسؤول الأول .. تتم الاضافة بدون قيد او شرط ( عدا بعض الشروط الأساسية )

اما اذا الباسوورد غيره .. فيتم تطبيق الشروط كاملة

 

 

[الحلبي]

معلمنا وشيخنا القدير / @ابوخليل

اهلا ومرحبا بك معنا وكما تعودنا منك المساعدة والاخلاص فى العمل

والله انت عبقرى فكرة وضع باسورد فى الاعلى فكرة جميلة جدا وفى منتهى الروعة وفعلا انا مثلك اتحسس من كثرة الوحدات النمطية ولكن للضرورة احكام

ولكن كيف يتم ذلك على المثال المرفق مع مراعاة عدم كتابة اى كلمة الا كلمة " مستخدم "  او  " محاسب"  فى حقل jop

وايضا مراعاة السماح باى عدد من المحاسبين وتحديد عدد المستخدمين فقط

اعتقد يمكن تطبيق ذلك وعند كتابة كلمة مستخدم وتحديد عددهم (ثلاثة فقط) مثلا وعند اضافة المستخدم الرابع  يظهر لنا الحقل العلوى ويلزم دخول كلمة السر فى هذا الحقل

كيف يمكن تطبيق هذه الشروط واظهار الحقل العلوى عند دخول مستخدم رابع

ياريت معلمنا واستاذنا ابو خليل يقوم بالتطبيق على المثال المرفق

جزاك الله كل خير معلمنا الفاضل ابو خليل

[ابوخليل]

لا اعلم ما فائدة الاخفاء !

تصوري يكون حقل الرقم السري ظاهر دوما .. ومطلوب من اجل الاضافة .. ايا كانت الاضافة

والرقم السري هذا =كلمة مرور المستخدم

وبكذا نتخلص من الرقم السري الجامد اللي وضعناه في الكود

ايضا مادام المستخدم كاشير ومحاسب فالاولى تشفير كلمة المرور في الجدول ، لأنه في وضعك الحالي يمكن كشف كلمة المرور من الجدول وازالة النجوم

ارى ان النجوم  من اجل ماحد يعرفها وانت تكتبها

..............

على كل حال تم تحقيق طلبك ، والحقل سيظهر في الأسفل

لاحظ اني غيرت في مصدر بيانات النموذج ( جعلته غير منضم ) .. والبيانات الجديدة يتم الحاقها 

 

 

عدد المستخدمين2.rar

[الحلبي]

17 دقائق مضت, ابوخليل said:

على كل حال تم تحقيق طلبك ، والحقل سيظهر في الأسفل

احب ان الفت نظر معلمنا الجليل ان النموذج فى المثال هو نموذج ادخال مستخدمين ويوجد نموذج يظهر عند فتح البرنامج وهو نموذج للدخول على البرنامج به كلمة سر واسم المستخدم

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

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

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

جزاك الله خير على تنفيذ الفكرة وسوف اقوم بالتطبيق على البرنامج والله المستعان

[ابوخليل]

نماذج المستخدمين لاي برنامج :

1- نموذج الدخول (غير منضم)

2- نموذج اضافة مستخدم جديد (غير منضم)

3- نموذج التعديل والحذف(منضم)

ويمكن جمع الثاني والثالث في نموذج واحد .. ولكن الفصل افضل

[الحلبي]

2 ساعات مضت, ابوخليل said:

نماذج المستخدمين لاي برنامج

لبرنامجى انا 

قمت بتطبيق فكرتك والحمد لله كل تمام

جزاك الله كل خير وجعله فى ميزان حسناتك