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

[ابو جودي]

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

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

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

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

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.accdbFetching info...

[ابو جودي]

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.accdbFetching info...

[ابو جودي]

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

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

[Moosak]

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

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

Expand  

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

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

ليش حاط المتغير الثاني الـ 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.accdbFetching info...

[ابو جودي]

  في 20‏/2‏/2023 at 09:55, Moosak said:

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

 

Expand  

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  في 20‏/2‏/2023 at 09:55, Moosak said:

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

Expand  

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

[Moosak]

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

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

Expand  

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

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

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

 

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

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

Expand  

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

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

[ابو جودي]

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

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

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

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

Expand  

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

[Moosak]

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

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

Expand  

طب بص كده 😏

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

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

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

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

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

Expand  

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

[ابو جودي]

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

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

Expand  

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

[أغيد]

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

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

Expand  

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

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

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

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

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

Expand  

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

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

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

  في 19‏/2‏/2023 at 22: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

Expand  

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

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

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

[ابو جودي]

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

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

Expand  

 

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

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

Expand  

 

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

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

Expand  

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

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

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

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

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

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

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

 

[ابو جودي]

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.accdbFetching info...

[ابو جودي]

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.accdbFetching info...

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

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

GetUUID()

Expand  

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

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

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

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

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

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

 

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

  في 23‏/2‏/2023 at 18:57, ابو جودي said:

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

Expand  

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

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

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

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

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

04- craet table with hard code.rarFetching info...

[ابو جودي]

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

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

Expand  

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

انظر الصورة

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

انظر الصورة

 

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

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

Expand  

انتظر ..

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

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

  في 26‏/2‏/2023 at 08:25, ابو جودي said:

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

انظر الصورة

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

انظر الصورة

 

انتظر ..

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

Expand  

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

سأنتظر 

  في 26‏/2‏/2023 at 08:25, ابو جودي said:

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

انظر الصورة

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

انظر الصورة

 

انتظر ..

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

Expand  

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

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

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

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

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

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

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

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

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

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

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

 

Expand  

اخي الحبيب 

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

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

[ابو جودي]

  في 26‏/2‏/2023 at 14:18, ابو عبد الرحمن اشرف said:

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

 

Expand  

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

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

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

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

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

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

  في 26‏/2‏/2023 at 15:31, ابو جودي said:

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

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

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

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

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

Expand  

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

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

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

  في 26‏/2‏/2023 at 15:31, ابو جودي said:

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

 

Expand  

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

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

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