Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
СиППО.docx
Скачиваний:
0
Добавлен:
01.05.2025
Размер:
363 Кб
Скачать
☆

Модуль Strings.

unit Strings;

interface

uses

SysUtils;

function getPrevLexem(str: string; var charPos: integer; separators: string): string;

function getNextLexem(str: string; var charPos: integer; separators: string): string;

procedure replaceLexems(var str: string; const oldLexem, newLexem, separators: string);

implementation

function getLexem(str: string; var charPos: integer; dir: shortint;

separators: string): string;

var

i : integer;

currLexem : string;

begin

currLexem := '';

i := charPos;

while ((i >= 1) and (i <= length(str))) do

begin

if (pos(str[i], separators) <> 0) then

begin

if (currLexem <> '') then

begin

charPos := i;

result := currLexem;

exit;

end;

end else

begin

if (dir < 0) then

currLexem := str[i] + currLexem

else

currLexem := currLexem + str[i];

end;

i := i + dir;

end;

charPos := length(str) + dir;

result := currLexem;

end;

function getNextLexem(str: string; var charPos: integer; separators: string): string;

begin

result := getLexem(str, charPos, +1, separators);

end;

function getPrevLexem(str: string; var charPos: integer; separators: string): string;

begin

result := getLexem(str, charPos, -1, separators);

end;

procedure replaceLexems(var str: string; const oldLexem, newLexem, separators: string);

var

currLexem : string;

charPos,

offset : integer;

begin

if (length(oldLexem) > length(newLexem)) then

offset := length(oldLexem) - length(newLexem)

else

offset := 0;

charPos := 1;

while (charPos < length(str)) do

begin

currLexem := ansiUpperCase(getNextLexem(str, charPos, separators));

if (currLexem = ansiUpperCase(oldLexem)) then

begin

delete(str, charPos - length(currLexem), length(currLexem));

insert(newLexem, str, charPos - length(currLexem));

charPos := charPos - offset;

end;

end;

end;

end.

Казань 2011