البرنامج المرفق مفتوح المصدر بإمكانكم الاطلاع علي الاكواد البرمجية وطريقة استدعاؤها لعمل رقم سري علي خاصية بدء التشغيل
طريقة عمل البرنامج
تم انشاء وظيفة بإسم
startup
كود
------------------------------------------------------------------------------------
Public Function startup()
ChangeProperty "StartupShowDBWindow", dbBoolean, True ' خاصية اظهار اطار الاكسيس مفتوحة
ChangeProperty "StartupShowStatusBar", DB_Boolean, False ' شريط الحالة مغلق
ChangeProperty "AllowBuiltinToolbars", DB_Boolean, False ' اشرطة الادوات المضمنة مغلقه
ChangeProperty "AllowFullMenus", DB_Boolean, False ' اشرطة الادوات الكاملة مغلقة
ChangeProperty "AllowSpecialKeys", DB_Boolean, True ' السماح لمفاتيح الوصول الخاصة مفتوح
ChangeProperty "AllowToolbarChanges", DB_Boolean, False ' السماح بتغيير اشرطة الادوات مغلق
ChangeProperty "AllowBypassKey", DB_Boolean, True ' السماح بإستخدام مفتاح الشفت مفتوح
TimerId = SetTimer(0, 0, 1, AddressOf TimerProc)
str_Title = "كلمة المرور مطلوبة"
str_Prompt = "ادخل كلمة المرور"
If InputBox(str_Prompt, str_Title) = "1" Then
MsgBox "كلمة المرور صحية", , "تفضل بالدخول"
DoCmd.RunCommand acCmdStartupProperties
Else
MsgBox "كلمة المرور غير صحيحة", , "الرجاء التأكد من كلمة المرور"
End If
End Function
هذه الوظيفة يتم استدعاؤها عن طريق ماكرو بإسم startup حيث تقوم هذه الوظيفة بعمل اللازم عند فتح بدء التشغيل فتقوم بإزالة كل علامات الصح من امام الخيارات وفي كل مره تحاول فتح القاعدة تكون هذه الخيارات ملغاة ولا تستطيع الدخول عليها ثم يتم تنفيذ كود الرقم السري بعدها مباشرة فإن كان صحيحا تم فتح خيارات بدء التشغيل والا لن يسمح بفتحه .
يتم التحكم في خصائص بدء التشغيل من خلال استدعاء الوظيفة ChangeProperty(strPropName
كود
-------------------------------------------------------------------------------------
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim dbs As Database, 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
نظرا لان برنامج الاكسيس لا يمكنه استدعاء او تشغيل اوامر صريحه مثل الدوال مباشرة ولكن يتم تشغيلها عن طريق ماكرو وهو الذي يتم وضعه مع اجراء بدء التشغيل ليتم فتح الوظيفة السابقة
startup
ولغرض جعل الحروف والارقام تظهر علي شكل نجوم في مربع الرقم السري تم استخدام الدوظيفة
TimerProc
كود
-------------------------------------------------------------------------------------
Declare Function SetTimer Lib "user32" (ByVal hWnd _
As Long, ByVal nIDEvent As Long, ByVal uElapse _
As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" _
(ByVal hWnd As Long, ByVal nIDEvent As Long) _
As Long
Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" (ByVal hWndParent As _
Long, ByVal hWndChildAfter As Long, ByVal _
lpClassName As String, ByVal lpWindowName _
As String) As Long
Declare Function Sendmessagebynum _
Lib "user32" Alias "SendMessageA" (ByVal _
hWnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, ByVal lParam As Long) _
As Long
Const EM_SETPASSWORDCHAR = &HCC
Public str_Title$, TimerId&
كود
------------------------------------------------------------------------------------
Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
KillTimer 0, TimerId
Dim lng_Hwnd&
lng_Hwnd = FindWindowEx(0, 0, "#32770", _
Trim(str_Title))
lng_Hwnd = FindWindowEx(lng_Hwnd, 0, _
"Edit", vbNullString)
If lng_Hwnd Then
Sendmessagebynum lng_Hwnd, EM_SETPASSWORDCHAR, 42, 0
End If
End Sub
اخيرا نقوم بإنشاء شريط ادوات خاص ونضع به ما نريد من اوامر مثل اغلاق القاعدة وفتح نموذج معين او تقرير اماخيارات بدء التشغيل فكما ذكرنا يوضع رقم سري حسب الطريقة
اذا نستنج من هذا انه يمكن استدعاء وظيفه رئيسية من داخل وظيفة فرعية وتستدعى جميعها بواسطة ماكرو معد لهذا الغرض
