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

[haniameen]

السلام عليكم 

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

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

Option Compare Database
Dim db As Database
Dim rs As DAO.Recordset
Dim x As Integer
Dim y As Integer

Function StartUp()
On Error GoTo Err_ProcedureName
Set db = CurrentDb
Set rs = db.OpenRecordset("tblDateFlagged", dbOpenDynaset)
If rs.EOF = False Then
    rs.MoveLast
    If rs.Fields("FlagDate") = True Then
        MsgBox "حدث خطأ فادح اثناء الرصد . ادى الى تلف البرنامج وحذف البيانات.", vbOKOnly, "تنبيــه"
        DoCmd.Quit
    End If
         If Date > rs.Fields("MeDate") Then
     MsgBox "حدث خطأ فادح اثناء الرصد . ادى الى تلف البرنامج وحذف البيانات. ", vbOKOnly, "تنبيــه"
         DoCmd.Quit
    End If
        rs.MoveFirst
    If Date < rs.Fields("MeDate") Then
    MsgBox "حدث خطأ فادح اثناء الرصد . ادى الى تلف البرنامج وحذف البيانات. ", vbOKOnly, "Serious Warning"
         DoCmd.Quit
    End If
   Else
If rs.BOF = True Then
y = 0
Do Until x = 30
x = rs.RecordCount
rs.AddNew
rs.Fields("MeDate") = Date + y
rs.Update
y = y + 1
Loop
End If
End If
UpdateTable
Exit_ProcedureName:
   Exit Function
Err_ProcedureName:
   MsgBox Err.Description, vbOKOnly + vbCritical, "Function Start Up"
   Resume Exit_ProcedureName
End Function
Function UpdateTable()
On Error GoTo Err_ProcedureName
Set db = CurrentDb
Set rs = db.OpenRecordset("tblDateFlagged", dbOpenDynaset)
If rs.BOF = False Then
rs.MoveFirst
Do While rs.Fields("MeDate") <= Date
rs.Edit
rs.Fields("FlagDate") = True
rs.Update
rs.MoveNext
Loop
End If
Exit_ProcedureName:
   Exit Function
Err_ProcedureName:
   MsgBox Err.Description, vbOKOnly + vbCritical, "Function Update Table"
   Resume Exit_ProcedureName
End Function

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

Option Compare Database
Option Explicit

Type adhTypeRect
    x1 As Long
    Y1 As Long
    X2 As Long
    Y2 As Long
End Type

Declare Function adh_apiIsIconic Lib "user32" _
 Alias "IsIconic" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetDeviceCaps Lib "gdi32" _
 Alias "GetDeviceCaps" (ByVal hdc As Long, _
 ByVal nIndex As Long) As Long

Declare Function adh_apiGetWindowRect Lib "user32" _
 Alias "GetWindowRect" (ByVal hWnd As Long, _
 lpRect As adhTypeRect) As Long

Declare Function adh_apiGetParent Lib "user32" _
 Alias "GetParent" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetClientRect Lib "user32" _
 Alias "GetClientRect" (ByVal hWnd As Long, _
 lpRect As adhTypeRect) As Long

Declare Function adh_apiGetWindowLong Lib "user32" _
 Alias "GetWindowLongA" (ByVal hWnd As Long, _
 ByVal nIndex As Long) As Long

Declare Function adh_apiGetSystemMetrics Lib "user32" _
 Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Declare Function adh_apiGetActiveWindow Lib "user32" _
 Alias "GetActiveWindow" () As Long


Type adhTypeDimensions
    sglLeft As Single
    sglTop As Single
    sglWidth As Single
    sglHeight As Single
    strCtlName As String
End Type


Public Const adhcAccessClass = "OMain"
Public Const adhcMDIClientClass = "MDICLIENT"
Public Const adhcAccessDBCClass = "ODb"
Public Const adhcAccessFormClass = "OForm"

Declare Function adh_apiCreateIC Lib "gdi32" _
 Alias "CreateICA" (ByVal lpDriverName As String, _
 ByVal lpDeviceName As String, ByVal lpOutput As String, _
 lpInitData As Any) As Long

Declare Function adh_apiDeleteDC Lib "gdi32" _
 Alias "DeleteDC" (ByVal hdc As Long) As Long

Declare Function adh_apiMoveWindow Lib "user32" _
 Alias "MoveWindow" (ByVal hWnd As Long, _
 ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
 ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Declare Function adh_apiSetWindowLong Lib "user32" _
 Alias "SetWindowLongA" (ByVal hWnd As Long, _
 ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function adh_apiGetWindow Lib "user32" _
 Alias "GetWindow" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Declare Function adh_apiGetClassName Lib "user32" _
 Alias "GetClassNameA" (ByVal hWnd As Long, _
 ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Declare Function adh_apiFindWindow Lib "user32" _
 Alias "FindWindowA" (ByVal lpClassName As String, _
 ByVal lpWindowName As String) As Long

Declare Function adh_apiGetNextWindow Lib "user32" _
 Alias "GetNextWindow" (ByVal hWnd As Long, _
 ByVal wFlag As Long) As Long

Declare Function adh_apiSetFocus Lib "user32" _
 Alias "SetFocus" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetPrivateProfileString Lib "kernel32" _
 Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
 ByVal lpKeyName As String, ByVal lpDefault As String, _
 ByVal lpReturnedString As String, ByVal nSize As Long, _
 ByVal lpFileName As String) As Long

Declare Function adh_apiWritePrivateProfileString Lib "kernel32" _
 Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
 ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

Declare Function adh_apiGetProfileString Lib "kernel32" _
 Alias "GetProfileStringA" (ByVal lpadhcAppName As String, _
 ByVal lpKeyName As String, ByVal lpDefault As String, _
 ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Declare Function adh_apiGetProfileInt Lib "kernel32" _
 Alias "GetProfileIntA" (ByVal lpadhcAppName As String, _
 ByVal lpKeyName As String, ByVal nDefault As Long) As Long

Declare Function WriteProfileString Lib "kernel32" _
 Alias "WriteProfileStringA" (ByVal lpszSection As String, _
 ByVal lpszKeyName As String, ByVal lpszString As String) As Long

Declare Function GetPrivateProfileInt Lib "kernel32" _
 Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, _
 ByVal lpKeyName As String, ByVal nDefault As Long, _
 ByVal lpFileName As String) As Long

Public Const adhcGW_CHILD = 5
Public Const adhcGW_HWNDNEXT = 2
Public Const adhcVERTRES = 10
Public Const adhcHORZRES = 8
Public Const adhcLOGPIXELSX = 88
Public Const adhcLOGPIXELSY = 90
Public Const adhcTwipsPerInch = 1440
Public Const adhcGWL_STYLE = -16
Public Const adhcWS_CAPTION = &HC00000
Public Const adhcSM_CYCAPTION = 4
Public Const adhcSM_CXFULLSCREEN = 16
Public Const adhcSM_CYFULLSCREEN = 17

وجزاكم الله خيرا

[ابو جودي]

شفرة الكود الاولى لمسح الجداول عند اختلاف التواريخ اما الثانية لا اعلم 

ان كنت تملك المرفق الذى احضرت منه الاكواد هل يمكنك مشاركتنا اياه ان تكرمت

وان كنت تبحث عى العموم عن عدم فتح القاعدة بعد وقت محدد فالمنتدى هنا ملئ بذلك لو بحثت لوجدت

[ابو جودي]

 

[ابو جودي]

وان اردت  وتهتم لموضوع الحماية مطلقا يبدو أننا سوف نشاهد على ايد الاستاذ @SEMO.Pa3x ما يخص لهذا الصدد بما لم يتطرق اليه احد من قبل ولم يبهل علينا نسأل الله تعالى له ولكل أساتذتنا الكرام فى هذا الصرح الشامخ والذين ندين لهم دائما وابدا بكل الفضل بعد رب العباد سبحانه بالكثير فاللهم تقبل منهم اعمالهم واجعها لهم يارب بموازين اعمالهم

انظر الى الموضوع