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

[ابو جودي]

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

طبعا لن اضع افكارى صريحة لتطبيق فكرة محددة 

لا أنوى أن اعطيكم سمكا بل انوى أن أعلمكم الصيد ...

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

1- الحماية عن طريق اضافة بيانات الحماية فى الريجسترى 

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

Public Const MyRegPath As String = "HKEY_CURRENT_USER\Software\Officena.net"
Public Const MyRegKey As String = "Judy"
Public Const myStringValue  As String = "محمد"
Public Const myValueData  As String = "ابو جودى"

'returns True if the registry key i_RegKey was found
'and False if not
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

  On Error GoTo ErrorHandler
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'try to read the registry key
  myWS.RegRead i_RegKey
  'key was found
  RegKeyExists = True
  Exit Function

ErrorHandler:
  'key was not found
  RegKeyExists = False
End Function

Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

  On Error Resume Next
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'read key from registry
  RegKeyRead = myWS.RegRead(i_RegKey)
End Function

Function RegKeySave(i_RegKey As String, _
               i_Value As String, _
      Optional i_Type As String = "REG_SZ")
Dim myWS As Object

  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'write registry key
  myWS.RegWrite i_RegKey, i_Value, i_Type
End Function

Function RegKeyDelete(i_RegKey As String) As Boolean
Dim myWS As Object

  On Error GoTo ErrorHandler
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'delete registry key
  myWS.RegDelete i_RegKey
  'deletion was successful
  RegKeyDelete = True
  Exit Function

ErrorHandler:
  'deletion wasn't successful
  RegKeyDelete = False
End Function

يتبع..

 

القاعدة المرفقة

 

01-Dealing with the registry.accdb

[ابو جودي]

2-تشفير البيانات 

نستخدم الأكواد الاتية فى وحدة نمطيه

Function incode(A As String, b As String) As String
 Dim r, i As Integer, s, u As String
1:
    u = ""
    s = ctrs(A, 3)
    If Len(s) Mod 2 = 1 Then s = s + Trim(Str(Int(8 * Rnd(-Timer))))
    i = 3 * Rnd(-Timer) + 1
    For r = 1 To i
        u = Chr(100 * Rnd(-Timer) + 155) + u
    Next
    u = Trim(Str(i)) + u
    u = u + s
    u = getcode(u, b)
    If decode(u, b) = A Then
       incode = u
    Else
       GoTo 1:
    End If
End Function
Function decode(A, b As String) As String
On Error Resume Next
    Dim r, i As Integer, s, u As String
    u = getcode(A, b)
    i = Val(Mid(u, 1, 1)) + 1
    u = Mid(u, i + 1, Len(u) - i)
    If Len(u) Mod 3 <> 0 Then u = Mid(u, 1, Len(u) - 1)
    s = ""
    For r = 1 To Len(u) - 2 Step 3
        s = s + Chr(Val(Mid(u, r, 3)))
    Next
    decode = s
End Function
Function getcode(A, b As String) As String
On Error Resume Next
  Dim L, r As Integer, c As Long, q As String
  c = 0
  For r = 1 To Len(b)
     c = c + Asc(Mid(b, r, 1)) * (10 ^ r)
  Next
  q = Str(c)
  c = 0
  For r = 1 To Len(q)
     c = c + Val(Mid(q, r, 1))
  Next
  q = ""
  For r = 1 To Len(A)
     L = 256 - Asc(Mid(A, r, 1)) - r - Len(A)
     If L + c > 255 Then
        q = q + Chr(L - c)
     Else
        q = q + Chr(L + c)
     End If
  Next
  getcode = q
End Function
Function ctrs(s As String, y As Byte) As String
 Dim r, i As Integer, u, T As String
    u = ""
    For r = 1 To Len(s)
        T = Trim(Str(Asc(Mid(s, r, 1))))
        For i = 1 To y - Len(T)
            T = "0" + T
        Next i
        u = u + T
    Next
    ctrs = u
End Function

التطبيق فى القاعدة المرفقة ..

يتبع ...

02-Encode Decode.accdb

[ابو جودي]

ان شاء الله جارى العمل على تحضير باقى الافكار تباعا ولكن قبل الاستكمال 

هل هناك ما يحتاج الى شرح أو توضيح فيما سبق ؟!

[Moosak]

4 ساعات مضت, ابو جودي said:

هل هناك ما يحتاج الى شرح أو توضيح فيما سبق ؟!

طبعا أيوه 😂  .. كل حاجة 😁

لا أنا بس سؤالي الحين عن دوال التشفير ..

ليش حاط المتغير الثاني الـ b  ؟؟؟ أيش فائدته في الكود ؟

 

ولو كان حطيت شرح أو توضيح بسيط كـ كومنتس في الكود كان ريحت جميع سكان الكرة الأرضية من البحث والتحري 😅

 

والله يبارك لك هذي العقلية الفذة والشغل العدل 😉👌

[ابو جودي]

3- استخلاص قيم من مكونات الجهاز تستخدم فى عملية الترخيص

- رقم الـ UUID   رقم ثابت لا يتغير بتغيير الهارد ديسك او ختى بعملية الفورمات أو إعادة التقسيم للهارد ديسك

-

Public Function GetUUID(Optional strHost As String = ".") As String
On Error GoTo ErrorHandler

Dim objComputerSystemProduct   As Object
Dim objWMIService              As Object
Dim objItems                   As Object
Dim objDiskDriveSerial         As Object

  Set objWMIService = GetObject("winmgmts:\\" & strHost & "\root\cimv2")
  Set objComputerSystemProduct = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct", , 48)
  
  For Each objItems In objComputerSystemProduct
    GetUUID = objItems.UUID
  Next

Set objItems = Nothing
Set objWMIService = Nothing
Set objComputerSystemProduct = Nothing

ExitHandler:
  On Error Resume Next
  If Not objItems Is Nothing Then Set objItems = Nothing
  If Not objDiskDriveSerial Is Nothing Then Set objDiskDriveSerial = Nothing
  If Not objWMIService Is Nothing Then Set objWMIService = Nothing
  Exit Function
 
ErrorHandler:
  MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
          "Error Number: " & Err.Number & vbCrLf & _
          "Error Source: GetUUID" & vbCrLf & _
          "Error Description: " & Err.Description, _
          vbCritical, "An Error has Occurred!"
  Resume ExitHandler
End Function

- ويتم استدعاءه فقط من خلال 

GetUUID()

 

- رقم وموديل الهارد ديسك ثابت ولا يتغير 

Public Function GetDDSerialNumber(Optional strHost As String = ".", Optional strSymbol As String = ",") As String
On Error GoTo ErrorHandler

Dim objComputerSystemProduct   As Object
Dim objWMIService              As Object
Dim objItems                   As Object
Dim objDiskDriveSerial         As Object

  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strHost & "\root\cimv2")
  Set objDiskDriveSerial = objWMIService.ExecQuery("SELECT DeviceID, SerialNumber FROM Win32_DiskDrive")
  
  For Each objItems In objDiskDriveSerial
    GetDDSerialNumber = Trim(GetDDSerialNumber) & Trim(objItems.SerialNumber & strSymbol)
  Next
  
  If Right(GetDDSerialNumber, 1) = strSymbol Then GetDDSerialNumber = Left(GetDDSerialNumber, Len(GetDDSerialNumber) - 1)
  
  Set objItems = Nothing
  Set objWMIService = Nothing
  Set objDiskDriveSerial = Nothing
  
ExitHandler:
  On Error Resume Next
  If Not objItems Is Nothing Then Set objItems = Nothing
  If Not objDiskDriveSerial Is Nothing Then Set objDiskDriveSerial = Nothing
  If Not objWMIService Is Nothing Then Set objWMIService = Nothing
  Exit Function
  
ErrorHandler:
  MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
          "Error Number: " & Err.Number & vbCrLf & _
          "Error Source: GetDDSerialNumber" & vbCrLf & _
          "Error Description: " & Err.Description, _
          vbCritical, "An Error has Occurred!"
  Resume ExitHandler
End Function

-ويتم فقط استدعاءه من خلال 

GetDDSerialNumber()

 

التطبيق فى القاعدة المرفقة ..

يتبع ...

 

3- ارقام القطع UUID - HDD.accdb

[ابو جودي]

20 دقائق مضت, Moosak said:

ليش حاط المتغير الثاني الـ b  ؟؟؟ أيش فائدته في الكود ؟

 

'طيب اولا لست انا من قام بكتابة الكود

ثانيا يا سيدى الكود هذا افضل كود تشفير تعاملت معه لعدة اسبب 

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

أما بخصوص المتعير b  هو معامل التشفير الذى يعتمد الكود عليه 

يعنى مثلا عاوز اشفر الاسم موسى باستخدام الكواد على سبيل المثال يكون
 

incode("موسي","FrstName")

انا استخدمت معامل التشفير هنا كلمة FrstName  اذا لابد من استخدامها كما هى لاعادة الكلمة الى اصلها

يعنى هذا التشفير   

كGFـغصظ×ظضضصسرج

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

decode("كGFـغصظ×ظضضصسرج","FrstName")

طيب جرب تغيير حالة حرف مثلا 

?decode("كGFـغصظ×ظضضصسرج","Frstname")

لاحظ حرف الـ  N , n

بذلك لن تستطيع اعادة العملية 
 

34 دقائق مضت, Moosak said:

كان حطيت شرح أو توضيح بسيط كـ كومنتس في الكود كان ريحت جميع سكان الكرة الأرضية من البحث والتحري

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

[Moosak]

8 دقائق مضت, ابو جودي said:

المتعير b  هو معامل التشفير الذى يعتمد الكود عليه

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

بل واستخدمته في برامجي للتشفير ... بس كان الكود بدون المعامل المحترم  b .. 😁 ..

لذلك ما عرفت أيش اللي حشره معانا في النص إلا بعد ما تفضلت بالشرح 🙂 

 

14 دقائق مضت, ابو جودي said:

مطلوب البحث والتحرى 

طبعا .. طبعا .. لا شك

لكن لولا شرحك لصعب على الكثيرين فهم المغزى من الكود أو كيفية استخدامه 🙂 

[ابو جودي]

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

لا أنوى أن اعطيكم سمكا بل انوى أن أعلمكم الصيد ...

34 دقائق مضت, Moosak said:

بل واستخدمته في برامجي للتشفير

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

[Moosak]

3 ساعات مضت, ابو جودي said:

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

طب بص كده 😏

وكمان أشرت لك في الموضوع وشوف التاريخ 😄
مع تحيات المكتبة العامرة 😙

[ابو عبد الرحمن اشرف]

10 ساعات مضت, ابو جودي said:

ان شاء الله جارى العمل على تحضير باقى الافكار تباعا ولكن قبل الاستكمال 

هل هناك ما يحتاج الى شرح أو توضيح فيما سبق ؟!

حالا بإذن الله تعالى هفتح الملف المرفق وابلغ حضرتك باي مشكلة أو معضلة حدثت معي اخي الحبيب 

[ابو جودي]

في 20‏/2‏/2023 at 12:44, Moosak said:

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

ليس هذا الكود وانا اعتقد من كلامك انك اخذته من صلاحيات المستخدمين

[أغيد]

في 20‏/2‏/2023 at 19:32, ابو عبد الرحمن اشرف said:

هل هناك ما يحتاج الى شرح أو توضيح فيما سبق ؟!

بالنسبة لي لا أفهم كثيراً في الاكواد سوى مناداتها وتعريفها فقط .. وبصراحه خليك على عهدك القديم (الشرح باستفاضة) .. وعطنا السمكة مع السنارة .. طبعاً ان اسعفك الوقت مالم فيكفينا ما تفضلت به فنحن كما عهدناك دائماً كريم في عطائك متجدد في أفكارك

تم تعديل فبراير 22 بواسطه أغيد

[ابو عبد الرحمن اشرف]

59 دقائق مضت, أغيد said:

بالنسبة لي لا أفهم كثيراً في الاكواد سوى مناداتها وتعريفها فقط .. وبصراحه خليك على عهدك القديم (الشرح باستفاضة) .. وعطنا السمكة مع السنارة .. طبعاً ان اسعفك الوقت مالم فيكفينا ما تفضلت به فنحن كما عهدناك دائماً كريم في عطائك متجدد في أفكارك

هو ده الكلام اللي كنت عاوز اقوله بالضبط صح لسانك اخي اغيد 

أعطينا السنارة والسمكة مع بعض الله يرضى عنك 

[ابو عبد الرحمن اشرف]

في 20‏/2‏/2023 at 00:37, ابو جودي said:

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

طبعا لن اضع افكارى صريحة لتطبيق فكرة محددة 

لا أنوى أن اعطيكم سمكا بل انوى أن أعلمكم الصيد ...

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

1- الحماية عن طريق اضافة بيانات الحماية فى الريجسترى 

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

Public Const MyRegPath As String = "HKEY_CURRENT_USER\Software\Officena.net"
Public Const MyRegKey As String = "Judy"
Public Const myStringValue  As String = "محمد"
Public Const myValueData  As String = "ابو جودى"

'returns True if the registry key i_RegKey was found
'and False if not
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

  On Error GoTo ErrorHandler
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'try to read the registry key
  myWS.RegRead i_RegKey
  'key was found
  RegKeyExists = True
  Exit Function

ErrorHandler:
  'key was not found
  RegKeyExists = False
End Function

Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

  On Error Resume Next
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'read key from registry
  RegKeyRead = myWS.RegRead(i_RegKey)
End Function

Function RegKeySave(i_RegKey As String, _
               i_Value As String, _
      Optional i_Type As String = "REG_SZ")
Dim myWS As Object

  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'write registry key
  myWS.RegWrite i_RegKey, i_Value, i_Type
End Function

Function RegKeyDelete(i_RegKey As String) As Boolean
Dim myWS As Object

  On Error GoTo ErrorHandler
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'delete registry key
  myWS.RegDelete i_RegKey
  'deletion was successful
  RegKeyDelete = True
  Exit Function

ErrorHandler:
  'deletion wasn't successful
  RegKeyDelete = False
End Function

يتبع..

 

القاعدة المرفقة

 

01-Dealing with the registry.accdb 384 kB · 10 downloads

على قدر فهمي معنى كده ان البرنامج لا يعمل الا على هذا الجهاز فقط لانه أصبح محمي بريجستري الجهاز 

ام انني مش فاهم خالص 

بالله فهموني و بهدوء بارك الله فيك أخي الحبيب ابو جودي 

[ابو جودي]

في 22‏/2‏/2023 at 08:11, أغيد said:

خليك على عهدك القديم (الشرح باستفاضة)

 

في 22‏/2‏/2023 at 09:13, ابو عبد الرحمن اشرف said:

أعطينا السنارة والسمكة مع بعض الله يرضى عنك 

 

في 22‏/2‏/2023 at 09:27, ابو عبد الرحمن اشرف said:

بالله فهموني و بهدوء بارك الله فيك أخي الحبيب ابو جودي 

طيب خلينا نتفق على شئ 

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

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

لذلك وضعت الاكواد دون شرح

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

ان شاء الله اليوم نكمل 

اللى لقاء قريب بأمر الله

 

[ابو جودي]

3- انشاء جدول بالحقول المطلوبة برمجيا مع تأمين الجدول 

اولا كود انشاء جدول طبعا واضح من الكود نوع الحقل المطلوب انشاءه 

  Dim MySQL As String
  MySQL = "CREATE TABLE tblNameOfTble" _
                                    & "(" _
                                    & " [FieldAutoID]                COUNTER" _
                                    & ",[FieldByte]                  BYTE" _
                                    & ",[FieldInteger]               SMALLINT" _
                                    & ",[FieldLong]                  INTEGER" _
                                    & ",[FieldSingle]                REAL" _
                                    & ",[FieldDouble]                FLOAT" _
                                    & ",[FieldCurrency]              MONEY" _
                                    & ",[FieldShortText]             Text(5)" _
                                    & ",[FieldLongText]              MEMO" _
                                    & ",[FieldDateTime]              DATETIME" _
                                    & ",[FieldYesNo]                 BIT" _
                                    & ",[FieldOleObject]             IMAGE" _
                                    & ");"
  DoCmd.SetWarnings False: DoCmd.RunSQL MySQL: DoCmd.SetWarnings True

ثانيا تأمين الجدول :

ومن هنا نبدأ فى ابتكار وافكار الحماية التأمين

كما تعلمنا سابقا ان كانت البادئة فى اسم الجدول Usys  يعتبر الاكسس من تلقاء نفسه انه من جداول النظام ويكون الجدول مخفيا 
ولكن

عند اظهار كائنات النظام المخفيه يظهر الجدول 

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

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

Public Function DoHideTable(Optional strTableName As String = "")
On Error GoTo ErrorHandler

  Set db = CurrentDb
  
  For Each obj In Application.CurrentData.AllTables
    Set tdf = db.TableDefs(obj.Name)
    If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then
      If tdf.Name = strTableName Then tdf.Attributes = tdf.Attributes + dbHiddenObject
    End If
  Next
  
Set tdf = Nothing
Set obj = Nothing
db.Close
Set db = Nothing


ExitHandler:
  On Error Resume Next
  If Not tdf Is Nothing Then Set tdf = Nothing
  If Not obj Is Nothing Then Set obj = Nothing
  If Not db Is Nothing Then Set db = Nothing
  Exit Function
ErrorHandler:
  MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
          "Error Number: " & Err.Number & vbCrLf & _
          "Error Source: DoHideTable" & vbCrLf & _
          "Error Description: " & Err.Description, _
          vbCritical, "An Error has Occurred!"
  Resume ExitHandler
End Function

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

الاول اظهار الجدول 

Public Function DoShowTable(Optional strTableName As String = "")
On Error GoTo ErrorHandler

  Set db = CurrentDb
  
  For Each tdf In db.TableDefs
    If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 And tdf.Attributes = 1 Then
      If tdf.Name = strTableName Then tdf.Attributes = tdf.Attributes - dbHiddenObject
  End If
  Next

  
Set tdf = Nothing
db.Close
Set db = Nothing

ExitHandler:
  On Error Resume Next
  If Not tdf Is Nothing Then Set tdf = Nothing
  If Not obj Is Nothing Then Set obj = Nothing
  If Not db Is Nothing Then Set db = Nothing
  Exit Function
ErrorHandler:
  MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
          "Error Number: " & Err.Number & vbCrLf & _
          "Error Source: DoHideTable" & vbCrLf & _
          "Error Description: " & Err.Description, _
          vbCritical, "An Error has Occurred!"
  Resume ExitHandler
End Function

الثانى عمل استعلام لهذا الجدول دون اظهار الجدول

Public Function DoCreateQuery(Optional strTableName As String = "", Optional strQueryName As String = "")
On Error GoTo ErrorHandler

  Set db = CurrentDb
  
  MySQL = "Select * From " & strTableName
  Set qdf = db.CreateQueryDef(strQueryName, MySQL)

Set qdf = Nothing
db.Close
Set db = Nothing

ExitHandler:
  On Error Resume Next
  If Not tdf Is Nothing Then Set tdf = Nothing
  If Not obj Is Nothing Then Set obj = Nothing
  If Not db Is Nothing Then Set db = Nothing
  Exit Function
ErrorHandler:
  MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
          "Error Number: " & Err.Number & vbCrLf & _
          "Error Source: DoHideTable" & vbCrLf & _
          "Error Description: " & Err.Description, _
          vbCritical, "An Error has Occurred!"
  Resume ExitHandler
End Function

ملاحظة بعد الاوامر ليظهر فعاليتها مثل الاخفاء والاظهار قد تحتاج لاغلاق القاعدة واعادة فتحها مرة أخرى

التطبيق فى القاعدة المرفقة ..

يتبع ...

 

04- craet table with hard code.accdb

[ابو جودي]

4- انشاء قاعدة البيانات الأمامية مأمنة بكلمة مرور

Public Function DoCreatDatabaseByPassword( _
                                          Optional strDbPath As String = "", _
                                          Optional strNewDbName As String = "", _
                                          Optional strPassNewDb As String = "" _
                                          )
 
On Error GoTo ErrorHandler
 
  Dim wrkDefault      As Workspace
  Dim db              As DAO.Database


    
  If IsNull(strDbPath) Or strDbPath = Null Or strDbPath = vbNullString Or strDbPath = Empty Or strDbPath = "" Or Len(strDbPath) = 0 Then strDbPath = CurrentProject.Path & "\"
  If IsNull(strNewDbName) Or strNewDbName = Null Or strNewDbName = vbNullString Or strNewDbName = Empty Or strNewDbName = "" Or Len(strNewDbName) = 0 Then strNewDbName = "NewDB.mdb"
  If IsNull(strPassNewDb) Or strPassNewDb = Null Or strPassNewDb = vbNullString Or strPassNewDb = Empty Or strPassNewDb = "" Or Len(strPassNewDb) = 0 Then strPassNewDb = "00"
   
  Set wrkDefault = DBEngine.Workspaces(0)
  
  If Dir(strDbPath & strNewDbName) <> "" Then Kill strDbPath & strNewDbName
  Set db = wrkDefault.CreateDatabase(strDbPath & strNewDbName, dbLangGeneral & ";PWD=" & strPassNewDb)
    
    
strDbPath = vbNullString
strNewDbName = vbNullString
strPassNewDb = vbNullString

Set wrkDefault = Nothing
db.Close
Set db = Nothing
    
ExitHandler:
   Exit Function
ErrorHandler:

    MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description
    Resume ExitHandler
  
End Function

 

التطبيق فى القاعدة المرفقة ..

يتبع ...

 

 

05- CreatDatabaseByPassword.accdb

[ابو عبد الرحمن اشرف]

في 20‏/2‏/2023 at 12:10, ابو جودي said:

GetUUID()

الله يرضي عنك اخي الحبيب الغالي ابو جودي

بعد تشغيل ذلك النموذج والحصول علي uuid 

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

يكتب فيه اذا كان uuid= كذا  open ..كذا

ورسالة الخطأ " يرجي الاتصال على مصمم البرنامج وشكرا"

فكيف يتم كتابة هذا الحدث واين يوضع في نموذج بدء التشغيل

 

[ابو عبد الرحمن اشرف]

21 ساعات مضت, ابو جودي said:

انشاء قاعدة البيانات الأمامية مأمنة بكلمة مرور

اخي الحبيب الغالي السلام عليكم ورحمة الله وبركاته

تم تنفيذ الخطوة 3 وهي انشاء الجدول والخطوة 4 وهي انشاء قاعدة بيانات امامية محمية بكلمة مرور

فما  هي الخطوة التالية بارك الله فيك اخي 

وما راي حضرتك في هذا الحدث الذي يخفي الجدول ويظهره دون الحاجه لغلق القاعدة وفتحها مرة اخري 

اليك المرفق اخي 

04- craet table with hard code.rar

[ابو جودي]

في 24‏/2‏/2023 at 08:11, ابو عبد الرحمن اشرف said:

يخفي الجدول ويظهره دون الحاجه لغلق القاعدة وفتحها مرة اخري

طيب اخفى الجدول بطريقتك واظهر الكائنات تجد الجدول موجود ضمن الكائنات المخفية

انظر الصورة

بينما الكود الذى استخدمته لا يظهر فيها الجدول اصلا 

انظر الصورة

 

في 24‏/2‏/2023 at 08:11, ابو عبد الرحمن اشرف said:

فما  هي الخطوة التالية بارك الله فيك اخي

انتظر ..

ان شاء الله جارى العمل 

[ابو عبد الرحمن اشرف]

5 ساعات مضت, ابو جودي said:

طيب اخفى الجدول بطريقتك واظهر الكائنات تجد الجدول موجود ضمن الكائنات المخفية

انظر الصورة

بينما الكود الذى استخدمته لا يظهر فيها الجدول اصلا 

انظر الصورة

 

انتظر ..

ان شاء الله جارى العمل 

يسر الله لي ولك الخير اخي الحبيب 

سأنتظر 

5 ساعات مضت, ابو جودي said:

طيب اخفى الجدول بطريقتك واظهر الكائنات تجد الجدول موجود ضمن الكائنات المخفية

انظر الصورة

بينما الكود الذى استخدمته لا يظهر فيها الجدول اصلا 

انظر الصورة

 

انتظر ..

ان شاء الله جارى العمل 

انا بتعلم منك اخي الفاضل الكريم 

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

بارك الله فيك أخي الحبيب 

[ابو عبد الرحمن اشرف]

في 24‏/2‏/2023 at 17:46, ابو عبد الرحمن اشرف said:

الله يرضي عنك اخي الحبيب الغالي ابو جودي

بعد تشغيل ذلك النموذج والحصول علي uuid 

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

يكتب فيه اذا كان uuid= كذا  open ..كذا

ورسالة الخطأ " يرجي الاتصال على مصمم البرنامج وشكرا"

فكيف يتم كتابة هذا الحدث واين يوضع في نموذج بدء التشغيل

 

اخي الحبيب 

كيف يتم كتابة الأمر البرمجي بعد الحصول على رقم uuid

مع إظهار رسالة خطأ تفيد بالرجوع للمصمم لعمل القاعدة على جهاز اخر 

[ابو جودي]

منذ ساعه, ابو عبد الرحمن اشرف said:

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

 

طيب الشئ بالشئ يذكر

انا لم اقل انه الاصح ولا الاكثر امانا  بل هو ليس امن 

ولا انصح باستخدام الكود مع باقى جداول قاعدة البيانات

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

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

[ابو عبد الرحمن اشرف]

11 دقائق مضت, ابو جودي said:

طيب الشئ بالشئ يذكر

انا لم اقل انه الاصح ولا الاكثر امانا  بل هو ليس امن 

ولا انصح باستخدام الكود مع باقى جداول قاعدة البيانات

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

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

بوركت اخي الحبيب 

زادك الله علما ونفعنا الله بك 

[ابو عبد الرحمن اشرف]

3 ساعات مضت, ابو جودي said:

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

 

1 - حبيبي الغالي انت مش يرضيك ان حاجة تعدي كدة بدون فهم خاصة ونحن في اطار دروس نتعلم منها من غزير علمكم اخي 

فممكن مثال اخي علي مربع السرد المتعدد

2 - هل من الممكن بنفس طريقة اخفاء الجدول يتم اخفاء كافة الاستعلامات والنماذج والتقارير والماكرو والوحدات النمطية (الاوامر البرمجية ) او المديول بحيث لا تظهر عند اظهار الملفات المخفية