Code:

{ **** UBPFD *********** by delphibase.endimus  ****

>> Быстрые функции сжатия пробелов и управляющих символов в строке.

Функции удаляют из строки начальные и конечные пробелы и управляющие

символы (меньшие пробела). Идущие подряд пробелы и управляющие символы

в середине строки заменяются одним пробелом.

Зависимости: нет

Автор: Александр Шарахов, alsha @ mailru.com, Москва

Copyright: Александр Шарахов

***************************************************** }

// Sha_SpaceCompress удаляет из Ansi-строки начальные и конечные пробелы

// и управляющие символы (меньшие пробела). Идущие подряд пробелы

// и управляющие символы в середине строки заменяются одним пробелом.

// Исходная строка при этом не изменяется. Эта функция работает

// медленнее, чем Sha_SpaceCompressInplace. С целью ускорения работы

// освобождение неиспользуемой памяти за пределами строки не производится.

// Если это критично, после вызова данной функции можно освободить память

// следующим образом: s2:=Sha_SpaceCompress(s1); SetLength(s2,Length(s2));

// Функция не работает, если нарушен формат Ansi-строки, в частности,

// если в конце строки отсутствует терминатор.

function Sha_SpaceCompress(const s: string): string;

var

p, q, t: pchar;

ch: char;

label

rt;

begin

;

p := pointer(s);

q := nil;

if p <> nilthen

begin

;

t := p + (pinteger(p - 4))^;

if p < t then

begin

;

repeat;

dec(t);

if p > t then

goto rt;

until (t^ > ' ');

SetString(Result, nil, (t - p) + 1);

q := pchar(pointer(Result));

repeat;

repeat;

ch := p^;

inc(p);

until ch > ' ';

repeat;

q^ := ch;

ch := p^;

inc(q);

inc(p);

until ch <= ' ';

q^ := ' ';

inc(q);

until p > t;

end;

end;

rt:

if q <> nilthen

begin

;

dec(q);

q^ := #0;

(pinteger(pchar(pointer(Result)) - 4))^ := q - pointer(Result);

end

else

Result := '';

end;

// Sha_SpaceCompressInplace удаляет из Ansi-строки начальные и конечные пробелы

// и управляющие символы (меньшие пробела). Идущие подряд пробелы

// и управляющие символы в середине строки заменяются одним пробелом.

// Результат замещает исходную строку. С целью ускорения работы

// освобождение неиспользуемой памяти за пределами строки не производится.

// Если это критично, после вызова данной функции можно освободить память

// следующим образом: Sha_SpaceCompressInpace(s); SetLength(s,Length(s));

// Процедура не работает, если нарушен формат Ansi-строки, в частности,

// если в конце строки отсутствует терминатор.

procedure Sha_SpaceCompressInplace(var s: string);

var

p, q, t: pchar;

ch: char;

label

rt;

begin

;

UniqueString(s);

p := pointer(s);

if p <> nilthen

begin

;

t := p + (pinteger(p - 4))^;

if p < t then

begin

;

q := p;

repeat;

dec(t);

if p > t then

goto rt;

until (t^ > ' ');

repeat;

repeat;

ch := p^;

inc(p);

until ch > ' ';

repeat;

q^ := ch;

ch := p^;

inc(q);

inc(p);

until ch <= ' ';

q^ := ' ';

inc(q);

until p > t;

dec(q);

rt: q^ := #0;

(pinteger(pchar(pointer(s)) - 4))^ := q - pointer(s);

end;

end;

end;

// Sha_SpaceCompressPChar удаляет из null-terminated строки начальные

// и конечные пробелы и управляющие символы (меньшие пробела), за исключением

// терминатора. Идущие подряд пробелы и управляющие символы в середине строки

// заменяются одним пробелом. Результат замещает исходную строку.

// Никакое перераспределения памяти не производится.

// Функция не работает с read-only строкой.

function Sha_SpaceCompressPChar(p: pchar): pchar;

var

q: pchar;

ch: char;

label

rt;

begin

;

Result := p;

if (p <> nil) and (p^ <> #0) then

begin

;

q := p - 1;

repeat;

repeat;

ch := p^;

inc(p);

if ch = #0then

goto rt;

until ch > ' ';

inc(q);

repeat;

q^ := ch;

ch := p^;

inc(q);

inc(p);

until ch <= ' ';

q^ := ' ';

until ch = #0;

rt: if q < Result then

inc(q);

q^ := #0;

end;

end;

Пример использования:

s2 := Sha_SpaceCompress(s1);

Sha_SpaceCompressInpace(s);

Sha_SpaceCompressPChar(pch);