کد کردن اطلاعات در اکسس

[id1385]

با سلام
قبلاً در این تالار یک سری فانکشن و روشها برای کد کردناطلاعات گذاشته بودم
در این تایپیک میخوام یک روش بسیار دقیق و حرفه ای تری را آموزش دهم

نمونه کد خروجی:


AC66FBFBA222D0E5AC20ACD8F3E4C42783D8708320686D580C F4CC9AFB889F7362F7BC03E7D92CFFAB223A5E6C7070337BD1 C05A78018522316B9C7D40B0D8F6BF4760325C45D8AD598821


ابتدا یک ماژول درست کنید و کد زیر را در ماژول قرار دهید


Option Compare Database


Public Function protect(strText As String) As String
If IsEmpty(strText) = False Then
protect = ToHexDump(encript(strText))
End If
End Function




Public Function unProtect(strProtectedText As String) As String
If IsEmpty(strProtectedText) = False Then
unProtect = encript(FromHexDump(strProtectedText))
End If
End Function


Private Function encript(sText As String) As String
Dim baS(0 To 255) As Byte
Dim baK(0 To 255) As Byte
Dim sKey As String
Dim bytSwap As Byte
Dim lI As Long
Dim lJ As Long
Dim lIdx As Long
sKey = "A78wew4asds5ds7dad21s1as4darfssd2fs5fg41as4aw5r5df s2f154weadhuf"
For lIdx = 0 To 255
baS(lIdx) = lIdx
baK(lIdx) = Asc(Mid$(sKey, 1 + (lIdx Mod Len(sKey)), 1))
Next
For lI = 0 To 255
lJ = (lJ + baS(lI) + baK(lI)) Mod 256
bytSwap = baS(lI)
baS(lI) = baS(lJ)
baS(lJ) = bytSwap
Next
lI = 0
lJ = 0
For lIdx = 1 To Len(sText)
lI = (lI + 1) Mod 256
lJ = (lJ + baS(lI)) Mod 256
bytSwap = baS(lI)
baS(lI) = baS(lJ)
baS(lJ) = bytSwap
encript = encript & Chr$((pvCryptXor(baS((CLng(baS(lI)) + baS(lJ)) Mod 256), Asc(Mid$(sText, lIdx, 1)))))
Next
End Function


Private Function pvCryptXor(ByVal lI As Long, ByVal lJ As Long) As Long
If lI = lJ Then
pvCryptXor = lJ
Else
pvCryptXor = lI Xor lJ
End If
End Function


Private Function ToHexDump(sText As String) As String
Dim lIdx As Long


For lIdx = 1 To Len(sText)
ToHexDump = ToHexDump & Right$("0" & Hex(Asc(Mid(sText, lIdx, 1))), 2)
Next
End Function


Private Function FromHexDump(sText As String) As String
Dim lIdx As Long


For lIdx = 1 To Len(sText) Step 2
FromHexDump = FromHexDump & Chr$(CLng("&H" & Mid(sText, lIdx, 2)))
Next
End Function





کد کردن

protect

AdminPass = GetAdminPass
If protect(Trim(txt_pass.Value)) = AdminPass Then
checkForm = True



خارج ساختن از حالت کد

unProtect

If User_pass.Value <> unProtect(Rst.Fields("Password")) Then
User_pass.SetFocus
Exit Sub



امیدوارم مورد پسند قرار گرفته باشد



موفق باشید