كود لتعطيل مفاتيح shift , alt , ctrl

**علي المصري** · أغسطس 20, 2012

الكود التالي وجدته في احد المواقع

وهو اتعطيل عمل shift , alt , ctrl

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

إليكم الكود


Option Explicit

Option Compare Text

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' modKeyState

' By Chip Pearson, www.cpearson.com, chip@cpearson.com

' This code is at www.cpearson.com/Excel/KeyTest.aspx

' This module contains functions for testing the state of the SHIFT, ALT, and CTRL

' keys.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


''''''''''''''''''''''''''''''''''''''''''''''''''''

' Declaration of GetKeyState API function. This

' tests the state of a specified key.

''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function GetKeyState Lib "user32" ( _

ByVal nVirtKey As Long) As Integer


''''''''''''''''''''''''''''''''''''''''''

' This constant is used in a bit-wise AND

' operation with the result of GetKeyState

' to determine if the specified key is

' down.

''''''''''''''''''''''''''''''''''''''''''

Private Const KEY_MASK As Integer = &HFF80 ' decimal -128

'''''''''''''''''''''''''''''''''''''''''

' KEY CONSTANTS. Values taken

' from VC++ 6.0 WinUser.h file.

'''''''''''''''''''''''''''''''''''''''''

Private Const VK_LSHIFT = &HA0

Private Const VK_RSHIFT = &HA1

Private Const VK_LCONTROL = &HA2

Private Const VK_RCONTROL = &HA3

Private Const VK_LMENU = &HA4

Private Const VK_RMENU = &HA5

'''''''''''''''''''''''''''''''''''''''''

' The following four constants simply

' provide other names, CTRL and ALT,

' for CONTROL and MENU. "CTRL" and

' "ALT" are more familiar than

' "CONTROL" and "MENU". These constants

' provide no additional functionality.

' They simply provide more familiar

' names.

'''''''''''''''''''''''''''''''''''''''''

Private Const VK_LALT = VK_LMENU

Private Const VK_RALT = VK_RMENU

Private Const VK_LCTRL = VK_LCONTROL

Private Const VK_RCTRL = VK_RCONTROL

''''''''''''''''''''''''''''''''''''''''''''

' The following constants are used to specify,

' when testing CTRL, ALT, or SHIFT, whether

' the Left key, the Right key, either the

' Left OR Right key, or BOTH the Left AND

' Right keys are down.

'

' By default, the key-test procedures make

' no distinction between the Left and Right

' keys and will return TRUE if either the

' Left or Right (or both) key is down.

''''''''''''''''''''''''''''''''''''''''''''

Public Const BothLeftAndRightKeys = 0

Public Const LeftKey = 1

Public Const RightKey = 2

Public Const LeftKeyOrRightKey = 3	


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

''''''''''''''''''''''''''''''''''''''''''''''''

' IsShiftKeyDown

' Returns TRUE or FALSE indicating whether the

' SHIFT key is down.

'

' If LeftOrRightKey is omitted or LeftKeyOrRightKey,

' the function return TRUE if either the left or the

' right SHIFT key is down. If LeftKeyOrRightKey is

' LeftKey, then only the Left SHIFT key is tested.

' If LeftKeyOrRightKey is RightKey, only the Right

' SHIFT key is tested. If LeftOrRightKey is

' BothLeftAndRightKeys, the codes tests whether

' both the Left and Right keys are down. The default

' is to test for either Left or Right, making no

' distiction between Left and Right.

''''''''''''''''''''''''''''''''''''''''''''''''

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 Function IsControlKeyDown(Optional LeftOrRightKey As Long = LeftKeyOrRightKey) As Boolean

''''''''''''''''''''''''''''''''''''''''''''''''

' IsControlKeyDown

' Returns TRUE or FALSE indicating whether the

' CTRL key is down.

'

' If LeftOrRightKey is omitted or LeftKeyOrRightKey,

' the function return TRUE if either the left or the

' right CTRL key is down. If LeftKeyOrRightKey is

' LeftKey, then only the Left CTRL key is tested.

' If LeftKeyOrRightKey is RightKey, only the Right

' CTRL key is tested. If LeftOrRightKey is

' BothLeftAndRightKeys, the codes tests whether

' both the Left and Right keys are down. The default

' is to test for either Left or Right, making no

' distiction between Left and Right.

''''''''''''''''''''''''''''''''''''''''''''''''

Dim Res As Long


Select Case LeftOrRightKey

	 Case LeftKey

		 Res = GetKeyState(VK_LCTRL) And KEY_MASK

	 Case RightKey

		 Res = GetKeyState(VK_RCTRL) And KEY_MASK

	 Case BothLeftAndRightKeys

		 Res = (GetKeyState(VK_LCTRL) And GetKeyState(VK_RCTRL) And KEY_MASK)

	 Case Else

		 Res = GetKeyState(vbKeyControl) And KEY_MASK

End Select


IsControlKeyDown = CBool(Res)

End Function

Public Function IsAltKeyDown(Optional LeftOrRightKey As Long = LeftKeyOrRightKey) As Boolean

''''''''''''''''''''''''''''''''''''''''''''''''

' IsAltKeyDown

' Returns TRUE or FALSE indicating whether the

' ALT key is down.

'

' If LeftOrRightKey is omitted or LeftKeyOrRightKey,

' the function return TRUE if either the left or the

' right ALT key is down. If LeftKeyOrRightKey is

' LeftKey, then only the Left ALT key is tested.

' If LeftKeyOrRightKey is RightKey, only the Right

' ALT key is tested. If LeftOrRightKey is

' BothLeftAndRightKeys, the codes tests whether

' both the Left and Right keys are down. The default

' is to test for either Left or Right, making no

' distiction between Left and Right.

''''''''''''''''''''''''''''''''''''''''''''''''

Dim Res As Long


Select Case LeftOrRightKey

	 Case LeftKey

		 Res = GetKeyState(VK_LALT) And KEY_MASK

	 Case RightKey

		 Res = GetKeyState(VK_RALT) And KEY_MASK

	 Case BothLeftAndRightKeys

		 Res = (GetKeyState(VK_LALT) And GetKeyState(VK_RALT) And KEY_MASK)

	 Case Else

		 Res = GetKeyState(vbKeyMenu) And KEY_MASK

End Select


IsAltKeyDown = CBool(Res)

End Function

The following are test procedures to illustrate the code. Run the procedure named Test and then press the keys that you want to test. Test calls ProcTest via OnTime to allow you to press the appropriate keys. The results are displayed in the Debug window of the VBA Editor.

Sub Test()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Test

' This is a procedure to test and demonstrate the Key-State

' functions above. Since you can't run a macro in the VBA

' Editor if the SHIFT, ALT, or CTRL key is down, this procedure

' uses OnTime to execute the ProcTest test procedure. OnTime

' will call ProcTest two seconds after running this Test

' procedure. Immediately after executing Test, press the

' key(s) (Left/Right SHIFT, ALT, or CTRL) you want to test

' for. The procedure called by OnTime, ProcTest, displays the

' status of the Left/Right SHIFT, ALT, and CTRL keys.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Application.OnTime Now + TimeSerial(0, 0, 2), "ProcTest", , True

End Sub


Sub ProcTest()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' ProcTest

' This procedure simply displays the status of the Left adn Right

' SHIFT, ALT, and CTRL keys.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Debug.Print "SHIFT KEY: ", "LEFT: " & CStr(IsShiftKeyDown(LeftKey)), _

						 "RIGHT: " & CStr(IsShiftKeyDown(RightKey)), _

			 "EITHER: " & CStr(IsShiftKeyDown(LeftKeyOrRightKey)), _

						 "BOTH: " & CStr(IsShiftKeyDown(BothLeftAndRightKeys))


Debug.Print "ALT KEY: ", "LEFT: " & CStr(IsAltKeyDown(LeftKey)), _

						 "RIGHT: " & CStr(IsAltKeyDown(RightKey)), _

						 "EITHER: " & CStr(IsAltKeyDown(LeftKeyOrRightKey)), _

						 "BOTH: " & CStr(IsAltKeyDown(BothLeftAndRightKeys))


Debug.Print "CTRL KEY: ", "LEFT: " & CStr(IsControlKeyDown(LeftKey)), _

						 "RIGHT: " & CStr(IsControlKeyDown(RightKey)), _

						 "EITHER: " & CStr(IsControlKeyDown(LeftKeyOrRightKey)), _

						 "BOTH: " & CStr(IsControlKeyDown(BothLeftAndRightKeys))

End Sub

تم تعديل أغسطس 20, 2012 بواسطه علي المصري

**Bluemind** · أغسطس 20, 2012

هذه داله تقوم بتعطيل مفتاح Shift من العمل لكي لا يستطيع المستخدم من الدخول الى قاعده البيانات و جداولها وكل اجزئها المتبقيه لدوافع الامنيه.

سوف اقوم بشرحها كالتالي:

اولأ:

اذهب الى الوحدات النمطيه وقم بانشاء جديد.

ثم من ادوات اذهب الى References ثم ابحث عن Microsoft DAO 3.6 وضع عليه علامه صح

ثم انسخ الكود التالي وضعه في هذه الوحده النمطية:

كود


Option Compare Database

Option Explicit

Public Function SetProperties(strPropName As String, _

varPropType As Variant, varPropValue As Variant) As Integer

On Error GoTo Err_SetProperties

Dim db As DAO.Database, prp As DAO.Property

Set db = CurrentDb

db.Properties(strPropName) = varPropValue

SetProperties = True

Set db = Nothing

Exit_SetProperties:

Exit Function

Err_SetProperties:

If Err = 3270 Then 'Property not found

	 Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)

	 db.Properties.Append prp

	 Resume Next

Else

	 SetProperties = False

	 MsgBox "SetProperties", Err.Number, Err.Description

	 Resume Exit_SetProperties

End If

End Function

بعد ذالك قم بنشاء زر في الواجه الرئيسيه لبرنامجك او قاعده بياناتك و اختر احد الملصقات او الكائنات الموجوده في هذا النموذج واذهب الى حدث عن النقر او النقر المزدوج و اكتب الكود التالي كود


Dim strInput As String

Dim strMsg As String

Beep

strMsg = "هل تريد اعاده تشغيل مفتاح Shift" & vbCrLf & vbLf & _

			 "الرجاء كتابه كلمه المرور لتشغيل مفتاح Shift."

strInput = InputBox(Prompt:=strMsg, Title:="تعطيل مفتاح Shift")

If strInput = "اكتب هنا كلمه المرور" Then

	 SetProperties "AllowBypassKey", dbBoolean, True

	 Beep

	 MsgBox "لقد تم تشغيل مفتاح Shift" & vbCrLf & vbLf & "مفتاح التشغيل سوف يسمح للمستخدم للدخول الى كائنات قاعدة البيانات" & "في المره القادمه عند الدخول الى قاعده البيانات", _

			 vbInformation, "Set Startup Properties"

Else

	 Beep

	 SetProperties "AllowBypassKey", dbBoolean, False

	 MsgBox "كلمه مرور خاطئة" & vbCrLf & vbLf & _

			 "مفتاح Shift تم تعطيله." & vbCrLf & vbLf & _

			 "مفتاح Shift لن يمكن المستخدم من الدخول الى قاعده البيانات في المره المقبلة", _

			 vbCritical, "كلمه مرور غير صحيحة!!"

	 Exit Sub

End If

*طبعا هذا الزر عند الضغط عليه مره واحده سوف يسالك عن كلمه مرور لتفعيل مفتاح Shift

وعند قبول كلمه السر و الخروج من البرنامج و فتح البرنامج مره اخرى مع الضغط على مفتاح Shift سوف يعمل.

ملاحظة:

*الكود الثاني هو لتجنب اقفال قاعده البيانات وعدم المقدره للدخول عليها مره اخرى عن طريق مفتاح Shift.

**علي المصري** · أغسطس 22, 2012

شكرا لك اخب وعلى الشرح

بارك الله فيك

HERO92 · يناير 25, 2014

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

الاساتذة الافاضل

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

وتقبل خالص تحياتى

HERO92 · يناير 25, 2014

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

الاساتذة الافاضل

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

وتقبل خالص تحياتى

وضاح النوبه · يناير 27, 2017

ممكن شرح طريقه تعطيل مفتاح بالاكس alt-F4

تم تعديل يناير 27, 2017 بواسطه وضاح النوبه

تسجيل الدخول

كود لتعطيل مفاتيح shift , alt , ctrl

الردود الموصى بها

علي المصري

رابط هذا التعليق

شارك

Bluemind

رابط هذا التعليق

شارك

علي المصري

رابط هذا التعليق

شارك

HERO92

رابط هذا التعليق

شارك

HERO92

رابط هذا التعليق

شارك

وضاح النوبه

رابط هذا التعليق

شارك

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information