VB加解密代码

前端之家收集整理的这篇文章主要介绍了VB加解密代码前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

Function crypt(Action As String,Key As String,Src As String) As String

'Action
' E encrypts,D decrypts,
'Key is a unique string needed to en/decrypt (either
' hardcode or setup something for the user to enter.'Src is the string to be en/decrypted.On Error GoTo errHandler Dim count As Integer,KeyPos As Integer,KeyLen As Integer,SrcAsc As Integer Dim Dest As String,Offset As Integer,TmpSrcAsc,SrcPos As Integer KeyLen = Len(Key) If Action = "E" Then Randomize Offset = (Rnd * 10000 Mod 255) + 1 Dest = Hex$(Offset) For SrcPos = 1 To Len(Src) SrcAsc = (Asc(Mid$(Src,SrcPos,1)) + Offset) Mod 255 If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1 'Fill Dest$ with HEX representation of Encrypted field 'Hex used to keep nasties such as eof or lf from mangling stream 'Use format$ to make Hex$ return " 0" instead of "0" when the same 'values are Xor'ed together (Null) - keeps placeholder for decrypt SrcAsc = SrcAsc Xor Asc(Mid$(Key,KeyPos,1)) Dest = Dest + Format$(Hex$(SrcAsc),"@@") Offset = SrcAsc Next ElseIf Action = "D" Then Offset = Val("&H" + Left$(Src,2)) For SrcPos = 3 To Len(Src) Step 2 SrcAsc = Val("&H" + Trim(Mid$(Src,2))) If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1 TmpSrcAsc = SrcAsc Xor Asc(Mid$(Key,1)) If TmpSrcAsc <= Offset Then TmpSrcAsc = 255 + TmpSrcAsc - Offset Else TmpSrcAsc = TmpSrcAsc - Offset End If Dest = Dest + Chr(TmpSrcAsc) Offset = SrcAsc Next End If crypt = Dest Exit FunctionerrHandler: LogErrors Err.Number,Err.Description,"Module - Startup","crypt" Resume NextEnd Function

原文链接:https://www.f2er.com/vb/262547.html

猜你在找的VB相关文章