VB6 - Scramble Text

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:

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

This is an example how to use the functions:

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

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

Quote:

---

Originally Posted by bushmobile

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

---

If you insist :)

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
 
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 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: [url]http://www.vbforums.com/showthread.php?t=415267[/url]
    '
 
    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