توقف البرنامج عند تشفير البيانات

[محمد القدسي]

السلام عليكم

اساتذتي الافاضل عند تشغيل الاستعلام لتشفير بيانات الجدول باستخدام دالة incode فان النظام يعلق ويتوقف عن العمل

وهذا مرفق

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

tashfertable.rar

[محمد القدسي]

up

[محمد القدسي]

up

[محمد القدسي]

up

[محمد القدسي]

up

[محمد أبوعبدالله]

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

لم يتوقف البرنامج ولكن جدول table1 غير موجود

والموجود جدول table12 لو اردنا استخدامه ولكن به مشكلة ايضاً فبه حقول مطلوبة مثل txtbyan و txtdes

جرب الدخول باسم : محمد وكلمة المرور : 123

tashfertable.rar

تحياتي

 

[محمد القدسي]

اشكرك استاذي محمد

ولاكن لعلي لم اوضح المطلوب

اريدك استاذي العزيز ان تشغل استعلام التحديث (استعلام4)الموجود لتشفير البيانات

وانظر كيف تتوقف القاعدة عن العمل

[محمد أبوعبدالله]

المشكلة في كود التشفير نفسه

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

للتشفير

Public Function Encrypt(StringToEncrypt As String, Optional AlphaEncoding As Boolean = False) As String
    On Error GoTo ErrorHandler
    Dim Char As String
    Encrypt = ""
    
    For i = 1 To Len(StringToEncrypt)
        Char = Asc(Mid(StringToEncrypt, i, 1))
        Encrypt = Encrypt & Len(Char) & Char
    Next i
    
    If AlphaEncoding Then
    
        StringToEncrypt = Encrypt
        Encrypt = ""
        
        For i = 1 To Len(StringToEncrypt)
            Encrypt = Encrypt & Chr(Mid(StringToEncrypt, i, 1))
        Next i
        
    End If
    Exit Function
ErrorHandler:
    Encrypt = "Error"
End Function

لفك التشفير

Public Function Decrypt(StringToDecrypt As String, Optional AlphaDecoding As Boolean = False) As String
    On Error GoTo ErrorHandler
    Dim CharCode As String
    Dim CharPos As Integer
    Dim Char As String
    
    If AlphaDecoding Then
    
        Decrypt = StringToDecrypt
        StringToDecrypt = ""
        
        For i = 1 To Len(Decrypt)
            StringToDecrypt = StringToDecrypt & (Asc(Mid(Decrypt, i, 1)))
        Next i
        
    End If
    
    Decrypt = ""
    
    Do
    
        CharPos = Left(StringToDecrypt, 1)
        StringToDecrypt = Mid(StringToDecrypt, 2)
        CharCode = Left(StringToDecrypt, CharPos)
        StringToDecrypt = Mid(StringToDecrypt, Len(CharCode) + 1)
        Decrypt = Decrypt & Chr(CharCode)
        
    Loop Until StringToDecrypt = ""
    Exit Function
ErrorHandler:
    Decrypt = "Error"
End Function

مثال للتفشير

    DoCmd.RunSQL "UPDATE table12 SET table12.txtbyan = Encrypt([txtbyan])"
    DoCmd.RunSQL "UPDATE table12 SET table12.txtdes = Encrypt([txtdes])"
    DoCmd.RunSQL "UPDATE table12 SET table12.txtallkad = Encrypt([txtallkad])"

مثال لفك التشفير

If Decrypt(DLookup("[pass]", "table12", "[username]='" & names & "'")) = Me.pswrd Then

tashfertable.rar

تحياتي

[محمد القدسي]

اشكرك استاذي على هذا المثال الرائع

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

[محمد أبوعبدالله]

بالتأكيد اذا كان عدد السجلات كبير سيكون هناك ضريبة للتشفير 🙂

تحياتي

[محمد القدسي]

هههههههههه ما زلنا نحن والضرائب حتى في اوفيس

على العموم سلمت يداك استاذي وبارك الله في الجميع