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

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

و قدم الاخ محمد وليد فكرة رائعة للتحايل على ذلك

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

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

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

لتطبيق الكود على أى برنامج لديك اتبع الخطوات التالية :-

1- افتح وحدة نمطية جديدة و ضع بها هذا الكود ( او اعمل استيراد للوحدة النمطية من المرفق )

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const KEY_MASK As Integer = &HFF80 ' decimal -128

 Private Const VK_LSHIFT = &HA0
 Private Const VK_RSHIFT = &HA1
 Private Const BothLeftAndRightKeys = 0
 Private Const LeftKey = 1
 Private Const RightKey = 2
 Private Const LeftKeyOrRightKey = 3
 Dim Withshift As Boolean

Public Function IsShiftKeyDown(Optional LeftOrRightKey As Long = LeftKeyOrRightKey) As Boolean
    Dim Res As Long

    Select Case LeftOrRightKey
        Case LeftKey
            Res = GetKeyState(VK_LSHIFT) And KEY_MASK
        Case RightKey
            Res = GetKeyState(VK_RSHIFT) And KEY_MASK
        Case BothLeftAndRightKeys
            Res = (GetKeyState(VK_LSHIFT) And GetKeyState(VK_RSHIFT) And KEY_MASK)
        Case Else
            Res = GetKeyState(vbKeyShift) And KEY_MASK
    End Select

    IsShiftKeyDown = CBool(Res)
End Function

Public Sub check_shift(frm As String, Optional pwd As String, Optional yourtoolbar As String)

On Error Resume Next
Dim db As Database
Set db = CurrentDb
Dim prp As Property
Withshift = False
Dim passwd As String

 If pwd = "" Then Exit Sub

 Set prp = db.CreateProperty("AllowByPassKey", dbBoolean, False)
 db.Properties.Append prp

With DoCmd
.SelectObject acForm, "", True
.RunCommand acCmdWindowHide
End With

DoCmd.ShowToolbar "yourtoolbar1", acToolbarYes

Dim i As Integer
For i = 1 To CommandBars.Count
If CommandBars(i).Name <> "yourtoolbar1" Then CommandBars(i).Enabled = False
Next i

If IsShiftKeyDown = True Then
    passwd = InputBox("تم استخدام مفتاح الشيفت ، لذا سيتم فتح القاعدة في الخلفية" & vbCrLf & "أدخل كلمة السر  " & vbCrLf, "الدخول الى التصميم ")

  If passwd = pwd Then
     For i = 1 To CommandBars.Count
      CommandBars(i).Enabled = True
     Next i

    DoCmd.SelectObject acForm, , True
    Withshift = True
    DoCmd.Close acForm, frm

 ElseIf passwd = "" Or passwd = Empty Then
    MsgBox "No Input Provided"
    DoCmd.Quit

 Else  'If passwd <> "123456" Then
    MsgBox "Sorry, you do not have access to these information"
    DoCmd.Quit
 End If
End If

End Sub

2- فى حدث عند الفتح لنموذج startup

الكود التالى

Call check_shift(Me.Name, "123")

حيث كلمة السر هى 123

و يمكنك التحكم بها كما تشاء

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

Call check_shift(Me.Name, "123","mytools")

حيث ان اسم شريط الادوات هو mytools

يمكنك ايقاف الكود بحذف كلة السر هكذا

Call check_shift(Me.Name)

او

Call check_shift(Me.Name, "")

و بالمرفق مثال على ذلك

كلمة السر هى 123

ارجو الفائدة للجميع

و لا تنسونا من صالح الدعاء

MrNo_shift_check.rar