إجمالي مرات مشاهدة الصفحة

الخميس، 6 أكتوبر 2016

تشفير وفك تشفير البيانات Encrypt And Decrypt Function

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

هل لديك بيانات حساسة ومهمة في ورقة العمل تريد ألا يطلع عليها أحد؟ 
طرق الحماية للإكسيل كما يعرف الجميع ضعيفة ، لذا فإن تشفير البيانات هو الحل الأمثل للوصول إلى حماية أفضل للبيانات.


إخواني الكرام أقدم لكم طريقة لتشفير البيانات في ملفك ، وبنفس الكود ستتمكن من فك تشفير البيانات.

خطوات العمل :
>> قم بالدخول لمحرر الأكواد عن طريق Alt + F11 ، ثم من قائمة Insert أدرج موديول جديد Module ، وأخيراً الصق الكود التالي داخل الموديول.

>> قم برسم زر أمر على ورقة العمل ، ثم كليك يمين على الزر واختر الأمر Assign Macro ثم اختر الإجراء الفرعي المسمى Encrypt_Decrypt

Sub Encrypt_Decrypt()
    Dim xRg             As Range
    Dim xPsd            As String
    Dim xTxt            As String
    Dim xEnc            As Boolean
    Dim xRet            As Variant
    Dim xCell           As Range

    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Select A Range:", "Select Range To Encrypt / Decrypt", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    
    xPsd = InputBox("Enter Password:", "Pass Entry")
    If xPsd = "" Then
        MsgBox "Password Cannot Be Empty", , "Kutools For Excel"
        Exit Sub
    End If
    
    xRet = Application.InputBox("Type 1 To Encrypt Cell(s)" & vbNewLine & vbNewLine & "Type 2 To Decrypt Cell(s)", "Encrypt = 1 / Decrypt = 2", , , , , , 1)
    If TypeName(xRet) = "Boolean" Then Exit Sub
    If xRet > 0 Then
        xEnc = (xRet Mod 2 = 1)
        For Each xCell In xRg
            If xCell.Value <> "" Then
                xCell.Value = Encryption(xPsd, xCell.Value, xEnc)
            End If
        Next xCell
    End If
End Sub

Private Function StrToPsd(ByVal Txt As String) As Long
    Dim xVal            As Long
    Dim xCh             As Long
    Dim xSft1           As Long
    Dim xSft2           As Long
    Dim I               As Integer
    Dim xLen            As Integer
    
    xLen = Len(Txt)
    
    For I = 1 To xLen
        xCh = Asc(Mid$(Txt, I, 1))
        xVal = xVal Xor (xCh * 2 ^ xSft1)
        xVal = xVal Xor (xCh * 2 ^ xSft2)
        xSft1 = (xSft1 + 7) Mod 19
        xSft2 = (xSft2 + 13) Mod 23
    Next I
    
    StrToPsd = xVal
End Function

Private Function Encryption(ByVal Psd As String, ByVal InTxt As String, Optional ByVal Enc As Boolean = True) As String
    Dim xOffset         As Long
    Dim xLen            As Integer
    Dim I               As Integer
    Dim xCh             As Integer
    Dim xOutTxt         As String
    
    xOffset = StrToPsd(Psd)
    Rnd -1
    Randomize xOffset
    xLen = Len(InTxt)
    
    For I = 1 To xLen
        xCh = Asc(Mid$(InTxt, I, 1))
        If xCh >= 32 And xCh <= 126 Then
            xCh = xCh - 32
            xOffset = Int((96) * Rnd)
            If Enc Then
                xCh = ((xCh + xOffset) Mod 95)
            Else
                xCh = ((xCh - xOffset) Mod 95)
                If xCh < 0 Then xCh = xCh + 95
            End If
            xCh = xCh + 32
            xOutTxt = xOutTxt & Chr$(xCh)
        End If
    Next I
    
    Encryption = xOutTxt
End Function

شرح كيفية استخدام الكود : 
لتشفير البيانات : حدد النطاق أو الخلايا المراد تشفير البيانات بها ، انقر على زر الأمر ليظهر لك صندوق إدخال يمكنك من خلاله تحديد النطاق ، وبما أنك قمت بتحديد النطاق في البداية فلن يكون لديك سوى أن تنقر OK ، لتنتقل إلى صندوق إدخال آخر بعنوان Pass Entry ومن خلاله تدخل كلمة السر للتشفير ، وليكن 111 ، ثم انقر OK
الآن سيظهر آخر صندوق إدخال وهو لإدخال الرقم 1 (للتشفير) ، أو الرقم 2 (لفك التشفير)
بما أننا نريد التشفير سنقوم بكتابة الرقم 1 ثم ننقر OK ، ولاحظ البيانات في النطاق (لقد تم الأمر بحمد الله)

لفك التشفير : ستقوم بتكرار نفس الخطوات بالضبط وتدخل نفس كلمة السر ، وفي آخر صندوق إدخال ستقوم بإدخال الرقم 2 لفك التشفير

وأخيراً إليكم صورة توضيحية لكيفية التعامل مع الكود


إعداد / ياسر خليل أبو البراء

هناك تعليقان (2):