работа с текстом

@Digit · Регистрация: 23.09.2010

Студворк — интернет-сервис помощи студентам

Не подскажите примеры работы с текстом (поиск слова, выделение, сравнение со словарем).

@Mawrat · 23.09.2010, 11:12

Выделение из текста слов, предложений, поиск подстроки в строке - предлагаю такие варианты решения:

Delphi
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
type
  //Множество разделителей.
  TD = set of Char;
  //Массив строк.
  TArrStr = array of String;
 
//Выделение частей из текста.
//Возвращает динамический массив, содержащий все части, присутствующие
//в тексте aStr.
//"Часть" - это часть строки (или вся строка), обрамлённая любым из символов
//множества aD, а также началом или (и) концом исходной строки.
//При этом сами обрамляющие символы aD в "часть" не входят.
function GetParts(const aStr : String; const aD : TD) : TArrStr;
const
  //Величина приращения длины динамического массива.
  Capacity = 10;
var
  //i - индекс символа в строке, j - индекс элемента массива,
  //Pos1, Pos2 - координаты слова в строке,
  //Len - длина строки aStr.
  i, j, Pos1, Pos2, Len : Integer;
begin
  SetLength(Result, 0);
  Len := Length(aStr);
  Pos1 := 0;
  Pos2 := 0;
  j := 0;
  for i := 1 to Len do begin
    //Если очередной символ является разделителем - пропускаем его.
    if aStr[i] in aD then Continue;
    //Отслеживаем начало части.
    if i = 1 then
      Pos1 := i
    else if aStr[i - 1] in aD then
      Pos1 := i
    ;
    //Отслеживаем конец части.
    if i = Length(aStr) then
      Pos2 := i
    else if aStr[i + 1] in aD then
      Pos2 := i
    ;
    //Если конец части найден - обрабатываем её.
    if Pos2 > 0 then begin
      //Наращиваем длину массива, если требуется.
      if j = Length(Result) then SetLength(Result, j + Capacity);
      //Добавляем найденную часть в массив.
      Result[j] := Copy(aStr, Pos1, Pos2 - Pos1 + 1);
      //Индекс следующего элементa массива.
      Inc(j);
      //Сбрасываем флаг-координату конца слова.
      Pos2 := 0;
    end;
  end;
  //Устанавливаем длину массива равной количеству добавленных в массив элементов.
  if Length(Result) > j then SetLength(Result, j);
end;
 
//Выделение слов из текста.
//Возвращает динамический массив, содержащий все слова, присутствующие
//в тексте aStr.
function GetWords(const aStr : String) : TArrStr;
const
  //Множество разделителей слов.
  D = [' ', '.', ',', ':', ';', '!', '?', #9, #10, #13];
begin
  Result := GetParts(aStr, D);
end;
 
//Выделение предложений из текста.
//Возвращает динамический массив, содержащий все предложения, присутствующие
//в тексте aStr.
function GetOffers(const aStr : String) : TArrStr;
const
  //Множество разделителей предложений.
  D = ['.', '!', '?'];
begin
  Result := GetParts(aStr, D);
end;
 
//Поиск подстроки в тексте.
//Возвращает позицию первого символа подстроки в исходной строке.
//Если подстрока не найдена, возвращает ноль.
//aStr - строка в которой производится поиск.
//aStrF - искомая подстрока.
function StrFind(const aStr, aStrF : String) : Integer;
var
  i, j, Len1, Len2 : Integer;
begin
  Result := 0;
  if (aStr = '') or (aStrF = '') then Exit;
  Len1 := Length(aStr);
  Len2 := Length(aStrF);
  if Len2 > Len1 then Exit;
 
  for i := 1 to Len1 - Len2 + 1 do begin
    for j := 1 to Len2 do begin
      if aStr[i + j - 1] <> aStrF[j] then Break
    end;
    if j > Len2 then begin
      Result := i;
      Break;
    end;
  end;
end;
 
type
  TPos = 1..High(Integer);
 
//Поиск подстроки, начиная с позиции aPos.
function StrFindEx(const aStr, aStrF : String; const aPos : TPos) : Integer;
var
  i, j, Len1, Len2 : Integer;
begin
  Result := 0;
  if (aStr = '') or (aStrF = '') then Exit;
  Len1 := Length(aStr);
  Len2 := Length(aStrF);
  if Len2 > (Len1 + aPos - 1) then Exit;
 
  for i := aPos to Len1 - Len2 + 1 do begin
    for j := 1 to Len2 do begin
      if aStr[i + j - 1] <> aStrF[j] then Break
    end;
    if j > Len2 then begin
      Result := i;
      Break;
    end;
  end;
end;

Код скоростной. Эти каркасы можно расширять - например, добавить в поиск переключатель зависимости/независимости от регистра букв и пр.
Кроме этого, процедуры поиска можно ускорить, если выполнять сначала поиск первого символа подстроки, а затем, если этот символ найден, выполнять проверку на совпадение всех остальных букв искомой подстроки.
---
Для поиска подстроки в строке есть стандартные функции: Pos() и PosEx(). Чтобы использовать функцию PosEx(), надо подключить модуль StrUtils. Этот модуль содержит множество других полезных процедур. Чтобы найти описание, надо в справочной системе Delphi на закладке "Предметный указатель" ввести: "StrUtils routines".

@Digit · 23.09.2010, 17:30 **[ТС]**

спасибо, попробую

может кто подскажет, как подобный алгоритм преобразовать в компонент?

Добавлено через 2 часа 9 минут
нашел такой пример

Delphi
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
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Разбивка строки на отдельные слова
 
function StringToWords(const DelimitedText: string; ResultList: TStrings;
Delimiters: TDelimiter = []): boolean - разбивает отдельную строку на
состовляющие ее слова и результат помещает в TStringList
 
function StringsToWords(const DelimitedStrings: TStrings; ResultList: TStrings;
Delimiters: TDelimiter = []): boolean - разбивает любое количество строк на
состовляющие их слова и все помещяет в один TStringList
 
Delimiters - список символов являющихся разделителями слов,
например такие как пробел, !, ? и т.д.
 
Зависимости: Classes
Автор:       Separator, [email]separator@mail.kz[/email], Алматы
Copyright:   Separator
Дата:        13 ноября 2002 г.
***************************************************** }
 
unit spUtils;
 
interface
 
uses Classes;
 
type
  TDelimiter = set of #0..'я' ;
 
const
  StandartDelimiters: TDelimiter = [' ', '!', '@', '(', ')', '-', '|', '\', ';',
    ':', '"', '/', '?', '.', '>', ',', '<'];
 
  //Преобразование в набор слов
function StringToWords(const DelimitedText: string; ResultList: TStrings;
  Delimiters: TDelimiter = []; ListClear: boolean = true): boolean;
 
function StringsToWords(const DelimitedStrings: TStrings; ResultList: TStrings;
  Delimiters: TDelimiter = []; ListClear: boolean = true): boolean;
 
implementation
 
function StringToWords(const DelimitedText: string; ResultList: TStrings;
  Delimiters: TDelimiter = []; ListClear: boolean = true): boolean;
var
  i, Len, Prev: word;
  TempList: TStringList;
 
begin
  Result := false;
  if (ResultList <> nil) and (DelimitedText <> '') then
  try
    TempList := TStringList.Create;
    if Delimiters = [] then
      Delimiters := StandartDelimiters;
    Len := 1;
    Prev := 0;
    for i := 1 to Length(DelimitedText) do
    begin
      if Prev <> 0 then
      begin
        if DelimitedText[i] in Delimiters then
        begin
          if Len = 0 then
            Prev := i + 1
          else
          begin
            TempList.Add(copy(DelimitedText, Prev, Len));
            Len := 0;
            Prev := i + 1
          end
        end
        else
          Inc(Len)
      end
      else if not (DelimitedText[i] in Delimiters) then
        Prev := i
    end;
    if Len > 0 then
      TempList.Add(copy(DelimitedText, Prev, Len));
    if TempList.Count > 0 then
    begin
      if ListClear then
        ResultList.Assign(TempList)
      else
        ResultList.AddStrings(TempList);
      Result := true
    end;
  finally
    TempList.Free
  end
end;
 
function StringsToWords(const DelimitedStrings: TStrings; ResultList: TStrings;
  Delimiters: TDelimiter = []; ListClear: boolean = true): boolean;
begin
  if Delimiters = [] then
    Delimiters := StandartDelimiters + [#13, #10]
  else
    Delimiters := Delimiters + [#13, #10];
  Result := StringToWords(DelimitedStrings.Text, ResultList, Delimiters,
    ListClear)
end;
 
end.
 
//Пример использования: 
//StringToWords(Edit1.Text, Memo1.Lines);
//StringToWords(Edit1.Text, Memo1.Lines, [' ', '.', ',']);
//StringsToWords(Memo1.Lines, Memo2.Lines);
//StringsToWords(Memo1.Lines, Memo2.Lines, [' ', '.', ',']);

частично покрывает необходимые мне функции

@Mawrat · 23.09.2010, 21:28

Если требуется передавать результаты в объект, тип которого является потомком TStrings, то можно использовать мой вариант кода с небольшими доработками. Вот например, как это можно сделать (весьма элегантно получилось, на мой взгляд.

) :

Delphi
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
type
  //Множество разделителей.
  TD = set of Char;
  //Массив строк.
  TArrStr = array of String;
 
//Выделение частей из текста.
//Возвращает динамический массив, содержащий все части, присутствующие
//в тексте aStr.
//"Часть" - это часть строки (или вся строка), обрамлённая любым из символов
//множества aD, а также началом или (и) концом исходной строки.
//При этом сами обрамляющие символы aD в "часть" не входят.
function GetArrParts(const aStr : String; const aD : TD) : TArrStr;
const
  //Величина приращения длины динамического массива.
  Capacity = 10;
var
  //i - индекс символа в строке, j - индекс элемента массива,
  //Pos1, Pos2 - координаты слова в строке,
  //Len - длина строки aStr.
  i, j, Pos1, Pos2, Len : Integer;
begin
  SetLength(Result, 0);
  Len := Length(aStr);
  Pos1 := 0;
  Pos2 := 0;
  j := 0;
  for i := 1 to Len do begin
    //Если очередной символ является разделителем - пропускаем его.
    if aStr[i] in aD then Continue;
    //Отслеживаем начало части.
    if i = 1 then
      Pos1 := i
    else if aStr[i - 1] in aD then
      Pos1 := i
    ;
    //Отслеживаем конец части.
    if i = Length(aStr) then
      Pos2 := i
    else if aStr[i + 1] in aD then
      Pos2 := i
    ;
    //Если конец части найден - обрабатываем её.
    if Pos2 > 0 then begin
      //Наращиваем длину массива, если требуется.
      if j = Length(Result) then SetLength(Result, j + Capacity);
      //Добавляем найденную часть в массив.
      Result[j] := Copy(aStr, Pos1, Pos2 - Pos1 + 1);
      //Индекс следующего элементa массива.
      Inc(j);
      //Сбрасываем флаг-координату конца слова.
      Pos2 := 0;
    end;
  end;
  //Устанавливаем длину массива равной количеству добавленных в массив элементов.
  if Length(Result) > j then SetLength(Result, j);
end;
 
//Выделение частей из текста.
//Все найденные в тексте aStr части добавляет в контейнер
//типа TStrings в виде отдельных строк.
procedure GetStringsParts(const aStr : String;  const aD : TD; aStrings : TStrings);
var
  Arr : TArrStr;
  i : Integer;
begin
  Arr := GetArrParts(aStr, aD);
  for i := 0 to High(Arr) do begin
    aStrings.Add( Arr[i] );
  end;
  Finalize(Arr);
end;
 
//**************************************************
//Выделение слов из текста.
//**************************************************
 
//Выделение слов из текста.
//Возвращает динамический массив, содержащий все слова, присутствующие
//в тексте aStr.
function GetArrWords(const aStr : String) : TArrStr;
const
  //Множество разделителей слов.
  D = [' ', '.', ',', ':', ';', '!', '?', #9, #10, #13];
begin
  Result := GetArrParts(aStr, D);
end;
 
//Выделение слов из текста.
//Все найденные в тексте aStr слова добавляет в контейнер
//типа TStrings в виде отдельных строк.
procedure GetStringsWords(const aStr : String; aStrings : TStrings);
const
  //Множество разделителей слов.
  D = [' ', '.', ',', ':', ';', '!', '?', #9, #10, #13];
begin
  GetStringsParts(aStr, D, aStrings);
end;
 
//**************************************************
//Выделение предложений из текста.
//**************************************************
 
//Выделение предложений из текста.
//Возвращает динамический массив, содержащий все предложения, присутствующие
//в тексте aStr.
function GetArrOffers(const aStr : String) : TArrStr;
const
  //Множество разделителей предложений.
  D = ['.', '!', '?'];
begin
  Result := GetArrParts(aStr, D);
end;
 
//Выделение предложений из текста.
//Все найденные в тексте aStr предложения добавляет в контейнер
//типа TStrings в виде отдельных строк.
procedure GetStringsOffers(const aStr : String; aStrings : TStrings);
const
  //Множество разделителей предложений.
  D = ['.', '!', '?'];
begin
  GetStringsParts(aStr, D, aStrings);
end;
 
//**************************************************
//Поиск подстрок в тексте.
//**************************************************
 
//Поиск подстроки в тексте.
//Возвращает позицию первого символа подстроки в исходной строке.
//Если подстрока не найдена, возвращает ноль.
//aStr - строка в которой производится поиск.
//aStrF - искомая подстрока.
function StrFind(const aStr, aStrF : String) : Integer;
var
  i, j, Len1, Len2 : Integer;
begin
  Result := 0;
  if (aStr = '') or (aStrF = '') then Exit;
  Len1 := Length(aStr);
  Len2 := Length(aStrF);
  if Len2 > Len1 then Exit;
 
  for i := 1 to Len1 - Len2 + 1 do begin
    for j := 1 to Len2 do begin
      if aStr[i + j - 1] <> aStrF[j] then Break
    end;
    if j > Len2 then begin
      Result := i;
      Break;
    end;
  end;
end;
 
//Поиск подстроки, начиная с позиции aPos.
function StrFindEx(const aStr, aStrF : String; const aPos : Integer) : Integer;
var
  i, j, Len1, Len2 : Integer;
begin
  Result := 0;
  if (aStr = '') or (aStrF = '') or (aPos < 1) then Exit;
  Len1 := Length(aStr);
  Len2 := Length(aStrF);
  if Len2 > (Len1 + aPos - 1) then Exit;
 
  for i := aPos to Len1 - Len2 + 1 do begin
    for j := 1 to Len2 do begin
      if aStr[i + j - 1] <> aStrF[j] then Break
    end;
    if j > Len2 then begin
      Result := i;
      Break;
    end;
  end;
end;

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++ 8Observer8 17.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip	Символические и жёсткие ссылки в Linux. algri14 15.03.2026 Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .	[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ФедосеевПавел 14.03.2026 Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .	делаю науч статью по влиянию грибов на сукцессию anaschu 13.03.2026 прикрепляю статью
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .	Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .

@Digit 1 / 1 / 0 Регистрация: 23.09.2010 Сообщений: 12

	работа с текстом 23.09.2010, 05:46. Показов 2411. Ответов 3 Метки нет (Все метки) Не подскажите примеры работы с текстом (поиск слова, выделение, сравнение со словарем). 0