DefDbl A-Z
Dim crlf$
Dim ltrCt(26), srtCt(26), src$, sometimes$, mx, best$, abc$
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
abc$ = "abcdefghijklmnopqrstuvwxyz"
Open "un members.txt" For Input As #1
Do
Line Input #1, l$
l = RTrim(LCase(l))
For i = 1 To 26
ix = InStr(l, Mid(abc, i, 1))
If ix > 0 Then
ltrCt(i) = ltrCt(i) + 1
srtCt(i) = srtCt(i) + 1
End If
Next
Loop Until EOF(1)
Close #1
Do
done = 1
For i = 1 To 25
If srtCt(i) > srtCt(i + 1) Then
h = srtCt(i): srtCt(i) = srtCt(i + 1): srtCt(i + 1) = h
done = 0
End If
Next
Loop Until done
For i = 1 To 26
Text1.Text = Text1.Text & mform(srtCt(i), "###0")
Next
Text1.Text = Text1.Text & crlf & crlf
For i = 1 To 26
Text1.Text = Text1.Text & " " & Mid(abc, i, 1)
Next
Text1.Text = Text1.Text & crlf
For i = 1 To 26
Text1.Text = Text1.Text & mform(ltrCt(i), "###0")
Next
Text1.Text = Text1.Text & crlf & crlf
For i = 1 To 26
If ltrCt(i) > 69 Then
always$ = always$ + Mid(abc, i, 1)
ElseIf ltrCt(i) > 6 Then
sometimes$ = sometimes$ + Mid(abc, i, 1)
End If
Next
Text1.Text = Text1.Text & always & crlf & sometimes & Str(Len(sometimes)) & crlf
src$ = always
addOn 1
Text1.Text = Text1.Text & crlf & crlf & " done"
DoEvents
End Sub
Sub addOn(wh)
DoEvents
For i = wh To 18 - (4 - wh)
src = src + Mid(sometimes, i, 1)
If Len(src) = 10 Then
ct = 0
Open "un members.txt" For Input As #1
Do
Line Input #1, l$
l = RTrim(LCase(l))
good = 1
For j = 1 To Len(l)
If InStr(abc, Mid(l, j, 1)) > 0 Then
ix = InStr(src, Mid(l, j, 1))
If ix = 0 Then
good = 0
Exit For
End If
End If
Next
If good Then ct = ct + 1
Loop Until EOF(1)
Close #1
good = 1
For j = 7 To 9
If Mid(src, j, 1) > Mid(src, j + 1, 1) Then good = 0: Exit For
Next
If ct >= mx And good = 1 Then
mx = ct
best$ = src
Text1.Text = Text1.Text & mx & " " & src & crlf
If mx = 19 Then
Open "un members.txt" For Input As #1
Do
Line Input #1, l$
l = RTrim(LCase(l))
good = 1
For j = 1 To Len(l)
If InStr(abc, Mid(l, j, 1)) > 0 Then
ix = InStr(src, Mid(l, j, 1))
If ix = 0 Then
good = 0
Exit For
End If
End If
Next
If good Then Text1.Text = Text1.Text & " " & l & crlf
Loop Until EOF(1)
Close #1
Text1.Text = Text1.Text & crlf
End If
End If
ElseIf Len(src) < 10 Then
addOn wh + 1
End If
src = Left(src, Len(src) - 1)
Next
End Sub
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
The list of countries for 18 was produced by changing the 19 in the program to 18.
re: max found by computer
