بعد التحية
كيف يمكن تشفير/ترميز قاعدة بيانات خارجية بكل جداولها من قاعدة حالية؟
أى من خلال قاعدة البيانات الحالية يمكننا تشفير/ترميز أى قاعدة بيانات أخرى بكافة جداولها (مهما كان حجم لبيانات بداخلها)
قمت باستخدام وحدة نمطية للترميز (مقتبسة من الأخ الكبير رضا عقيل) كالتالى
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
وقمت باستخدام هذا الكود
DoCmd.RunSQL "UPDATE tblItems SET tblItems.Itname = incode(tblItems.[Itname],tblItems.[Itname]); ", -1
ولكن هذا الكود يقوم بتشفير كل محتويات الحقل المحدد فقط..
مرفق مثال للتوضيح
شكراً مقدماً على المساعدة
مع خالص تحياتى
