بخصوص التعديل لفتح النموذج بكلمة المرور

[بلال اليامين]

السلام عليكم

عندما لم نقوم بادخال كلمة المرور  لفتح النموذج يتم الخروج من البرنامج

اريد التعديل عندما لم نقوم بادخال كلمة المرور لفتح النموذج لم يتم الخروج من البرنامج

 

test (1).rar

[ahmed draz]

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

مرحباً بك أخي بلال

تفضل التعديل بإغلاق النموذج فقط

كلمة المرور: 123

 

test (2).rar

[ابو جودي]

هذه طريقتى المفضلة   

 

رقم سري.accdb

[ابو جودي]

شوف يا سيدى افتح التقرير مباشرة

وافتح النموذج :frmSecretData مباشرة 

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

وبعد ذلك قم بفتح النموذج والتقرير من النموذج الرئيسى وفق لكلمة المرور والموضحة على كل زر امر فى النموذج الرئيس

 

 

[ابو جودي]

طيب للعلم وللدارسين والباحثين مستقبلا 
الحل الذى تم التأشير عليه كأفضل إجابة عاجز وغير مجدى مع النواة 64 نظراً لقصور أو إهمال أو عجز المطور عن إعادة هيكلة الكود لتعديله ليتوافق مع كل الأنوية والذى يقع فريستها العاجزين 

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

[ابو جودي]

الاجابة الاصح والافضل 

اولا : كود الوحدة النمطية العامة تم اعادة هيكلة الكود وتعديله للتعامل مع النواتان بالطريقة الصحيحة على 

Option Compare Database
Option Explicit

#If VBA7 Or Win64 Then
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As LongPtr, ByVal wParam As LongPtr, 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 LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
    Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
#Else
    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 LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr,  ByVal dwThreadId As LongPtr) As LongPtr
    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

Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim RetVal
    Dim strClassName    As String
    Dim lngBuffer       As LongPtr
 
    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
On Error GoTo ExitProperly
    
    Dim lngModHwnd As LongPtr
    Dim lngThreadID As LongPtr
     
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
 
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
 
    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    UnhookWindowsHookEx hHook
    
ExitProperly:
    UnhookWindowsHookEx hHook
End Function

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

 

Private Sub Form_Open(Cancel As Integer)
    ' Exit if this is a new record

    
    Dim MyPass As String
    Dim TargetFormName As String
    
    ' Replace "TargetFormName" with the actual form name you want to open
    If Len(TargetFormName & "") = 0 Then TargetFormName = Me.Name
    
    ' Prompt user for the password
    MyPass = InputBoxDK("To open this form, you need to know the correct password to proceed with the opening process", "Confirm Opening a Secured Form")
    
    ' Check if the entered password is correct
    If MyPass = "123" Then
        If Len(TargetFormName & "") = 0 Then TargetFormName = Me.Name
        DoCmd.OpenForm TargetFormName
    ElseIf Len(MyPass & "") = 0 Then
        MsgBox "Form opening process canceled", vbInformation ' Display a message if the operation is canceled
        Cancel = True ' Cancel the form opening
    Else
        MsgBox "Incorrect password", vbExclamation ' Display a message if the password is incorrect
        Cancel = True ' Cancel the form opening
    End If
End Sub

 

 

واخيـرا:  المرفق الصحيح ليكون مرجعا للدارسين وطلاب العلم 

 

test (3).accdb

[Foksh]

4 ساعات مضت, ابو جودي said:

الاجابة الاصح والافضل 

اولا : كود الوحدة النمطية العامة تم اعادة هيكلة الكود وتعديله للتعامل مع النواتان بالطريقة الصحيحة على 

Option Compare Database
Option Explicit

#If VBA7 Or Win64 Then
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As LongPtr, ByVal wParam As LongPtr, 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 LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
    Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
#Else
    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 LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr,  ByVal dwThreadId As LongPtr) As LongPtr
    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

Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim RetVal
    Dim strClassName    As String
    Dim lngBuffer       As LongPtr
 
    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
On Error GoTo ExitProperly
    
    Dim lngModHwnd As LongPtr
    Dim lngThreadID As LongPtr
     
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
 
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
 
    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    UnhookWindowsHookEx hHook
    
ExitProperly:
    UnhookWindowsHookEx hHook
End Function

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

 

Private Sub Form_Open(Cancel As Integer)
    ' Exit if this is a new record

    
    Dim MyPass As String
    Dim TargetFormName As String
    
    ' Replace "TargetFormName" with the actual form name you want to open
    If Len(TargetFormName & "") = 0 Then TargetFormName = Me.Name
    
    ' Prompt user for the password
    MyPass = InputBoxDK("To open this form, you need to know the correct password to proceed with the opening process", "Confirm Opening a Secured Form")
    
    ' Check if the entered password is correct
    If MyPass = "123" Then
        If Len(TargetFormName & "") = 0 Then TargetFormName = Me.Name
        DoCmd.OpenForm TargetFormName
    ElseIf Len(MyPass & "") = 0 Then
        MsgBox "Form opening process canceled", vbInformation ' Display a message if the operation is canceled
        Cancel = True ' Cancel the form opening
    Else
        MsgBox "Incorrect password", vbExclamation ' Display a message if the password is incorrect
        Cancel = True ' Cancel the form opening
    End If
End Sub

 

 

واخيـرا:  المرفق الصحيح ليكون مرجعا للدارسين وطلاب العلم 

 

test (3).accdb 496 kB · 6 downloads

جميل جداً ،،