VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Permutations 
   Caption         =   "Permutation Generator"
   ClientHeight    =   6135
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6840
   LinkTopic       =   "Form1"
   ScaleHeight     =   6135
   ScaleWidth      =   6840
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command2 
      Caption         =   "Clipboard"
      Height          =   255
      Left            =   5520
      TabIndex        =   8
      Top             =   360
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "File"
      Height          =   255
      Left            =   5520
      TabIndex        =   7
      Top             =   720
      Width           =   1095
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Remove Duplicates"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   840
      Value           =   1  'Checked
      Width           =   1815
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   5640
      Width           =   4335
      _ExtentX        =   7646
      _ExtentY        =   661
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.ListBox List1 
      Height          =   4350
      Left            =   120
      TabIndex        =   2
      Top             =   1200
      Width           =   6615
   End
   Begin VB.CommandButton bStart 
      Caption         =   "Calculate Permutations"
      Height          =   255
      Left            =   1200
      TabIndex        =   1
      Top             =   480
      Width           =   1935
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   120
      MaxLength       =   7
      TabIndex        =   0
      Top             =   480
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "Save Options"
      Height          =   975
      Left            =   5400
      TabIndex        =   9
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "Enter 2 to 7 Digits or Characters"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   2295
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Total Permutations:"
      Height          =   195
      Left            =   4560
      TabIndex        =   3
      Top             =   5640
      Width           =   1365
   End
End
Attribute VB_Name = "Permutations"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************
'* Permutations : Jaafar Bin Yusof *
'* email : jaafar1_2001@yahoo.com  *
'***********************************
Public i, j, x, mx, pass, temp, newnum
Public TextPos1, TextPos4, TextPos5, TextPos6
Public forth, fifth, sixth, seven
Public found As Boolean

Private Sub bStart_Click()
Dim numarr() As String
    'error trap if text is null
    If Text1.Text = "" Then
    MsgBox "You must enter at least (2) valid numbers or characters.", vbCritical, "User Defined Error"
    Exit Sub
    End If
    If Text1.Text = " " Then
    MsgBox "You must enter at least (2) valid numbers or characters.", vbCritical, "User Defined Error"
    Exit Sub
    End If
    If Text1.Text = "  " Then
    MsgBox "You must enter at least (2) valid numbers or characters.", vbCritical, "User Defined Error"
    Exit Sub
    End If
    If Text1.Text = "   " Then
    MsgBox "You must enter at least (2) valid numbers or characters.", vbCritical, "User Defined Error"
    Exit Sub
    End If
    If Text1.Text = "    " Then
    MsgBox "You must enter at least (2) valid numbers or characters.", vbCritical, "User Defined Error"
    Exit Sub
    End If
    If Text1.Text = "     " Then
    MsgBox "You must enter at least (2) valid numbers or characters.", vbCritical, "User Defined Error"
    Exit Sub
    End If
    If Text1.Text = "      " Then
    MsgBox "You must enter at least (2) valid numbers or characters.", vbCritical, "User Defined Error"
    Exit Sub
    End If
    If Text1.Text = "       " Then
    MsgBox "You must enter at least (2) valid numbers or characters.", vbCritical, "User Defined Error"
    Exit Sub
    End If
    
    'clears the listbox
    List1.Clear
    
    'set the maximum number of permutations
    mx = 1
    For i = 1 To Len(Text1.Text)
        mx = mx * i
    Next i
    ProgressBar1.Max = mx
    
    'get the main number position to num array for permute
    ReDim num(Len(Text1.Text))
    For i = 1 To Len(Text1.Text)
        num(i) = Mid(Text1.Text, i, 1)
    Next i
    
    'set the swap for first loop to the first digit...
    'it will not be less than 2 after the first loop
    j = 1
    
    'set OUTTER swap with INNER for more than 3 digits
    forth = 4
    fifth = 5
    sixth = 6
    seven = 7
    
    'initialise the number of passes
    pass = 0
    
    'get the original text
    TextPos1 = Text1.Text
    TextPos4 = Text1.Text
    TextPos5 = Text1.Text
    TextPos6 = Text1.Text
    
    'start permutations
    For i = 1 To mx
        'swap the text in num array
        temp = num(1)
        num(1) = num(j)
        num(j) = temp
        
        'increase the inner j position to not less than 2 and not more than 3
        j = j + 1
        If j > 3 Then j = 2
        
        'increase the pass : keeps track for more than 3 digits.
        pass = pass + 1
        
        If pass > 6 Then
            '3 digits is only 6 combinations, so on the 7th, pass will be back to 1
            pass = 1
            j = 2 'reset to the second digit for next swap
            
            For x = 1 To Len(TextPos1)
                num(x) = Mid(TextPos1, x, 1)
            Next x
            
            'will be 3..2..1..0 position swap with 4th position
            forth = forth - 1
            temp = num(forth)
            num(forth) = num(4)
            num(4) = temp
            
            If forth = 0 Then
                forth = 4
                TextPos1 = TextPos4
                For x = 1 To Len(TextPos1)
                    num(x) = Mid(TextPos1, x, 1)
                Next x
                
                'will be 4..3..2..1..0 position swap with 5th position
                fifth = fifth - 1
                temp = num(fifth)
                num(fifth) = num(5)
                num(5) = temp
                
                If fifth = 0 Then
                    fifth = 5
                    TextPos1 = TextPos5
                    For x = 1 To Len(TextPos5)
                        num(x) = Mid(TextPos5, x, 1)
                    Next x
                    
                    'will be 5..4..3..2..1..0 position swap with 6th position
                    sixth = sixth - 1
                    temp = num(sixth)
                    num(sixth) = num(6)
                    num(6) = temp
                    
                    If sixth = 0 Then
                        sixth = 6
                        TextPos1 = TextPos6
                        For x = 1 To Len(TextPos6)
                            num(x) = Mid(TextPos6, x, 1)
                        Next x
                    
                        'will be 6..5..4..3..2..1..0 position swap with 7th position
                        seven = seven - 1
                        temp = num(seven)
                        num(seven) = num(7)
                        num(7) = temp
                        
                        newnum = ""
                        For x = 1 To Len(TextPos1)
                            newnum = newnum & num(x)
                        Next x
                        TextPos6 = newnum
                    End If
                    
                    'get newnum as the main text
                    newnum = ""
                    For x = 1 To Len(TextPos1)
                        newnum = newnum & num(x)
                    Next x
                    TextPos5 = newnum
                End If
                
                'get newnum as the main text
                newnum = ""
                For x = 1 To Len(TextPos1)
                    newnum = newnum & num(x)
                Next x
                TextPos4 = newnum
            End If

            'get newnum as the main text
            newnum = ""
            For x = 1 To Len(TextPos1)
                newnum = newnum & num(x)
            Next x
            TextPos1 = newnum
        End If
        
        'get newnum as the main text
        newnum = ""
        For x = 1 To Len(TextPos1)
            newnum = newnum & num(x)
        Next x
                
        If Check1.Value = 1 Then
            If i = 1 Then 'the first number is capture in numarr(1)
                ReDim Preserve numarr(i)
                numarr(i) = newnum
            Else
                x = 1 'start of array to be check for duplicates
                found = False 'reset to false at first
                While Not found And x <= UBound(numarr)
                    If numarr(x) = newnum Then found = True
                    x = x + 1
                Wend
                If Not found Then
                    ReDim Preserve numarr(x)
                    numarr(x) = newnum
                End If
            End If
        Else
            ReDim Preserve numarr(i)
            numarr(i) = newnum
        End If
                
        'indicate the progress
        ProgressBar1.Value = i
    Next i

    'display the result
    List1.Clear
    ProgressBar1.Max = UBound(numarr)
    For i = 1 To UBound(numarr)
        List1.AddItem numarr(i)
        ProgressBar1.Value = i
    Next i
    
    'go to the bottom of the list
    List1.ListIndex = List1.ListCount - 1
    'List1.Selected(List1.ListCount - 1) = False
    
    'show total
    Label1.Caption = "Total Permutations: " & List1.ListCount
End Sub

Private Sub Command1_Click()
Dim i
    i = 0
    Open "permutations.txt" For Output As #1
        While i <= List1.ListCount - 1
        Print #1, List1.List(i); "-"
        i = i + 1
        Wend
        Close #1
    MsgBox "Permutations Written to:                                                                                                       " & App.Path & "\permutations.txt", vbInformation, "Permutation Output"
End Sub