CVMichael
Jul 6th, 2006, 09:45 PM
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 (http://www.vbforums.com/showthread.php?t=231798)
So, here's the 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: http://www.vbforums.com/showthread.php?t=415267
'
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: http://www.vbforums.com/showthread.php?t=415267
'
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
This is an example how to use the functions:
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
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 (http://www.vbforums.com/showthread.php?t=231798)
So, here's the 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: http://www.vbforums.com/showthread.php?t=415267
'
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: http://www.vbforums.com/showthread.php?t=415267
'
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
This is an example how to use the functions:
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