Search code examples
stringrandomvbscriptscramble

How to scramble characters in a string?


I am writing a script that reads in a text file. After the header lines I read the data lines. As each data line is read in, string values in columns AssetID and Description are to be scrambled. I split each line on tab delimiter. Knowing that AssetID is in array position 1, and Description is in position 2, I can get the strings.

I would like to know a simple way to scramble the two strings. Here is some code for reference.

P.S. for now I commented to the loop out so that I could test the "scrambling" on the first header line to make sure it works before I implement it on the entire project.

Const ForReading = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("AssetImport.txt", ForReading)
Set objFile2 = objFSO.CreateTextFile("\newnewnew.txt")

Do Until objFile.AtEndOfStream
    strLine = objFile.ReadLine

    arrFields = Split(strLine, vbTab)

    If (UBound(arrFields) = 1) Then
        'script to write header lines here
        objFile2.WriteLine arrFields(0)
    Else
        'scramble AssetID and Description Columns, then write
        Randomize
        objFile2.WriteLine arrFields(0)
        arrFields(1) = Scramble(arrFields(1))
        objFile2.WriteLine arrFields(1)
        objFile2.WriteLine arrFields(2)
        objFile2.WriteLine arrFields(3)
        objFile2.WriteLine arrFields(4)
        arrFields(5) = Scramble(arrFields(5))
        objFile2.WriteLine arrFields(5)
        objFile2.WriteLine arrFields(6)
    End If
Loop

objFile.Close
objFile2.Close

Function Scramble(s)
    Dim i, j, n
    Dim temp, shuffled

    n = Len(s)
    ReDim shuffled(n - 1)
    For i = 1 To n
        shuffled(i - 1) = Mid(s, i, 1)
    Next

    For i = 0 To n - 2
        j = i + Int((n - i) * Rnd())
        temp = shuffled(i)
        shuffled(i) = shuffled(j)
        shuffled(j) = temp
    Next
    Scramble = Join(shuffled, "")

End Function


Solution

  • You can do a Fisher-Yates shuffle on the characters of the string:

    Function Scramble(s)
        'Performs a Fisher-Yates Shuffle on the characters in the string
        'Assumes that Randomize has been called
    
        Dim i, j, n
        Dim temp, shuffled
    
        n = Len(s)
        ReDim shuffled(n - 1)
        For i = 1 To n
            shuffled(i - 1) = Mid(s, i, 1)
        Next
    
        'now do Fisher-Yates:
        For i = 0 To n - 2
            j = i + Int((n - i) * Rnd())
            temp = shuffled(i)
            shuffled(i) = shuffled(j)
            shuffled(j) = temp
        Next
        Scramble = Join(shuffled, "")
    
    End Function
    
    'test script:
    
    Randomize
    s = InputBox("Enter a word to be scrabled")
    MsgBox Scramble(s)