This is an idea I got while helping for one of the threads in General VB forum.
It was asked to "jumble up messages", so I got the idea to randomly swap the letters in the string, but of course, if you use random numbers, then you have to repeate the same sequance again in order to decode.
So then I remembered I already did something simmilar
So, here's the code:
This is an example how to use the functions:VB Code:
Private Function ScrambleString(ByVal Str As String, Optional SeekInit As Long = 0) As String ' ' Made by Michael Ciurescu (CVMichael from vbforums.com) ' Original thread: [url]http://www.vbforums.com/showthread.php?t=415267[/url] ' Dim K As Long, Sk As Long, Tmp As String, RndPos As Long Sk = SeekInit For K = 1 To Len(Str) Sk = Sk + Asc(Mid$(Str, K, 1)) Next K Rnd -1 Randomize Sk For K = 1 To Len(Str) RndPos = 1 + Fix(Len(Str) * Rnd) ' SWAP Chars Tmp = Mid$(Str, K, 1) Mid$(Str, K, 1) = Mid$(Str, RndPos, 1) Mid$(Str, RndPos, 1) = Tmp Next K ScrambleString = Str End Function Private Function UnscrambleString(ByVal Str As String, Optional SeekInit As Long = 0) As String ' ' Made by Michael Ciurescu (CVMichael from vbforums.com) ' Original thread: [url]http://www.vbforums.com/showthread.php?t=415267[/url] ' Dim K As Long, Sk As Long, Tmp As String, RndPos As Long Dim RndArr() As Long Sk = SeekInit For K = 1 To Len(Str) Sk = Sk + Asc(Mid$(Str, K, 1)) Next K Rnd -1 Randomize Sk ReDim RndArr(Len(Str) - 1) For K = 1 To Len(Str) RndArr(K - 1) = 1 + Fix(Len(Str) * Rnd) Next K For K = Len(Str) To 1 Step -1 RndPos = RndArr(K - 1) ' SWAP Chars Tmp = Mid$(Str, K, 1) Mid$(Str, K, 1) = Mid$(Str, RndPos, 1) Mid$(Str, RndPos, 1) = Tmp Next K UnscrambleString = Str End Function
VB Code:
Option Explicit Private Sub Form_Load() Dim S As String S = ScrambleString("testing 1 2 3 4 5 6 7 8 9 0 hello there... blah blah") Debug.Print S S = UnscrambleString(S) Debug.Print S End Sub




Reply With Quote