طريقة تشفير الوصول الى عرض التصميم

[Abdelaziz Osman]

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

ارجوا الافادة عن طريقة تشفير الوصول الى عرض التصميم

لقطع الطريق على المستخدم العادى لافشال قاعدة البيانات بقصد او عن طريق الخطأ

الموضوع بالغ الاهمية

[Abdelaziz Osman]

هل ممكن الاكواد التالية تفيد

Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant)
Dim dbs, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_err:
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
ChangeProperty = False
Resume Change_Bye
End If
End Function

ChangeProperty "AllowBypassKey", DB_BOOLEAN, False
MsgBox "تم الغاء زر الشفت"

 

[عمر ضاحى]

2 ساعات مضت, Abdelaziz Osman said:

هل ممكن الاكواد التالية تفيد

Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant)
Dim dbs, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_err:
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
ChangeProperty = False
Resume Change_Bye
End If
End Function

ChangeProperty "AllowBypassKey", DB_BOOLEAN, False
MsgBox "تم الغاء زر الشفت"

 

هذا لمنع الشفت ويمكن كسره بسهوله

الافضل اولا اخذ نسخه من البرنامج وحفظه فى مكان امن

ثانيا هتقسم البرنامج بقاعدة اماميه وخلفيه

ثالثا القاعدة الاماميه هتحفظها بصيغة accde صيغة تنفيذيه

لكن انتبه لتستبدل الاصليه بالتنفيذيه

لان التنفيذيه لا يمكن الاطلاع او تعديل اكوادها

[Abdelaziz Osman]

معلمنا   @عمر ضاحى   لسيادتكم جزيل الشكر والتقدير على ردكم

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

مثل التى فى الصورة

 

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

واخشى ان اغلق شئ بطريق الخطأ

ماذا افعل ؟؟؟؟

 

 

 

 

[Abdelaziz Osman]

طيب ممكن نشوف ايه الخطأ فى النموذج المرفق

Shift.rar

[عمر ضاحى]

الملف حول بدون مشاكل معي 

[Abdelaziz Osman]

لا مش بتكلم علم ملف Shift ده فى قاعدة بيانات اخرى

shift ملف اختبار

انا متشكر لك جدا جدا على اهتمامك سيدى الفاضل  كتر خيرك بجد على اهتمامك

ان كنت بتكلم على الخطأ فى ملف shift  على الكود اللى على زرار 

[عمر ضاحى]

اها

طيب هراجعه لك

[عمر ضاحى]

الكود هذا من مكتبة استاذى @Moosak

 

Option Compare Database
Option Explicit

Public Function ShowHideRibbon(ShowRibbon As Boolean)

    On Error GoTo ErrHandler
    
'*********************( إخفاء/إظهار الشريط العلوي وجميع النوافذ )**************************
    
If ShowRibbon = False Then
'--------------------------------(إخفاء الريبون والنفجيشن بان)
        DoCmd.ShowToolbar "Ribbon", acToolbarNo
    '    Hide Navigation Pane:
        DoCmd.NavigateTo ("acnavigationcategoryobjecttype")
        DoCmd.RunCommand (acCmdWindowHide)
'--------------------------------(جميع تضبيطات تقفيل القاعدة وإخفاء القوائم ومنع الزر الأيمن والاختصارات)
        Application.SetOption "Show Status Bar", False
        CurrentDb.Properties("ShowDocumentTabs") = False
        Application.SetOption "Auto compact", True
        Application.SetOption "Remove Personal Information", False
        Application.SetOption "Themed Form Controls", False
        Application.SetOption "DesignWithData", False
        CurrentDb.Properties("AllowDatasheetSchema") = False
        Application.SetOption "CheckTruncatedNumFields", False
        CurrentDb.Properties("AllowFullMenus") = False
        CurrentDb.Properties("AllowShortcutMenus") = False
'--------------------------------(Shift منع استخدام زر الشفت)
        On Error GoTo err
        CurrentDb.Properties("allowbypasskey") = False
        Exit Function
    
ElseIf ShowRibbon = True Then
'--------------------------------(إضهار الريبون والنفجيشن بان)
        DoCmd.ShowToolbar "Ribbon", acToolbarYes
        'Unhide the navigation pane
        On Error Resume Next
            Call DoCmd.SelectObject(acTable, , True)
            Call DoCmd.SelectObject(acMacro, , True)
            Call DoCmd.SelectObject(acForm, , True)
        On Error GoTo ErrHandler
'--------------------------------(فتح خصائص قاعدة البيانات وإظهار القوائم وتفعيل الزر الأيمن والاختصارات)
        Application.SetOption "Show Status Bar", True
        CurrentDb.Properties("ShowDocumentTabs") = True
        Application.SetOption "Auto compact", True
        Application.SetOption "Remove Personal Information", True
        Application.SetOption "Themed Form Controls", True
        Application.SetOption "DesignWithData", True
        CurrentDb.Properties("AllowDatasheetSchema") = True
        Application.SetOption "CheckTruncatedNumFields", True
        CurrentDb.Properties("AllowFullMenus") = True
        CurrentDb.Properties("AllowShortcutMenus") = True
'--------------------------------(Shift السماح باستخدام زر الشفت)
        On Error GoTo err2
        CurrentDb.Properties("allowbypasskey") = True
        Exit Function
    End If
'---------------------------------------------------------------------------

ErrHandler:
    If err.Number <> 0 Then
        MsgBox err.Number & vbCrLf & vbCrLf & err.Description, , "Function: ShowHideRibbon"
        Resume Next
    Else
    Exit Function
    End If
err:
    CurrentDb.Properties.Append CurrentDb.CreateProperty("allowbypasskey", 1, False)
    Exit Function
err2:
    CurrentDb.Properties.Append CurrentDb.CreateProperty("allowbypasskey", 1, True)
    Exit Function

End Function

 

طبعا بيتم تشغيل الكود مع الاكسيس بواسطة المايكرو ( Autoexec )

مرفق ملف للتوضيح

Shift.rar