Операции над строками

@TAVulator · Регистрация: 27.07.2009

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

В этой теме представлены реализации алгоритмов работы со строками.
Выкладывайте свои реализации на языке Pascal.

Содержание

1. Замена первого вхождения подстроки другой подстрокой

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function Replace(var S:string; s1,s2:string):byte;
{Замена первого вхождения подстроки другой подстрокой.
Replace(Строка, Подстрока, На что заменить);
Результатом функции является число - на какой
позиции в строке была найдена подстрока.
Возвращается 0, если подстрока не найдена.}
 
Begin
 if ((length(S)+length(s2)-length(s1))<=255)and
    (pos(s1,S)<>0) then
  Begin
   Replace:=pos(S,s1);
   S:=copy(S,1,pos(s1,S)-1)+s2+copy(S,pos(s1,S)+length(s1),length(S));
  End else Replace:=0;
End;

Автор: TAVulator

2. Функция удаления лишних пробелов

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function OneSpace(S:string;B:boolean):string;
{Функция удаления лишних пробелов.
OneScpace(Строка,true/false - удалять
или нет пробелы в начале и в конце строки);
Результатом функции является строка с удаленными
лишними пробелами.}
var
 T: string;
Begin
 T:=S;
 while pos('  ',T)>0 do
  delete(T,pos('  ',T),1);
 if B then
  Begin
   if T[1]=' ' then delete(T,1,1);
   if T[length(T)]=' ' then delete(T,length(T),1);
  End;
 OneSpace:=T;
End;

Автор: TAVulator

3. Функция переворачивания строки

Pascal
1
2
3
4
5
6
7
8
9
10
Function Revert(S: string):string;
var
 i: byte;
 T: string;
Begin
 T:='';
 For i:=length(S) downto 1 do
  T:=T+S[i];
 Revert:=T;
End;

Версия для Free Pascal:

Pascal
1
2
3
4
5
6
7
8
9
Function Revert(S: string):string;
{Функция переворачивания строки}
var
 i: byte;
Begin
 Revert:='';
 For i:=length(S) downto 1 do
  Revert:=Revert+S[i];
End;

Автор: TAVulator

4. Функция разбития строки на слова.
5. Функция переворачивания строки. Вариант 2.
6. Удаление двойных пробелов.
7. Удаление пробелов вначале и в конце строки.
8. Удаление повторяющихся пробелов без использования Delete
9. Замена первого вхождения слова другим словом.

10. Извлечение нужного слова из строки

Free Pascal

Pascal
1
2
3
4
5
6
7
8
9
10
Function GetWord(S: string; N: byte): String;
Var
 Str: string;
 i: byte;
Begin
 Str:=S+' ';
 For i:=1 to N-1 do
  delete(Str,1,pos(' ',Str));
 GetWord:=Copy(Str,1,Pos(' ',Str)-1);
End;

Автор: TAVulator

11. Перевод строки в биты
12. Удаление пробелов из строки
13. Выделение имени файла из полного пути
14. Набор функций для работы с путями и именами файлов и папок

@rangerx · 24.12.2010, 01:38

Функция разбития строки на слова.

Pascal
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
{Функция разбивает строку на слова и помещает их в строковый массив dest
Возвращаемое значение:  количество слов помещенных в массив.}
type DelimSet = set of char;
 
function split(var dest: array of string; const s: string; const delim: DelimSet): integer;
var
  n, i, len: integer;
begin
  n:= 0;
  i:= 1;
  len:= Length(s);
 
  while (i <= len) do begin
    if s[i] in delim then
      repeat inc(i) until (i > len) or (not (s[i] in delim))
    else begin
      dest[n]:= '';
      while (i <= len) and (not (s[i] in delim)) do begin
        dest[n]:= dest[n] + s[i];
        inc(i);
      end;
      inc(n);
    end;
  end;
  split:= n;
end;

@Inadequate · 25.12.2010, 05:41

Сообщение от TAVulator

Pascal
1
2
3
4
5
6
7
8
9
10
Function Revert(S: string):string;
var
 i: byte;
 T: string;
Begin
 T:='';
 For i:=length(S) downto 1 do
  T:=T+S[i];
 Revert:=T;
End;

Я бы написал так

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
function Reverse(s: string): string;
var
  i, sLen: byte;
  tmp: char;
begin
  sLen := Length(s);
  for i := 1 to sLen div 2 do
  begin
    tmp := s[i];
    s[i] := s[sLen - i + 1];
    s[sLen - i + 1] := tmp;
  end;
  Reverse := s;
end;

Теперь удаление двойных пробелов и удаление их вначале и в конце строки... Не хочу мешать в одну кучу, поэтому разобью на две отдельные функции

Pascal
1
2
3
4
5
6
7
8
9
function DeleteDoubleS(s: string): string;
var
  i: byte;
begin
  for i := Length(s) - 1 downto 1 do
    if (s[i] = ' ') and (s[i + 1] = ' ') then
      Delete(s, i, 1);
  DeleteDoubleS := s;
end;

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
function MyTrim(const s: string): string;
var
  i,sLen: byte;
begin
  sLen := Length(s);
  i := 1;
  while (s[i] = ' ') and (i <= sLen) do
    Inc(i);
  if i > sLen then
    MyTrim := ''
  else
  begin
    while s[sLen] = ' ' do
      Dec(sLen);
    MyTrim := Copy(s, i, sLen - i + 1);
  end;
end;

Ну и теперь функция замены слова... Вчера, видимо, сильно хотел спать, потому как не очень внимательно посмотрел эту функцию. Она работает неправильно, ну или выполняет совсем не то, что заявлено в описании. Хотя после приколов Free Pascal наверное не буду спешить с определениями. Скажем так, на ABC, TP7, Console (Delphi) будет выводить не то, что нужно. Для того, чтобы убедиться в этом достаточно попробовать заменить в строке, скажем "you need to see all" слово "ee". Если речь идет именно о замене слов, а не части строки, то я бы написал так

Pascal
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
function Replace(const s,wF,wR: string): string;
const
  Dividers = [' ', '.', ',', ':', '-', ';'];
var
  i,sLen: byte;
  tmp: string;
begin
  sLen := Length(s);
  tmp := '';
  for i := 1 to sLen do
  begin
    if not (s[i] in Dividers) then
      tmp := tmp + s[i];
    if (s[i] in Dividers) or (i = sLen) then
      if tmp = wF then
      begin
        if (i = sLen) and not (s[i] in Dividers) then
          Replace := Copy(s, 1, i - Length(wF)) + wR + Copy(s, i + 1, 255)
        else
          Replace := Copy(s, 1, i - Length(wF) - 1) + wR + Copy(s, i, 255);
        exit;
      end
      else
        tmp := '';
  end;
  Replace := s;
end;

Условие на строке 17 добавил для совместимости. Конечно можно было все лихо сделать с помощью Ord(boolean), но не везде такое прокатит. Вполне возможно, что допустил где-то ошибки, глаза уже слипаются... Буду признателен, если укажут на их присутствие.

@Somebody · 25.12.2010, 15:45

В удалении повторяющихся пробелов использование Delete неоптимально. Как вариант:
TP

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
function RemoveExtraSpaces(s: string): string;
var
  src, dst: Byte;
begin
  src := 1;
  dst := 1;
  while src <= Length(s) do
  begin
    s[dst] := s[src];
    inc(dst);
    if s[src] <> ' ' then
      inc(src)
    else
      repeat
        inc(src);
      until (src <= Length(s)) and (s[src] <> ' ');
  end;
  s[0] := Char(Byte(dst) - 1);
  RemoveExtraSpaces := s;
end;

Delphi/FP для длинных строк

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
function RemoveExtraSpaces(s: string): string;
var
  src, dst: Integer;
begin
  src := 1;
  dst := 1;
  while src <= Length(s) do
  begin
    s[dst] := s[src];
    inc(dst);
    if s[src] <> ' ' then
      inc(src)
    else
      repeat
        inc(src);
      until s[src] <> ' ';
  end;
  SetLength(s, dst - 1);
  RemoveExtraSpaces := s;
end;

@sergey93 · 07.04.2011, 19:12

Удаление пробелов из строки

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
program prob;
var
  s:string;
  i,k:integer;
begin
 readln(s);
   for i:=1 to length(s) do
     begin
      k:=pos(' ',s);
      if k>0 then delete(s,k,1)
     end;
 write(s);
end.

@TAVulator · 07.04.2011, 19:50 **[ТС]**

Сообщение от sergey93

Удаление пробелов из строки

как на счет такого варианта:

Pascal
1
2
3
4
5
6
7
8
var
 S: string;
Begin
 S:=' fgf hh yy   hy  rf g'; {строка}
 while pos(' ',S)<>0 do delete(S,pos(' ',S),1);
 writeln(S);
 readln;
end.

@S9 · 08.04.2011, 12:29

Как то писал функцию перевода строки в биты(т.е. не совсем биты, а строка состоящая из 0 и 1)
Может кому пригодится

Pascal
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
Function StrToBin(TextValue:String):String;
 
    Function DecToBin(Int:Longint):String;{Перевод из 10 системы в 2 систему}
        Var
        StringConst:String[2];
        Res:String;
    Begin
        StringConst:='01';
        Res:='';
    Repeat
        Res:=StringConst[(Int Mod 2)+1] + Res;
        Int:=Int Div 2;
    Until Int=0;
        DecToBin:=Res;
    End;
 
Var
    TempString:String;
    OctString:String;
    BinString:String;
    i,k:Integer;
Begin
    For i:=1 To Length(TextValue) Do 
Begin
    TempString:=DecToBin(Ord(TextValue[i]));
    OctString:='';
If Length(TempString)<8 Then 
    Begin
        For k:=1 To 8-Length(TempString) Do 
            Begin
            OctString:=OctString+'0';
            End;
        End;
        TempString:=OctString+TempString;
        BinString:=BinString+TempString;
        StrToBin:=BinString;
    End;
End;

@S9 · 09.04.2011, 08:43

В дополнении хотел добавить ещё одну функцию, которая выделяет из полного пути к файлу
имя файла с расширением или без него(задается в параметрах).
З.Ы.Если есть стандартные функции делающие то-же самое то просьба меня извинить, я их не знаю

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function InWayFileName(Way:String;Expansion:Boolean):String;
    Var
        Name:String;{Если Expansion = True тогда результат функции имя файла с расширением, если False то выводится}
        i,j,k:Integer;{просто имя файла(без расширения)}
    Begin
        k:=0;
        j:=0;
        Name:='';
    For i:=1 To Length(Way) Do 
        Begin{Находим последний слеш в пути}
            k:=k+1;
            If Way[i]='\' Then j:=k;
        End;
    If Expansion = True Then 
        Begin
            For i:=j+1 To Pos('.',Way)-1 Do
                Name:=Name+Way[i];
        End Else
            For i:=j+1 To Length(Way) Do
                Name:=Name+Way[i];
    InWayFileName:=Name;
End;

@SuPeR XaKer · 09.04.2011, 11:22

S9
уж больно сложно.Это и так можно сделать.

Pascal
1
2
3
4
5
6
7
8
9
10
11
Function Filename(Var str:string;f:boolean):string;
var
 s:string;
 i:byte;
begin
 for i:=length(str) downto 1 do
 if str[i]<>'\' then s:=str[i]+s
 else break;
 if f then Filename:=copy(s,1,pos('.',s)-1)
 else Filename:=s
end;

да и следует учесть то что может быть задан путь к каталогу а не к определённому файлу:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
Function Filename(Var str:string;f:boolean):string;
var
 s:string;
 i:byte;
begin
 for i:=length(str) downto 1 do
 if str[i]<>'\' then s:=str[i]+s
 else break;
 if pos('.',s)=0 then writeln('Êàòàëîãè,ôàéëà íåò')
 else if f then Filename:=copy(s,1,pos('.',s)-1)
 else Filename:=s
end;

22.06.2011, 15:04

может кто-нибудь организует все операции в процедуры? думаю будет полезным и удобным.
как вот здесь:
Сортировки

@Jaguar · 25.08.2011, 02:03

Я бы написал так

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
function Reverse(s: string): string;
var
  i, sLen: byte;
  tmp: char;
begin
  sLen := Length(s);
  for i := 1 to sLen div 2 do
  begin
    tmp := s[i];
    s[i] := s[sLen - i + 1];
    s[sLen - i + 1] := tmp;
  end;
  Reverse := s;
end;

Можно еще такс:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
function Reverse( s: string):string;
var
  i, sLen:Byte;
Begin
  sLen:=length(s);
  for i:=1 to sLen do 
begin
   Insert(s[sLen], s, i);
   Delete(s, sLen+1, sLen);
end;
 Reverse:=s;
End;

@Mawrat · 18.09.2011, 05:43

Предлагаю набор функций для работы с путями и именами файлов и папок в среде Borland и Turbo Pascal.
Выполнил в виде модуля:

Pascal
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
unit FnUtils;
 
interface
 
(*Получить полное имя файла.*)
function GetFullFileName(const aFileName : String) : String;
(*Получить имя файла с расширением без пути.*)
function GetFileName(const aFileName : String) : String;
(*Получить имя файла без пути и без расширения.*)
function GetShortFileName(const aFileName : String) : String;
(*Получить расширение файла.*)
function GetFileExt(const aFileName : String) : String;
(*Получить полный путь к папке, в которой расположен заданный файл.*)
function GetFilePath(const aFileName : String) : String;
(*Получить полное имя исполняемого файла программы.*)
function GetExeName : String;
(*Получить полный путь к папке, в которой расположен исполняемый файл программы.*)
function GetExePath : String;
 
implementation
 
uses
  Dos;
 
(*
Получить полное имя файла.
---
Пример1:
Текущая папка   = 'D:\Bp\Projects\'
aFileName       = '0001\File1.txt'
GetFullFileName = 'D:\Bp\Projects\0001\File1.txt'
---
Пример2:
Текущая папка   = 'D:\Bp\Projects\0001\'
aFileName       = '..\0002\File1.txt'
GetFullFileName = 'D:\Bp\Projects\0002\File1.txt'
---
Пример3:
aFileName       = 'D:\Bp\Projects\0001\File1.txt'
GetFullFileName = 'D:\Bp\Projects\0001\File1.txt'
*)
function GetFullFileName(const aFileName : String) : String;
begin
  GetFullFileName := FExpand(aFileName);
end;
 
(*
Получить имя файла с расширением без пути.
---
Пример1:
aFileName   = 'D:\Bp\Projects\0001\File1.txt'
GetFileName = 'File1.txt'
*)
function GetFileName(const aFileName : String) : String;
var
  (*Путь к файлу без имени самого файла.*)
  FDir : DirStr;
  (*Имя файла без пути и без расширения.*)
  FName : NameStr;
  (*Расширение файла.*)
  FExt : ExtStr;
begin
  FSplit(aFileName, FDir, FName, FExt);
  GetFileName := FName + FExt;
end;
 
(*
Получить имя файла без пути и без расширения.
---
Пример1:
aFileName        = 'D:\Bp\Projects\0001\File1.txt'
GetShortFileName = 'File1'
*)
function GetShortFileName(const aFileName : String) : String;
var
  FDir : DirStr;
  FName : NameStr;
  FExt : ExtStr;
begin
  FSplit(aFileName, FDir, FName, FExt);
  GetShortFileName := FName;
end;
 
(*Получить расширение файла.
---
Пример1:
aFileName  = 'D:\Bp\Projects\0001\File1.txt'
GetFileExt = '.txt'
---
Пример2:
aFileName  = 'File1'
GetFileExt = ''
*)
function GetFileExt(const aFileName : String) : String;
var
  FDir : DirStr;
  FName : NameStr;
  FExt : ExtStr;
begin
  FSplit(aFileName, FDir, FName, FExt);
  GetFileExt := FExt;
end;
 
(*
Получить полный путь к папке, в которой расположен заданный файл.
---
Пример1:
Текущая папка = 'D:\Bp\Projects\'
aFileName     = '0001\File1.txt'
GetFilePath   = 'D:\Bp\Projects\0001\'
---
Пример2:
Текущая папка = 'D:\Bp\Projects\0001\'
aFileName     = '..\0002\File1.txt'
GetFilePath   = 'D:\Bp\Projects\0002\'
---
Пример3:
Текущая папка - нет зависимости от текущей папки.
aFileName     = 'D:\Bp\Projects\0001\File1.txt'
GetFilePath   = 'D:\Bp\Projects\0001\'
*)
function GetFilePath(const aFileName : String) : String;
var
  (*Полное имя файла - состоит из полного пути и имени файла с расширением.*)
  FullFileName : String;
  (*Путь к файлу без имени самого файла.*)
  FDir : DirStr;
  (*Имя файла без пути и без расширения.*)
  FName : NameStr;
  (*Расширение файла.*)
  FExt : ExtStr;
begin
  FullFileName := FExpand(aFileName);
  FSplit(FullFileName, FDir, FName, FExt);
  GetFilePath := FDir;
end;
 
(*
Получить полное имя исполняемого файла программы. - Т. е., полный путь
с именем файла и с расширением.
---
Пример1:
Текущая папка = 'D:\Bp\Projects\'
ParamStr(0)   = '0001\PROJECT1.EXE'
GetExeName    = 'D:\BP\PROJECTS\0001\PROJECT1.EXE'
*)
function GetExeName : String;
begin
  GetExeName := FExpand( ParamStr(0) );
end;
 
(*
Получить полный путь к папке, в которой расположен исполняемый файл
программы.
---
Пример1:
Текущая папка = 'D:\Bp\Projects\'
ParamStr(0)   = '0001\PROJECT1.EXE'
GetExePath    = 'D:\BP\PROJECTS\0001\'
*)
function GetExePath : String;
var
  FullFileName : String;
  FDir : DirStr;
  FName : NameStr;
  FExt : ExtStr;
begin
  FullFileName := FExpand( ParamStr(0) );
  FSplit(FullFileName, FDir, FName, FExt);
  GetExePath := FDir;
end;
 
end.

Пример использования на примере задачи: "Скопировать файл в папку, в которой расположен исполняемый файл программы. При этом, файл переименовать".

Pascal
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
program Project1;
 
uses
  FnUtils;
 
const
  (*Размер буфера в байтах для копирования данных.*)
  Size = 10000;
var
  (*Файловые переменные.*)
  F1, F2 : File;
  (*Имена файлов.*)
  Fn1, Fn2 : String;
  (*Указатель на буфер в памяти.*)
  PBuff : Pointer;
  (*Количество прочитанных байт из файла.*)
  Cnt : Integer;
  S : String;
begin
  repeat
    Writeln('Задайте путь и имя исходного файла:');
    Readln(Fn1);
    Assign(F1, Fn1);
    (*Попытка открыть файл. Установка режима доступа с минимальным
    блоком в 1 байт.*)
    {$I-}
    Reset(F1, 1);
    {$I+}
    if IOResult <> 0 then begin
      Writeln('Не удалось открыть указанный файл. Действие отменено.');
      Writeln('Повторить - Enter. Выход - любой символ + Enter.');
      Readln(S);
      Continue;
    end;
 
    (*Формируем полное имя целевого файла на основе имени исходного файла.*)
    Fn2 := GetExePath + Copy(GetShortFileName(Fn1), 1, 5) + '_cp' + GetFileExt(Fn1);
 
    Assign(F2, Fn2);
    (*Создание файла и открытие его в режиме доступа с минимальным
    блоком в 1 байт.*)
    Rewrite(F2, 1);
    (*Выделяем память для буфера и получаем указатель на первый байт
    выделенной памяти.*)
    GetMem(PBuff, Size);
    (*Копирование всего содержимого исходного файла в целевой файл.*)
    while not Eof(F1) do begin
      BlockRead(F1, PBuff^, Size, Cnt);
      BlockWrite(F2, PBuff^, Cnt);
    end;
 
    (*Освобождение памяти буфера.*)
    FreeMem(PBuff, Size);
    (*Закрытие файлов.*)
    Close(F1);
    Close(F2);
 
    Writeln('Файл:');
    Writeln(Fn1);
    Writeln('Скопирован под именем:');
    Writeln(Fn2);
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

@BakhtiyarZ · 23.12.2011, 14:51

Сообщение от Incred

может кто-нибудь организует все операции в процедуры? думаю будет полезным и удобным.
как вот здесь:
Сортировки

Было бы еще лучше если бы каждая переменная описывалась для чего она необходима.
И не могли бы вы добавить процедуру удваивания каждого символа в предложении.

Комментарий модератора

BakhtiyarZ, здесь, видимо, нет смысла по этой задаче размещать отдельный пост. Поэтому напишу прямо в твоём сообщении:

Удвоение каждого символа в строке:

Pascal
1
2
3
4
5
6
7
8
9
10
11
var
  S : String;
  i : Integer;
begin
  Writeln('Задайте строку:');
  Readln(S);
  for i := Length(S) downto 1 do Insert(S[i], S, i);
  Writeln('Строка после обработки:');
  Writeln(S);
  Readln;
end.

Так как при вставках символов длина строки изменяется, поэтому применён цикл for downto. - Таким образом, при проходе строки от конца - к началу алгоритм становится не зависящим от изменений длины строки.

@TAVulator · 24.12.2011, 09:19 **[ТС]**

Сообщение от BakhtiyarZ

Было бы еще лучше если бы каждая переменная описывалась для чего она необходима.

не вижу в этом смысла

@suiseiseki · 01.12.2012, 19:48

Сообщение от rangerx

Функция разбития строки на слова.

Pascal
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
{Функция разбивает строку на слова и помещает их в строковый массив dest
Возвращаемое значение:  количество слов помещенных в массив.}
type DelimSet = set of char;
 
function split(var dest: array of string; const s: string; const delim: DelimSet): integer;
var
  n, i, len: integer;
begin
  n:= 0;
  i:= 1;
  len:= Length(s);
 
  while (i <= len) do begin
    if s[i] in delim then
      repeat inc(i) until (i > len) or (not (s[i] in delim))
    else begin
      dest[n]:= '';
      while (i <= len) and (not (s[i] in delim)) do begin
        dest[n]:= dest[n] + s[i];
        inc(i);
      end;
      inc(n);
    end;
  end;
  split:= n;
end;

Пример использования этого можно? Что за параметр такой - dest? Как понимаю, этому массиву надо самостоятельно задавать размер. А если длина заранее неизвестна? А если надо экономить память и не выделять ее слишком много?

Pascal
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
program main;
type DelimSet = set of char;
 
function split(var dest: array of string; const s: string; const delim: DelimSet): integer;
var
  n, i, len: integer;
begin
  n:= 0;
  i:= 1;
  len:= Length(s);
 
  while (i <= len) do begin
    if s[i] in delim then
      repeat inc(i) until (i > len) or (not (s[i] in delim))
    else begin
      dest[n]:= '';
      while (i <= len) and (not (s[i] in delim)) do begin
        dest[n]:= dest[n] + s[i];
        inc(i);
      end;
      inc(n);
    end;
  end;
  split:= n;
end;
 
var i, amount:Integer;
    s:String;
    dest:array of string;
    const delimeter=[' ','*','/'];
begin
  writeln('Enter s string: ');
  read(s);
  writeln;
  amount:=split(dest,s,delimeter);
  for i:=1 to length(s) do
    write(dest[i]);
end.

Вот это крашится при запуске. С dest:array[1..10] of string; даже не компилируется.

@rangerx · 01.12.2012, 20:54

Сообщение от suiseiseki

Пример использования этого можно? Что за параметр такой - dest?

Вариант с dest: array[1..10] of string; должен компилироваться как во Free Pascal так и в Turbo Pascal. Насчёт остальных компиляторов без понятия.

Pascal
1
2
3
4
5
6
7
8
9
10
11
var i, amount:Integer;
    s:String;
    dest: array[1..10] of string;
    const delimeter=[' ','*','/'];
begin
  writeln('Enter s string: ');
  readln(s);
  amount:=split(dest,s,delimeter);
  for i:=1 to amount do
    write(dest[i]);
end.

Сообщение от suiseiseki

Как понимаю, этому массиву надо самостоятельно задавать размер. А если длина заранее неизвестна? А если надо экономить память и не выделять ее слишком много?

Это просто пример алгоритма. Естественно, вместо массива лучше использовать какую-нибудь динамически расширяемую структуру, например список.

Сообщение от suiseiseki

Вот это крашится при запуске.

Под такие массивы память выделяется с помощью SetLength

Pascal
1
SetLength(dest, 10);

и индексируются они с 0, а не с 1.

@suiseiseki · 01.12.2012, 21:44

Сообщение от rangerx

Вариант с dest: array[1..10] of string; должен компилироваться как во Free Pascal так и в Turbo Pascal. Насчёт остальных компиляторов без понятия.

Только в PascalABC появляется ошибка strings.pas(35) : Неправильный тип параметров подпрограммы, а во фри паскале программа компилируется, но при запуске крашится.

@ПерС · 28.11.2013, 15:47

Самый простой разбор на слова

Заметил, что огромное число вопросов по Паскалю - разобрать строку на слова. Если ткнуть в хороший, годный код - число вопросов удваивается ("а как это работает?")
Приведённый ниже самый простой, "школьный" код, воспринимается оптимистичней. Если было - сорри.

s - исходная строка, предполагается, что слова разделены хотя бы одним пробелом, "посторонние" знаки в конце слов (запятые, точки и т.п.) не учитываются. Программа не сохраняет строку s.
w - очередное слово. Его можно обрабатывать (вместо вывода в отдельную строку консоли, как в примере)
p - позиция очередного пробела, если пробела нет, принимает значение 0 после вызова стандартной функции pos.
len - длина очередного слова
count - количество слов

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
var s,w:string;
 p,len,count:integer;
begin
 write ('Введите строку: '); readln (s);
 p:=1;
 while p>0 do begin
  p:=pos(' ',s);  {ищем очередной пробел}
  if p>0 then w:=copy(s,1,p-1) {если есть - копируем в переменную "слово" символы до пробела}
  else w:=s; {если нет, то вся оставшееся строка - это одно слово}
  delete (s,1,p); {удаляем переписанное в w слово вместе с пробелом }
  len:=length(w); {находим длину слово}
  if len>0 then begin {"пустые" слова - лишние пробелы - не учитываем}
   inc(count); {Увеличиваем счетчик слов}
   writeln (w); {Просто выводим очередное слово -
                 вставьте сюда свой код}
  end;
 end;
 writeln ('Всего слов: ',count);
 write ('Нажмите ENTER для выхода');
 readln;
end.

@Mawrat · 28.11.2013, 18:19

Я разбивку на слова выполняю так:

Pascal
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
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  S : String;
  i, Len, LenW, Cnt : Integer;
begin
  Writeln('Задайте текст:');
  Readln(S);
 
  Writeln('Выделенные из текста слова:');
  Len := Length(S);
  Cnt := 0; //Количество найденных слов.
  LenW := 0; //Длина очередного слова.
  for i := 1 to Len do
    if not (S[i] in D) then begin //Если символ не разделитель, значит он принадлежит слову.
      Inc(LenW); //Учитываем очередной символ в длине слова.
      if (i = Len) or (S[i + 1] in D) then begin //Отслеживаем конец слова.
        Inc(Cnt); //Подсчёт слова.
        Writeln(Copy(S, i - LenW + 1, LenW)); //Распечатка слова.
        LenW := 0; //Сброс длины слова.
      end;
    end;
  
  Writeln('Количество слов в заданном тексте = ', Cnt);
  Readln;
end.

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .
SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .	Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .	SDL3 для Android: Загрузка PNG с альфа-каналом с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 28.01.2026 Содержание блога SDL3 имеет собственные средства для загрузки и отображения PNG-файлов с альфа-каналом и базовой работы с ними. В этой инструкции используется функция SDL_LoadPNG(), которая. . .

Incred
	22.06.2011, 15:04
	может кто-нибудь организует все операции в процедуры? думаю будет полезным и удобным. как вот здесь: Сортировки