Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Быстрые функции сжатия пробелов и управляющих символов в строке.
 
Функции удаляют из строки начальные и конечные пробелы и управляющие
символы (меньшие пробела). Идущие подряд пробелы и управляющие символы
в середине строки заменяются одним пробелом.
 
Зависимости: нет
Автор:       Александр Шарахов, alsha@mailru.com, Москва
Copyright:   Александр Шарахов
Дата:        2 февраля 2003 г.
***************************************************** }
 
// 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 <> nil then
 
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 <> nil then
 
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 <> nil then
 
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 = #0 then
         
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);