VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
Caption = "Word Combination Maker"
ClientHeight = 3660
ClientLeft = 60
ClientTop = 345
ClientWidth = 9540
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3660
ScaleWidth = 9540
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame1
Caption = "Quick Reference"
Height = 3255
Left = 4920
TabIndex = 7
Top = 120
Width = 4455
Begin MSComctlLib.ListView ListView1
Height = 2895
Left = 120
TabIndex = 8
Top = 240
Width = 4215
_ExtentX = 7435
_ExtentY = 5106
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 0
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "# of words"
Object.Width = 1676
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "# of combinations"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "Approx. time to compute"
Object.Width = 3440
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "Approx. File Size"
Object.Width = 2540
EndProperty
End
End
Begin VB.TextBox Text2
Height = 285
Left = 240
TabIndex = 4
Text = "A B C D E F G"
Top = 360
Width = 4215
End
Begin VB.TextBox Text1
Height = 1695
Left = 233
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 1080
Width = 4215
End
Begin VB.CommandButton Command2
Caption = "E&xit"
Default = -1 'True
Height = 375
Left = 2400
TabIndex = 0
Top = 2880
Width = 1935
End
Begin VB.CommandButton Command1
Caption = "&Go"
Height = 375
Left = 360
TabIndex = 1
Top = 2880
Width = 1935
End
Begin VB.Line Line1
X1 = 4680
X2 = 4680
Y1 = 120
Y2 = 3360
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Possible combinations of those words are:"
Height = 195
Left = 240
TabIndex = 6
Top = 840
Width = 2955
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Enter some words here (seperated by spaces):"
Height = 195
Left = 240
TabIndex = 5
Top = 120
Width = 3270
End
Begin VB.Label Label1
AutoSize = -1 'True
Height = 195
Left = 720
TabIndex = 3
Top = 3360
Width = 3405
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'The timeGetTime function retrieves the system time, in milliseconds. The system time is the time elapsed since Windows was started.
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
'The timeBeginPeriod function sets the minimum timer resolution for an application or device driver.
Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
'The timeEndPeriod function clears a previously set minimum timer resolution.
Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
'Generates all possible combinations from a series of words
Public Function PermutateString(ByVal input_string As String, Optional Base As String = "") As String
Dim i As Long
Dim TmpStrArray() As String
'If there's only 1 element, then
If InStr(1, input_string, " ", vbTextCompare) = 0 Then
PermutateString = Base & " " & input_string & vbCrLf
Exit Function
End If
'If more than 1 element, split elements in one array of elements
TmpStrArray = Split(input_string, " ", , vbTextCompare)
If Base = "" Then
'Loop trough each element and do callbacks to permutate again
For i = LBound(TmpStrArray) To UBound(TmpStrArray)
PermutateString = PermutateString & PermutateString(ReturnAllBut(TmpStrArray, i), TmpStrArray(i))
Next
Else
'Loop trough each element and do callbacks to permutate again
For i = LBound(TmpStrArray) To UBound(TmpStrArray)
PermutateString = PermutateString & PermutateString(ReturnAllBut(TmpStrArray, i), Base & " " & TmpStrArray(i))
Next
End If
End Function
'Return all items in a array but 1
Public Function ReturnAllBut(ByRef strArray() As String, But As Long) As String
Dim i As Long
For i = LBound(strArray) To UBound(strArray)
If i <> But Then
ReturnAllBut = ReturnAllBut & strArray(i) & " "
End If
Next
ReturnAllBut = RTrim(ReturnAllBut)
End Function
Private Sub Command1_Click()
Dim startTime As Long
Dim NumberOfElements As Integer ' Used to hold number of elements
Dim NumberOfCombinations As Double 'used to hold number of combinations
Dim i As Long
If Len(Text2.Text) > 0 Then
NumberOfElements = UBound(Split(Text2.Text, " ", , vbTextCompare)) + 1
NumberOfCombinations = 1
For i = NumberOfElements To 1 Step -1 'determine number of possible combinations
NumberOfCombinations = NumberOfCombinations * i
Next
timeBeginPeriod 1 'change resolution of timer to 1 ms
startTime = timeGetTime ' Get start time
Text1.Text = PermutateString(Text2.Text)
Label1.Caption = "Generated " & NumberOfCombinations & " combinations in " & (timeGetTime - startTime) / 1000 & " seconds."
Label1.Left = (4900 - Label1.Width) / 2
timeEndPeriod 1 'reset timer resolution to default
Else
MsgBox "Nothing was entered.", vbExclamation + vbOKOnly
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim strArry As Variant
For i = 20 To 1 Step -1
ListView1.ListItems.Add 1, , CStr(i)
Next
strArry = Array("1", "2", "6", "24", "120", "720", "5,040", "40,320", "362,880", "3,628,800", "39,916,800", "479,001,600", "6,227,020,800", "87,178,291,200", "1,307,674,368,000", "20,922,789,888,000", "355,687,428,096,000", "6,402,373,705,728,000", "121,645,100,408,832,000", "2,432,902,008,176,640,000")
For i = 1 To 20
ListView1.ListItems.Item(i).ListSubItems.Add 1, , strArry(i - 1)
Next
strArry = Array("1ms", "1ms", "1ms", "1ms", "3ms", "18ms", "120ms", "1s", "9s", "1m 26s", "15m 50s", "3h 10m 5s", "1d 17h 11m 2s", "24d 0h 34m 34s", "360d 8h 38m 24s", "15y 290d 18h 14m 24s", "268y 197d 22h 4m 48s", "4,833y 277d 13h 26m 24s", "91,841y 163d 15h 21m 36s", "1,836,828y 352d 19h 12m 0s")
For i = 1 To 20
ListView1.ListItems.Item(i).ListSubItems.Add 2, , strArry(i - 1)
Next
strArry = Array("1 byte", "7 bytes", "35 bytes", "191 bytes", "1.17 KB", "9.13 KB", "73.8 KB", "590.63 KB", "5.19 MB", "51.91 MB", "571.01 MB", "6.69 GB", "86.99 GB", "1.19 TB", "17.84 TB", "285.44 TB", "4.74 PB", "85.23 PB", "1.58 EB", "31.65 EB")
For i = 1 To 20
ListView1.ListItems.Item(i).ListSubItems.Add 3, , strArry(i - 1)
Next
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 2 And KeyCode = 65 Then 'CTRL-A is being held down, so select all
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End If
End Sub