اذهب الي المحتوي
أوفيسنا

عكس دالة تشفير


rey360
إذهب إلى أفضل إجابة Solved by صالح حمادي,

الردود الموصى بها

السلام عليكم

هذه دالة ممتازة للتشفير و فك التشفير وضعها الأستاذ @أ / محمد صالح جزاه الله كل خير

Public Const trialdays As Integer = 30
Public Const encodekey As String = "mas"
Public Const regpath As String = "HKEY_CURRENT_USER\software"
Public Const regfolder As String = "masrfirst"
Public Const mainform As String = "main"

Function en_de(sMessage As String, Optional strKey As String = encodekey)
    Dim kLen, x, y, i, j, temp
    Dim s(256), k(256)
 
    'Init keystream
    kLen = Len(strKey)
    For i = 0 To 255
        s(i) = i
        k(i) = Asc(Mid(strKey, (i Mod kLen) + 1, 1))
    Next
 
    j = 0
    For i = 0 To 255
        j = (j + k(i) + s(i)) Mod 255
        temp = s(i)
        s(i) = s(j)
        s(j) = temp
    Next
 
    'Drop n bytes from keystream
    x = 0
    y = 0
    For i = 1 To 3072
        x = (x + 1) Mod 255
        y = (y + s(x)) Mod 255
        temp = s(x)
        s(x) = s(y)
        s(y) = temp
    Next
 
    'Encode/Decode
    For i = 1 To Len(sMessage)
        x = (x + 1) Mod 255
        y = (y + s(x)) Mod 255
        temp = s(x)
        s(x) = s(y)
        s(y) = temp
 
        en_de = en_de & Chr(s((s(x) + s(y)) Mod 255) Xor Asc(Mid(sMessage, i, 1)))
    Next
End Function

قم بوضعها في وحدة نمطية منفصلة

و يتم استدعائها بهذا الشكل

Me.t = en_de(Me.v)

v و t هما أسماء مربعات نص

و هي تقوم بالتشفير و فك التشفير في نفس الوقت

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

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

 

  • Like 1
رابط هذا التعليق
شارك

منذ ساعه, ابوآمنة said:

طبعاً الشفرة تسجل في الريجستري regedit

لا يا أخي الشفرة لا تسجل في الرجستري

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

Public Const encodekey As String = "mas"

 

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

1 دقيقه مضت, صالح حمادي said:

لا يا أخي الشفرة لا تسجل في الرجستري

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


Public Const encodekey As String = "mas"

 

Public Const regpath As String = "HKEY_CURRENT_USER\software"

ضيعني هذا السطر 

شكراً لك على التنبيه 

لكن هل هو متغيير أم ثابت Const 

  • Like 1
رابط هذا التعليق
شارك

  • أفضل إجابة
8 ساعات مضت, rey360 said:

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

أولا يجب إضافة تعديل بسيط لدالتك لتصبح بهذا الشكل:

Function sedqtr(mott As String)
Dim se As String
se = ""
For i = 1 To Len(mott)
  se = se & Format(Asc(Mid(mott, i, 1)), "000") + Int(100 / 15)
Next
sedqtr = se
End Function

الدالة المعاكسة لها تكون كالتالي:

Function sedqtr(mott As String)
Dim se As String
se = ""
For i = 1 To Len(mott) Step 3
  se = se & Chr(Val(Mid(mott, i, 3)) - Int(100 / 15))
Next
sedqtr = se
End Function

 

  • Like 4
  • Thanks 1
رابط هذا التعليق
شارك

شكرا لك أستاذ صالح حمادي أدخلت format لتصبح كل أرقام تتكون من 3 أرقام عوض 1 أو 2 أو 3 فكرة أكثر من جيدة أنا كنت أفكر في عمل دالة عن طريق دوران تتحقق من الارقام  ومع ذلك لم أكن اعرف اذا كانت ستنجح ومن هنا نستنتج أن تهكر الارقام السريال للبرامج و الالعاب ليس بأمر الهين أو السهل

رابط هذا التعليق
شارك

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

Function sedqtr(mott As String)
Dim se As String
se = ""
For i = 1 To Len(mott)
  se = se & Format(Asc(Mid(mott, i, 1))+ Int(100 / 15), "000") 
Next
sedqtr = se
End Function

 

تم تعديل بواسطه rey360
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information