rey360 قام بنشر مارس 28, 2020 مشاركة قام بنشر مارس 28, 2020 السلام عليكم أريد عكس دالة لتشفير جدول اليوزر ان أمكن هي دالة بسيطة Function sedqtr(mott As String) Dim se As String se = "" For i = 1 To Len(mott) se = se & Asc(Mid(mott, i, 1)) + Int(100 / 15) Next sedqtr = se End Function رابط هذا التعليق شارك More sharing options...
صالح حمادي قام بنشر مارس 29, 2020 مشاركة قام بنشر مارس 29, 2020 السلام عليكم هذه دالة ممتازة للتشفير و فك التشفير وضعها الأستاذ @أ / محمد صالح جزاه الله كل خير 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 هما أسماء مربعات نص و هي تقوم بالتشفير و فك التشفير في نفس الوقت 2 1 رابط هذا التعليق شارك More sharing options...
rey360 قام بنشر مارس 29, 2020 الكاتب مشاركة قام بنشر مارس 29, 2020 شكرا لك أستاذ صالح حمادي على الدالة كما يوجد عدة دوال أخرى وكل وحدة وطرقة المتبعة فيها ولكن أرد عكس هذيه دالة رغم بساطتها لم أنجح في ذلك وشكر جزيلا لك 1 رابط هذا التعليق شارك More sharing options...
حسين العربى قام بنشر مارس 29, 2020 مشاركة قام بنشر مارس 29, 2020 بعد اذن صاحب المشاركه سؤالي الي استاذي الفاضل صالح حمادي بعد تجربة الكود تظهر لي هذه الرساله 3333.accdb رابط هذا التعليق شارك More sharing options...
ابوآمنة قام بنشر مارس 29, 2020 مشاركة قام بنشر مارس 29, 2020 (معدل) عن إذن أستاذي ومعلمي صالح تفضل 3333.accdb طبعاً الشفرة تسجل في الريجستري regedit تم تعديل مارس 29, 2020 بواسطه ابوآمنة 3 1 رابط هذا التعليق شارك More sharing options...
حسين العربى قام بنشر مارس 29, 2020 مشاركة قام بنشر مارس 29, 2020 الف شكر استاذي الفاضل ابوآمنة 1 رابط هذا التعليق شارك More sharing options...
صالح حمادي قام بنشر مارس 29, 2020 مشاركة قام بنشر مارس 29, 2020 منذ ساعه, ابوآمنة said: طبعاً الشفرة تسجل في الريجستري regedit لا يا أخي الشفرة لا تسجل في الرجستري فالمتغيرات المعرفة فوق الدالة نحتاج منها سطر واحد فقط و البقية تستطيع حذفها لأنها خاصة ببرنامج آخر Public Const encodekey As String = "mas" 1 1 رابط هذا التعليق شارك More sharing options...
ابوآمنة قام بنشر مارس 29, 2020 مشاركة قام بنشر مارس 29, 2020 1 دقيقه مضت, صالح حمادي said: لا يا أخي الشفرة لا تسجل في الرجستري فالمتغيرات المعرفة فوق الدالة نحتاج منها سطر واحد فقط و البقية تستطيع حذفها لأنها خاصة ببرنامج آخر Public Const encodekey As String = "mas" Public Const regpath As String = "HKEY_CURRENT_USER\software" ضيعني هذا السطر شكراً لك على التنبيه لكن هل هو متغيير أم ثابت Const 1 رابط هذا التعليق شارك More sharing options...
أفضل إجابة صالح حمادي قام بنشر مارس 29, 2020 أفضل إجابة مشاركة قام بنشر مارس 29, 2020 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 4 1 رابط هذا التعليق شارك More sharing options...
صالح حمادي قام بنشر مارس 29, 2020 مشاركة قام بنشر مارس 29, 2020 منذ ساعه, ابوآمنة said: شكراً لك على التنبيه لكن هل هو متغيير أم ثابت Const العفو أخي هو متغير ثابت 1 رابط هذا التعليق شارك More sharing options...
rey360 قام بنشر مارس 29, 2020 الكاتب مشاركة قام بنشر مارس 29, 2020 شكرا لك أستاذ صالح حمادي أدخلت format لتصبح كل أرقام تتكون من 3 أرقام عوض 1 أو 2 أو 3 فكرة أكثر من جيدة أنا كنت أفكر في عمل دالة عن طريق دوران تتحقق من الارقام ومع ذلك لم أكن اعرف اذا كانت ستنجح ومن هنا نستنتج أن تهكر الارقام السريال للبرامج و الالعاب ليس بأمر الهين أو السهل رابط هذا التعليق شارك More sharing options...
rey360 قام بنشر مارس 29, 2020 الكاتب مشاركة قام بنشر مارس 29, 2020 (معدل) تعديل بسيط لدالة التشفير لتقوم بقرأة الاحرف الكبيرة 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 تم تعديل مارس 29, 2020 بواسطه rey360 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.