PDA

View Full Version : سوال: یک الگوریتم حرفه ای برای Encode , Decode



m.4.r.m
شنبه 04 شهریور 1391, 14:05 عصر
دوستان یک الگوریتم code , decode برای رشته می خوام هر کی داره دریغ نکنه مرسی منتظرم

امین مستانی
شنبه 04 شهریور 1391, 16:21 عصر
سلام

من خودم از این استفاده میکنم خیلی خوب و دقیقه و همراه با پسورد هست.
فقط حروف فارسی رو پشتیبانی نمیکنه که میشه با یکم دستکاری درستش کرد .


Function EncryptIt(strCodeword, strMessage, intAction)
Dim strAlphabet, intMessageChar, intCodewordChar
Dim intShiftAdjust, intHomeLocation
strAlphabet = "0@1#2$3%4^5&6*7=8-9+ AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYy Zz"
intCodewordChar = 1
For intMessageChar = 1 To Len(strMessage)
If InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) > 0 Then
If InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) > 0 Then
intShiftAdjust = InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare)
intHomeLocation = InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare)
If intAction = 0 Then intShiftAdjust = intHomeLocation - intShiftAdjust
If intAction = 1 Then intShiftAdjust = intHomeLocation + intShiftAdjust
If intShiftAdjust > Len(strAlphabet) Then intShiftAdjust = intShiftAdjust - Len(strAlphabet)
If intShiftAdjust < 1 Then intShiftAdjust = intShiftAdjust + Len(strAlphabet)
Else
intShiftAdjust = 1
End If
EncryptIt = EncryptIt & Mid(strAlphabet, intShiftAdjust, 1)
Else
EncryptIt = EncryptIt & Mid(strMessage, intMessageChar, 1)
End If
If intCodewordChar > Len(strCodeword) Then intCodewordChar = 1 Else intCodewordChar = intCodewordChar + 1
Next intMessageChar
End Function



کد کردن :

Text1.Text = EncryptIt("Password", Text1.Text, 0)

دیکد کردن :

Text1.Text = EncryptIt("Password", Text1.Text, 1)

یا علی

امین مستانی
شنبه 04 شهریور 1391, 16:25 عصر
در کد بالا یک مشکل وجود داره من هرچقدر ویرایش میکنم درست نمیشه

در قسمت
strAlphabet = "0@1#2$3%4^5&6*7=8-9+ AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYy Zz"

مابین Yy و Zz فاصله نیست .

پروژه را ضمیمه کردم

m.4.r.m
شنبه 04 شهریور 1391, 16:38 عصر
این تو فارسی مشکل سازه دوستان کسی الگوریتم دیگه ای نداره ؟

امین مستانی
شنبه 04 شهریور 1391, 17:20 عصر
اینم یکی دیگه از فارسی هم پشتیبانی میکنه