Dim As String dict, word, domain, result, uniqueWords, w1, w2, w3
Dim As Integer i
Dim As String filename = "unixdict.txt"
'Dim As String filename = "mit.10000.words.txt"

Function REPLACE(original As String, find As String, replaceWith As String) As String
    Dim As Integer posic
    Dim As String result = original

    Do
        posic = Instr(result, find)
        If posic = 0 Then Exit Do
        result = Left(result, posic - 1) & replaceWith & Mid(result, posic + Len(find))
    Loop

    Return result
End Function

Function isUnique(word As String) As Boolean
    Dim As Integer i, c, chars(255)

    For i = 1 To Len(word)
        c = Asc(Mid(word, i, 1))
        If chars(c) Then Return False
        chars(c) = 1
    Next

    Return True
End Function

Function TALLY (Byval s As String, Byval f As String) As Integer
    Return (Len(s) - Len(REPLACE(s, f, ""))) / Len(f)
End Function

Open filename For Input As #1
dict = Input(Lof(1), #1)
Close #1

For i = 1 To Len(dict)
    If Mid(dict, i, 1) = Chr(10) Then
        If Len(word) = 3 And isUnique(word) Then domain &= word & Chr(10)
        word = ""
    Else
        word &= Mid(dict, i, 1)
    End If
Next i

For i = 1 To Len(domain)
    If Mid(domain, i, 1) = Chr(10) Then
        w2 = Right(w1, 2) & Left(w1, 1)
        w3 = Right(w2, 2) & Left(w2, 1)
        If TALLY(domain, w2 & Chr(10)) > 0 _
        And TALLY(domain, w3 & Chr(10)) > 0 _
        And TALLY(uniqueWords, w1 & Chr(10)) = 0 Then
            result &= w1 & " " & w2 & " " & w3 & Chr(10)
            uniqueWords &= w1 & Chr(10) & w2 & Chr(10) & w3 & Chr(10)
        End If
        w1 = ""
    Else
        w1 &= Mid(domain, i, 1)
    End If
Next i

Print result
Print "Total words:"; TALLY(dict, Chr(10)); ", and"; TALLY(result, Chr(10)); " are circular."

Sleep