VB6 - Scramble Text

[CVMichael]

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

[bushmobile]

surely you'd use a Byte array here, rather than Mid-ing the string.

[CVMichael]

surely you'd use a Byte array here, rather than Mid-ing the string.
If you insist :)

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

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 Byte, RndPos As Long
Dim Data() As Byte, UB As Long

Data = StrConv(Str, vbFromUnicode)

Sk = SeekInit
UB = UBound(Data)

For K = 0 To UB
Sk = Sk + Data(K)
Next K

Rnd -1
Randomize Sk

For K = 0 To UB
RndPos = Fix((UB + 1) * Rnd)

' SWAP Chars
Tmp = Data(K)
Data(K) = Data(RndPos)
Data(RndPos) = Tmp
Next K

ScrambleString = StrConv(Data, vbUnicode)
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 Byte, RndPos As Long
Dim RndArr() As Long, Data() As Byte, UB As Long

Data = StrConv(Str, vbFromUnicode)

Sk = SeekInit
UB = UBound(Data)

For K = 0 To UB
Sk = Sk + Data(K)
Next K

Rnd -1
Randomize Sk

ReDim RndArr(UB)
For K = 0 To UB
RndArr(K) = Fix((UB + 1) * Rnd)
Next K

For K = UB To 0 Step -1
RndPos = RndArr(K)

' SWAP Chars
Tmp = Data(K)
Data(K) = Data(RndPos)
Data(RndPos) = Tmp
Next K

UnscrambleString = StrConv(Data, vbUnicode)
End Function