purebasic.info

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218

Error_Procedure = 0
 
 
Procedure.s ExtractRE(sRE1$, sED3$, FlagsRE, Label)
        Protected sResult$, NbFound, i, Gsub$ = Chr($25AC)
        If Not Bool(sED3$)
                Error_Procedure = 1
                ProcedureReturn "Отсутствует текст для обработки"
        EndIf
        If CreateRegularExpression(0, sRE1$, FlagsRE)
                Protected Dim asResult$(0)
                NbFound = ExtractRegularExpression(0, sED3$, asResult$())
                For i = 0 To NbFound-1
                        If Label
                                sResult$ + Gsub$ + " " + Str(i) + " " + asResult$(i) + #CRLF$
                        Else
                                sResult$ + asResult$(i) + #CRLF$
                        EndIf
                Next
        Else
                Error_Procedure = 1
                ProcedureReturn RegularExpressionError()
        EndIf
        ProcedureReturn sResult$
EndProcedure
 
Procedure.s SearchRE(sRE1$, sED3$, FlagsRE)
        Protected sResult$
        If Not Bool(sED3$)
                Error_Procedure = 1
                ProcedureReturn "Отсутствует текст для обработки"
        EndIf
        If CreateRegularExpression(0, sRE1$, FlagsRE)
                If MatchRegularExpression(0, sED3$)
                        sResult$ = "Найдено"
                Else
                        sResult$ = "Не найдено."
                EndIf
        Else
                Error_Procedure = 1
                ProcedureReturn RegularExpressionError()
        EndIf
        ProcedureReturn sResult$
EndProcedure
 
Procedure.s StepRE(sRE1$, sED3$, FlagsRE, Label)
        Protected sResult$, Gsub$ = Chr($25AC), i
        If Not Bool(sED3$)
                Error_Procedure = 1
                ProcedureReturn "Отсутствует текст для обработки"
        EndIf
        If CreateRegularExpression(0, sRE1$, FlagsRE)
                If ExamineRegularExpression(0, sED3$)
                        While NextRegularExpressionMatch(0)
                                If Label
                                        i+1
                                        sResult$ + Gsub$ + " " + Str(i) + " " + Gsub$ + " " + Str(RegularExpressionMatchPosition(0)) + " : " + Str(RegularExpressionMatchLength(0)) + " : " + RegularExpressionMatchString(0) + #CRLF$
                                Else
                                        sResult$ + Str(RegularExpressionMatchPosition(0)) + " : " + Str(RegularExpressionMatchLength(0)) + " : " + RegularExpressionMatchString(0) + #CRLF$
                                EndIf
                        Wend
                EndIf
        Else
                Error_Procedure = 1
                ProcedureReturn RegularExpressionError()
        EndIf
;       SetClipboardText(sResult$)
        ProcedureReturn sResult$
EndProcedure
 
Procedure.s GroupsRE(sRE1$, sED3$, FlagsRE, Label)
        Protected sResult$, Groups, i, d, Groot$, Gsub$ = Chr($25AC)
        If Not Bool(sED3$)
                Error_Procedure = 1
                ProcedureReturn "Отсутствует текст для обработки"
        EndIf
        If CreateRegularExpression(0, sRE1$, FlagsRE)
                Groups = CountRegularExpressionGroups(0)
                If Not Groups
                        Error_Procedure = 1
                        ProcedureReturn "Нет групп, выделите группы скобками в регулярном выражении"
                EndIf
                Groot$ = LSet("" , 10, Gsub$)
                If ExamineRegularExpression(0, sED3$)
                        While NextRegularExpressionMatch(0)
                                If Label
                                        d+1
                                        sResult$ + Str(d) + " " + Groot$ + #CRLF$
                                EndIf
                                For i = 1 To Groups
                                        If Label
                                                sResult$ + Gsub$ + Gsub$ + " " + Str(i) + " " + Gsub$ + " " + RegularExpressionGroup(0, i) + #CRLF$
                                        Else
                                                sResult$ + RegularExpressionGroup(0, i) + #CRLF$
                                        EndIf
                                Next
                        Wend
                EndIf
        Else
                Error_Procedure = 1
                ProcedureReturn RegularExpressionError()
        EndIf
        ProcedureReturn sResult$
EndProcedure
 
Procedure.s ReplaceRE(sRE1$, sED3$, sRP2$, FlagsRE)
        If Not Bool(sED3$)
                Error_Procedure = 1
                ProcedureReturn "Отсутствует текст для обработки"
        EndIf
        If CreateRegularExpression(0, sRE1$, FlagsRE)
                ProcedureReturn ReplaceRegularExpression(0, sED3$, sRP2$)
        Else
                Error_Procedure = 1
                ProcedureReturn RegularExpressionError()
        EndIf
EndProcedure
 
 
 
If OpenWindow(0, 0, 0, 850, 503, "Тест регулярных выражений", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
        StringGadget(1 , 10, 22, 610, 22 , "(\w+?)(\$)")
        StringGadget(2 , 10, 65, 640, 22 , "")
        EditorGadget(3, 10, 105, 640, 180)
        SetGadgetText(3 , "Тестовый текст sRE1$, sED3$, sRP2$ , Text$)") ; Тестовый текст, временная вставка
        EditorGadget(4, 10, 306, 640, 180)
        ButtonGadget(5, 700, 430, 70, 35, "Старт")
        
        OptionGadget(6, 680, 300, 120, 20, "Поиск")
        OptionGadget(7, 680, 320, 120, 20, "Замена")
        OptionGadget(8, 680, 340, 120, 20, "Массив")
        OptionGadget(9, 680, 360, 120, 20, "Группы")
        OptionGadget(10, 680, 380, 120, 20, "Пошаговый")
        SetGadgetState(8, 1)
        GadgetToolTip(6, "До первого совпадения")
        GadgetToolTip(7, "Замена всех вхождений")
        GadgetToolTip(8, "Все полные вхождения")
        GadgetToolTip(9, "То что в скобках")
        GadgetToolTip(10, "Ещё позиция и длина")
        
        CheckBoxGadget(11, 660, 10, 180, 20, "(?s) точка всё")
        CheckBoxGadget(12, 660, 30, 180, 20, "(?x) игнор пробелов и коммент.")
        CheckBoxGadget(13, 660, 50, 180, 20, "(?m) многостроч. текст (^...$)")
        CheckBoxGadget(14, 660, 70, 180, 20, "Любой из CR, LF, и CRLF")
        CheckBoxGadget(15, 660, 90, 180, 20, "(?i) не учитывать регистр")
        SetGadgetState(11, 1)
        SetGadgetState(14, 1)
        SetGadgetState(15, 1)
        GadgetToolTip(11, "Точка включает в себя ещё и LF")
        GadgetToolTip(14, "Разделение строк может быть любым из этих сиволов")
        
        TextGadget(16, 10, 4, 250, 14, "Регулярное выражения для поиска")
        TextGadget(17, 10, 50, 250, 14, "Текст замены")
        TextGadget(18, 10, 90, 250, 14, "Текст для обработки")
        TextGadget(19, 10, 290, 250, 14, "Результаты обработки")
        
        
        CheckBoxGadget(20, 660, 400, 180, 20, "С разметкой")
        GadgetToolTip(20, "Помечает начало, полезно для многострочных")
        HyperLinkGadget(21, 710, 210, 60, 30, "Справка", RGB(0, 155,255), #PB_HyperLink_Underline)
        
        
        Repeat
                Select WaitWindowEvent()
                        Case #PB_Event_Gadget
                                Select EventGadget()
                                        Case 21
                                                RunProgram("http://forum.ru-board.com/topic.cgi?forum=33&topic=0472&start=0&limit=1&m=2#1")
                                        Case 5
                                                ClearGadgetItems(4) ; SetGadgetText иногда не заменяет текст, пришлось очищать
                                                FlagsRE = 0
                                                If GetGadgetState(11)
                                                        FlagsRE | #PB_RegularExpression_DotAll
                                                EndIf
                                                If GetGadgetState(12)
                                                        FlagsRE | #PB_RegularExpression_Extended
                                                EndIf
                                                If GetGadgetState(13)
                                                        FlagsRE | #PB_RegularExpression_MultiLine
                                                EndIf
                                                If GetGadgetState(14)
                                                        FlagsRE | #PB_RegularExpression_AnyNewLine
                                                EndIf
                                                If GetGadgetState(15)
                                                        FlagsRE | #PB_RegularExpression_NoCase
                                                EndIf
                                                Label = 0
                                                If GetGadgetState(20)
                                                        Label = 1
                                                EndIf
                                                
                                                Select 1
                                                        Case GetGadgetState(6)
                                                                sResult$ = SearchRE(GetGadgetText(1), GetGadgetText(3), FlagsRE)
                                                                SetGadgetText(4, sResult$)
                                                        Case GetGadgetState(7)
                                                                sResult$ = ReplaceRE(GetGadgetText(1), GetGadgetText(3), GetGadgetText(2), FlagsRE)
                                                                SetGadgetText(4, sResult$)
                                                        Case GetGadgetState(8)
                                                                sResult$ = ExtractRE(GetGadgetText(1), GetGadgetText(3), FlagsRE, Label)
                                                                SetGadgetText(4, sResult$)
                                                        Case GetGadgetState(9)
                                                                sResult$ = GroupsRE(GetGadgetText(1), GetGadgetText(3), FlagsRE, Label)
                                                                SetGadgetText(4, sResult$)
                                                        Case GetGadgetState(10)
                                                                sResult$ = StepRE(GetGadgetText(1), GetGadgetText(3), FlagsRE, Label)
                                                                SetGadgetText(4, sResult$)
                                                EndSelect
                                                FreeRegularExpression(#PB_All)
                                EndSelect
                        Case #PB_Event_CloseWindow
                                CloseWindow(0)
                                FreeRegularExpression(#PB_All)
                                End
                EndSelect
        ForEver
        
EndIf