يوجد خطأ عند الضغط على ايقونة لكتابة كلمة المرور يتم الخروج البرنامج نهائيا

[بلال بلال]

السلام عليكم

يوجد في نموذج ايقونة عند الضغط عليها لكتابة كلمة المرور يخرج البرنامج نهائيا

حتى يتم فتحه

اليك البرنامج

البرنامج.accdb

[Foksh]

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

السلام عليكم

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

لم يظهر أي مشكلة عند فتح المرفق وتعديل الأكواد لتعمل مع إصداري 64 ..

ولكن في الإصدار 32 ، ظهرت المشكلة والسبب المعامل الثالث الذي يمرر في استدعاء الـ InpuBoxDK ، عدله ليصبح كالتالي :-

    str_Title = "سبحان الله وبحمده سبحان الله العظيم"
    strAdminPWord = InputBoxDK("Password required to proceed.", str_Title)

بدلاً من :-

    str_Title = "سبحان الله وبحمده سبحان الله العظيم"
    strAdminPWord = InputBoxDK("Password required to proceed.", str_Title, "Enter Licence Code")

 

[بلال بلال]

السلام عليكم 

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

[ابو جودي]

في 10‏/4‏/2026 at 18:16, بلال بلال said:

السلام عليكم

يوجد في نموذج ايقونة عند الضغط عليها لكتابة كلمة المرور يخرج البرنامج نهائيا

حتى يتم فتحه

اليك البرنامج

خلينا نرد 

الرقم &H1324 مش ثابت بيشتغل في أغلب الحالات لكن ممكن يفشل حسب إصدار الاوفيس او الويندوز 
دا غير ان لو حصل Error قبل : UnhookWindowsHookEx hHook الهـوك هيفضل شغال

فى زر الامر تم استخدام : Cancel = True
Cancel بيستخدم فقط في Events فيها  معامل : Cancel مثلا زى : Form_BeforeUpdate(Cancel As Integer)
يعنى من الاخر السطر ده : Cancel = True مالوش أي تأثير والمفروض ينحذف 

كمان استخدام : DoCmd.SetWarnings False مالوش أى لزوم هنا لانه بيستخدم مع الاستعلامات لمنع الرسائل الافتراضية فقط

والرد الشافى فى النقطة دى 

في 10‏/4‏/2026 at 20:16, Foksh said:

ولكن في الإصدار 32 ، ظهرت المشكلة والسبب المعامل الثالث الذي يمرر في استدعاء الـ InpuBoxDK ، عدله ليصبح كالتالي :-

    str_Title = "سبحان الله وبحمده سبحان الله العظيم"
    strAdminPWord = InputBoxDK("Password required to proceed.", str_Title)

بدلاً من :-

    str_Title = "سبحان الله وبحمده سبحان الله العظيم"
    strAdminPWord = InputBoxDK("Password required to proceed.", str_Title, "Enter Licence Code")

 

المعامل الثالث (Default) هو النص الافتراضي داخل مربع الإدخال
فيه احتمالين للمشكلة مع 32 بت
الاول : 
الهوك بيشتغل لحظة إنشاء النافذة وجود نص افتراضي (Default) يخلي الكنترول يتعمل له تهيئة بطريقة مختلفة

النتيجة: الـ Password masking (*) ما يتطبقش أو يحصل خلل

الثانى :
اختلاف داخلي في الـ : InputBox (32 بت مقابل 64 بت)
الـ Edit control ID (&H1324) بيتأثر بوجود Default Text مع النواة 32 او مع احد الاصدارات والنتيجة : EM_SETPASSWORDCHAR ممكن تروح لعنصر غلط أو تفشل
طيب السؤال الان هل الحل ده صح و جذرى:

InputBoxDK("Password required to proceed.", str_Title)

من حيث الصحة : جزئيا صح ولكن مش جذرى ومش احترافى ومش الأصح
طيب إيه الحل الصح : 

strAdminPWord = InputBoxDK("Password required to proceed.", str_Title, "")

وبعد ان قمنا بالتفنيد والرد المناسب  واللى ماله علاقة اساسا بالمشكلة مناط السؤال

 

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

أكود لعناصر شبحية تم حذفها ولكن مازالت عالقة بالقاعدة 

 

 

[ابو جودي]

الكود الافضل فى الوحدة النمطية تتم كتابته بالشكل التالى 

Option Compare Database
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
        (ByVal hHook As LongPtr, ByVal nCode As Long, _
         ByVal wParam As LongPtr, ByVal lParam As LongPtr) 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 GetClassName Lib "user32" Alias "GetClassNameA" _
        (ByVal hWnd As LongPtr, ByVal lpClassName As String, _
         ByVal nMaxCount As Long) As Long

    Private Declare PtrSafe Function EnumChildWindows Lib "user32" _
        (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _
         ByVal lParam As LongPtr) As Long

    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As LongPtr, ByVal wMsg As Long, _
         ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

    Private m_hHook As LongPtr
#Else
    Private Declare Function CallNextHookEx Lib "user32" _
        (ByVal hHook As Long, ByVal nCode As Long, _
         ByVal wParam As Long, ByVal lParam As Long) 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 GetClassName Lib "user32" Alias "GetClassNameA" _
        (ByVal hWnd As Long, ByVal lpClassName As String, _
         ByVal nMaxCount As Long) As Long

    Private Declare Function EnumChildWindows Lib "user32" _
        (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
         ByVal lParam As Long) As Long

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, ByVal lParam As Long) As Long

    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

    Private m_hHook As Long
#End If

Private Const WH_CBT              As Long = 5
Private Const HCBT_ACTIVATE       As Long = 5
Private Const HC_ACTION           As Long = 0
Private Const EM_SETPASSWORDCHAR  As Long = &HCC
Private Const EM_GETPASSWORDCHAR  As Long = &HD2
Private Const PASSWORD_CHAR       As Long = 42
Private Const DIALOG_CLASS        As String = "#32770"
Private Const EDIT_CLASS          As String = "Edit"

#If VBA7 Then
Public Function EnumChildProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long
    Dim sClass As String
    Dim nChars As Long
    Dim verifyChar As LongPtr
#Else
Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    Dim sClass As String
    Dim nChars As Long
    Dim verifyChar As Long
#End If

    sClass = String$(256, vbNullChar)
    nChars = GetClassName(hWnd, sClass, 255)

    If nChars <= 0 Then
        EnumChildProc = 1
        Exit Function
    End If

    If Left$(sClass, nChars) <> EDIT_CLASS Then
        EnumChildProc = 1
        Exit Function
    End If

    SendMessage hWnd, EM_SETPASSWORDCHAR, PASSWORD_CHAR, 0
    
    verifyChar = SendMessage(hWnd, EM_GETPASSWORDCHAR, 0, 0)

    If verifyChar = PASSWORD_CHAR Then
        EnumChildProc = 0
    Else
        EnumChildProc = 1
    End If

End Function

#If VBA7 Then
Public Function HookCallback(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
Public Function HookCallback(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Dim sClassName As String
    Dim nChars As Long

    If nCode < HC_ACTION Then
        HookCallback = CallNextHookEx(m_hHook, nCode, wParam, lParam)
        Exit Function
    End If

    If nCode = HCBT_ACTIVATE Then
        sClassName = String$(256, vbNullChar)
        nChars = GetClassName(wParam, sClassName, 255)

        If nChars > 0 Then
            If Left$(sClassName, nChars) = DIALOG_CLASS Then
                EnumChildWindows wParam, AddressOf EnumChildProc, 0
            End If
        End If
    End If

    HookCallback = CallNextHookEx(m_hHook, nCode, wParam, lParam)

End Function

Public Function SecureInputBox( _
    ByVal Prompt As String, _
    Optional ByVal Title As String = "", _
    Optional ByRef WasCancelled As Boolean = False, _
    Optional ByVal XPos As Long = -1, _
    Optional ByVal YPos As Long = -1) As String

    Dim sResult As String
    Dim threadID As Long

#If VBA7 Then
    Dim hMod As LongPtr
#Else
    Dim hMod As Long
#End If

    If Len(Trim$(Prompt)) = 0 Then
        err.Raise vbObjectError + 1001, "SecureInputBox", "Prompt cannot be empty."
    End If

    On Error GoTo SafeExit

    threadID = GetCurrentThreadId()
    hMod = GetModuleHandle(vbNullString)

    m_hHook = SetWindowsHookEx(WH_CBT, AddressOf HookCallback, hMod, threadID)

    If m_hHook = 0 Then
        err.Raise vbObjectError + 1002, "SecureInputBox", "Failed to install Windows hook."
    End If

    If XPos >= 0 And YPos >= 0 Then
        sResult = InputBox(Prompt, Title, "", XPos, YPos)
    Else
        sResult = InputBox(Prompt, Title, "")
    End If

    WasCancelled = (StrPtr(sResult) = 0)
    SecureInputBox = sResult

SafeExit:
    If m_hHook <> 0 Then
        UnhookWindowsHookEx m_hHook
        m_hHook = 0
    End If

    If err.Number <> 0 Then
        Dim errNum As Long, errDesc As String
        errNum = err.Number
        errDesc = err.Description
        err.Clear
        err.Raise errNum, "SecureInputBox", errDesc
    End If

End Function

Public Sub ZeroString(ByRef sValue As String)
    If Len(sValue) > 0 Then
        sValue = String$(Len(sValue), vbNullChar)
    End If
End Sub

فى زر الامر يتم الاستدعاء بالشكل التالى 

Dim strPWord As String
Dim strTitle As String
Dim isCancel As Boolean

strTitle = "سبحان الله وبحمده سبحان الله العظيم"
strPrompt = "كلمة المرور مطلوبة للمتابعة."

strPWord = SecureInputBox(strPrompt, strTitle, isCancel)

If isCancel Then Exit Sub
If strPWord = "1001" Then
    DoCmd.OpenForm "frmPassStars", acNormal
Else
    MsgBox "الرقم السري الذي أدخلته غير صحيح - من فضلك أدخل الرمز الصحيح", vbExclamation, str_Title
End If

ZeroString strPWord

 

[ابو جودي]

في 10‏/4‏/2026 at 21:09, بلال بلال said:

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

بالنسبة للرد على هذا السؤال 

نعم يوجد حل أخر وهو موجود بالتفصيل فى هذا الموضوع 

 

[kkhalifa1960]

مشاركة مع اساتذتي تفضل استاذ @بلال بلال مرفقك بعد التعديل . ووافني بالرد .

البرنامج.rar

[ابو جودي]

2 دقائق مضت, kkhalifa1960 said:

مشاركة مع اساتذتي

انتم اللى اساتذة عظماء وانا مجرد طويلب علم

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

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

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

وبعد ذلك قدمت كل الحلول التى اعرفها 

تحياتى لكم استاذ