1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
| Dim Arr(10000, 10000) As String
Dim ArrMax(10000) As Integer
Dim N As Integer
Dim max As Integer 'Длина слова
Dim str1 As String, str2 As String 'Исходная строка, набор букв
Function pastSymbol(str As String, symbol As String, position As Integer) As String
Dim tmp As String
tmp = Mid(str, 1, position - 1)
tmp = tmp + symbol
tmp = tmp + Mid(str, position, Len(str) - position + 1)
pastSymbol = tmp
End Function
Sub rec(k As Integer, str As String)
Dim i As Integer, j As Integer
Dim tmp As String
Dim sym As String
sym = Mid(str2, k + 1, 1)
For j = 1 To Len(str) + 1
tmp = pastSymbol(str, sym, j)
N = N + 1
List1.AddItem (CStr(N) + ")" + tmp)
If tmp = str1 Then Label1.Caption = Label1.Caption + "Слово найдено на " + CStr(N) + "шаге" + vbCrLf
If Len(tmp) < max Then Call rec(k + 1, tmp)
Next
End Sub
Sub recShir(k As Integer, str As String)
Dim i As Integer, j As Integer
Dim tmp As String
Dim sym As String
For i = 1 To ArrMax(k)
sym = Mid(str2, k + 1, 1)
For j = 1 To Len(str) + 1
tmp = pastSymbol(Arr(k, i), sym, j)
N = N + 1
List1.AddItem (CStr(N) + ")" + tmp)
Arr(k + 1, (i - 1) * (k + 1) + j) = tmp
If tmp = str1 Then Label1.Caption = Label1.Caption + "Слово найдено на " + CStr(N) + "шаге" + vbCrLf
Next
Next
ArrMax(k + 1) = (k + 1) * ArrMax(k)
If Len(tmp) < max Then Call recShir(k + 1, tmp)
End Sub
Private Sub Command1_Cglick()
End Sub
Private Sub Command1_Click()
List1.Clear
N = 0
Label1.Caption = ""
str1 = CStr(Text1.Text)
str2 = CStr(Text2.Text)
max = Len(str1)
Call rec(1, Mid(str2, 1, 1))
End Sub
Private Sub Command2_Click()
List1.Clear
N = 0
Label1.Caption = ""
str1 = CStr(Text1.Text)
str2 = CStr(Text2.Text)
max = Len(str1)
Arr(1, 1) = Mid(str2, 1, 1)
ArrMax(1) = 1
Call recShir(1, Mid(str2, 1, 1))
End Sub
Private Sub Form_Load()
N = 0
End Sub |