How to scramble characters in a string?

Question

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

txt file goes like this... headerline1 headerline2 headerline3 columnName1,columnName2...columnName7 data1 data2 data3 data4 data5 data6 data7 data1 data2 data3 data4 data5 data6 data7 data1 data2 data3 data4 data5 data6 data7 ... data1 data2 data3 data4 data5 data6 data7 (end of file) — Keyur Vaidya, Sep 29 '17 at 01:23
What is the purpose of scrambling the data? Do you need to unscramble it at some point? — oracle certified professional, Sep 29 '17 at 08:09
That is a good question, I honestly do not know the reason for scrambling the data. Was given to me as a task to complete. I did not put any raw data, or file locations as I do not know if I am authorized to do that. Thanks! — Keyur Vaidya, Sep 29 '17 at 14:00
Also, in the txt file format I commented, it didn't register the break lines I put in. So each header line is a separate line. And each data(n) is tab separated, data1-data7 repeats are all on separate "rows". Hope this helps! — Keyur Vaidya, Sep 29 '17 at 14:01
I got it fixed with the help of John below. Thank you for your help as well! — Keyur Vaidya, Sep 29 '17 at 14:05

score 2 · Accepted Answer · answered Sep 28 '17 at 22:56

2

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)

answered Sep 28 '17 at 22:56

John Coleman

51,337
7
54
119

Thanks John, worked great! I have a Subscript out of range: '[number: 1]' error. It's at line "arrFields(1) = Scramble(arrFields(1))". In the text file I write to, it wrote the first header line and then I got the error. After the first header line, it goes to the else instead of staying in the if (first 3 lines are header lines). I'm not sure why this is happening. I have updated the code for you to see. – Keyur Vaidya Sep 29 '17 at 01:17
@KeyurVaidya Perhaps the problem is that `If (UBound(arrFields) = 1)` should be replaced by `If (UBound(arrFields) <= 1)`? if the upper bound is 0 you will get that error in the else clause. – John Coleman Sep 29 '17 at 02:14
Good point! That actually did fix the issue I was having! Thanks again! – Keyur Vaidya Sep 29 '17 at 14:04

Ansgar Wiechers · Answer 2 · 2017-09-28T22:54:10.817

I'd probably do something like this:

Fill a dictionary with the characters of the string, using the character positions as keys.

s = "..."   'string to scramble

Set d = CreateObject("Scripting.Dictionary")
For n = 1 To Len(s)
    d(n) = Mid(s, n, 1)
Next

Create an array of the same size as the number of key/value pairs in the dictionary.
```
ReDim a(UBound(d.Keys))
```

Pick a random key and put the corresponding item in the next free slot of the array, then remove the key/value pair. Repeat until all characters have been moved.

Randomize
For n = 0 To UBound(a)
    keys  = d.Keys
    index = Int((UBound(keys) + 1) * Rnd)  'pick random key
    a(n)  = d(keys(index))                 'copy corresponding value to array
    d.Remove(keys(index))                  'remove key/value pair
Next

The keys array is used so that one of the remaining keys can be picked by (random) index.

Join the array back to a string:
```
scrambled = Join(a, "")
```

How to scramble characters in a string?

2 Answers2