Автор: SuMaga
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Небольшой модуль для работы со строками

function CompMask(S, Mask: string):string; //выбор строки по маске
// удаление из строки count символов начиная с posit
function deleteStr(s:string;posit,count:integer):string;
//Удаление из строки s сначала first и с конца last символов
function deleteFaskaStr(s:string; first,last:integer):string;
Запись в стринлист strg всех вхождений по маске mask из строки source
procedure getStrings(var strg: TStringList; mask,source: string);

Зависимости: classes,sysutils
Автор:       SuMaga, sumaga@mail.ru, ICQ:721602488, Махачкала
Copyright:   Сам состряпал :)
Дата:        24 января 2003 г.
***************************************************** }

unit StrMask;
interface
uses classes, sysutils;
function CompMask(S, Mask: string): string;
function deleteStr(s: string; posit, count: integer): string;
function deleteFaskaStr(s: string; first, last: integer): string;
procedure getStrings(var strg: TStringList; mask, source: string);

implementation

type
  TmaskObj = class
    constructor open;
  public
    Maschr: tstringlist;
    Masposish: TStringList;
    destructor close;
  end;

procedure getStrings(var strg: TStringList; mask, source: string);
var
  s, s2: string;
begin
  s2 := source;
  s := CompMask(s2, mask);
  while s <> '' do
  begin
    strg.Add(s);
    s2 := StringReplace(s2, s, '', []);
    s := CompMask(s2, mask);
    if pos(s, s2) = 0 then
      break;
  end;

end;

function eraseMask(inpstr: TStrings): TStrings;
var
  i: integer;
  e: boolean;
begin
  e := false;
  for i := 0 to inpstr.Count - 1 do
    if (i <> inpstr.Count - 1) and (i < inpstr.Count - 1) then
      if ((inpstr[i] = '`') and (inpstr[i + 1] = '|')) or
        ((inpstr[i] = '|') and (inpstr[i + 1] = '`')) or
        ((inpstr[i] = '`') and (inpstr[i + 1] = '`')) then
      begin
        e := true;
      end;

  if (e = false) or (i <= inpstr.Count - 1) then
  begin
    Result := inpstr;
    exit;
  end;

  for i := 0 to inpstr.Count - 1 do
    if (i <> inpstr.Count - 1) and (i < inpstr.Count - 1) then
      if ((inpstr[i] = '`') and (inpstr[i + 1] = '|')) or
        ((inpstr[i] = '`') and (inpstr[i + 1] = '`')) or
        ((inpstr[i] = '|') and (inpstr[i + 1] = '`')) then
      begin
        inpstr.Delete(i + 1);
        inpstr[i] := '`';
      end;
  Result := eraseMask(inpstr);
end;

{
`<---- Эквивалентна----->*
|<---- Эквивалентна----->?
}

function SplitMask(mask: string; MaskList: TStringList): TStringList;
var
  i, j, k: integer;
  s1: string;
  mch: TmaskObj;
begin
  mch := TmaskObj.open;
  for i := 1 to length(Mask) do
  begin
    if Mask[i] = '`' then
    begin
      mch.Maschr.Add('`');
      mch.Masposish.Add(inttostr(i))
    end;

    if Mask[i] = '|' then
    begin
      mch.Maschr.Add('|');
      mch.Masposish.Add(inttostr(i))
    end;
  end;
  k := 0;
  for i := 0 to mch.Maschr.Count - 1 do
  begin
    j := strtoint(mch.Masposish.Strings[i]) - k;
    if j - 1 <> 0 then
      s1 := copy(Mask, 1, j - 1)
    else
      s1 := '';
    delete(Mask, 1, j);
    k := length(s1) + 1 + k;
    if (s1 <> mch.Maschr.Strings[i]) and (length(s1) <> 0) then
      MaskList.Add(s1);
    MaskList.Add(mch.Maschr.Strings[i]);
  end;
  if Mask <> '' then
    MaskList.Add(Mask);
  mch.close;
  Result := TStringList(eraseMask(MaskList));
end;

function deleteStr(s: string; posit, count: integer): string;
begin
  Delete(s, posit, count);
  Result := s;
end;

function deleteFaskaStr(s: string; first, last: integer): string;
begin
  result := deleteStr(s, 1, first);
  result := deleteStr(Result, length(Result) - last + 1, length(Result) -
    (length(Result) - last));
end;

function CompMask(S, Mask: string): string;
var
  i, j, k, y: integer;
  s1, s2, s3, s4, s5: string;
  MaskList: TStringList;
  PrPos: integer;
var
  fm: boolean;
label
  1, 2, 3;

begin
  2:
  if length(s) = 0 then
    exit;
  if length(Mask) = 0 then
    exit;
  if length(s) < length(Mask) then
    exit;
  //if Assigned(MaskList) then
  begin
    MaskList := TStringList.Create;
    MaskList := SplitMask(Mask, MaskList);
  end;
  PrPos := 0;
  s4 := s;
  fm := false;
  s3 := '';
  i := 0;
  result := '';
  if MaskList.Count - 1 = 0 then
  begin
    if (MaskList[0] = '`') then
    begin

      s3 := s;
      fm := true;
    end;
    if (MaskList[0] = '|') then
    begin
      s3 := s[1];
      fm := true;
      result := s3;
      exit;
    end;
    if (MaskList[0] <> '`') and (MaskList[0] <> '|') then
    begin
      if pos(MaskList[0], s) = 0 then
        exit;
      s3 := copy(s, pos(MaskList[0], s), length(MaskList[0]));
      fm := true;
    end;
    i := MaskList.Count + 1;
  end;

  //Начало цикла
  while i <= MaskList.Count - 1 do
  begin
    if (MaskList[i] = '`') and (PrPos = 0) and (i + 1 <= MaskList.Count - 1)
      then
    begin
      if pos(MaskList[i + 1], s) = 0 then
        goto 2;
      j := pos(MaskList[i + 1], s) + length(MaskList[i + 1]) - 1;
      s3 := copy(s, 1, j);
      delete(s, 1, j);
      fm := true;
      PrPos := j;
      i := i + 1;
      goto 1;
    end;

    if (MaskList[i] = '|') and (PrPos = 0) and (i + 1 <= MaskList.Count - 1)
      then
    begin
      k := i;
      y := 0;
      if i + 1 <= MaskList.Count - 1 then
        while (MaskList[k] = '|') do
        begin
          k := k + 1;
          y := y + 1;
          if k >= MaskList.Count - 1 then
            break;
        end;
      if pos(MaskList[k], s) = 0 then
        goto 2;
      j := pos(MaskList[k], s);
      s3 := copy(s, j - y, length(MaskList[k]) + y);
      delete(s, 1, j + length(MaskList[k]) - 1);
      fm := true;
      PrPos := j - 1;
      i := k;
      goto 1;
    end;
    if (PrPos = 0) and (MaskList[i] <> '|') and (MaskList[i] <> '`') then
    begin
      if pos(MaskList[i], s) = 0 then
        break;
      j := pos(MaskList[i], s);
      s3 := copy(s, j, length(MaskList[i]));
      delete(s, 1, j + length(MaskList[i]) - 1);
      fm := true;
      PrPos := length(MaskList[i]);
      goto 1;
    end;

    fm := false;
    if (PrPos <> 0) and (i < MaskList.Count - 1) then
    begin
      if (MaskList[i] = '`') then
      begin
        if pos(MaskList[i + 1], s) = 0 then
          goto 2;
        j := pos(MaskList[i + 1], s);
        s3 := s3 + copy(s, 1, j + length(MaskList[i + 1]) - 1);
        fm := true;

        delete(s, 1, j + length(MaskList[i + 1]) - 1);

        PrPos := j + length(MaskList[i + 1]);
        i := i + 1;
        goto 1;

      end;
      if (MaskList[i] = '|') then
      begin
        if i + 1 <= MaskList.Count - 1 then
          if MaskList[i + 1] <> '|' then
          begin
            if pos(MaskList[i + 1], s) > 2 then
            begin
              //break;
              goto 2;
            end;
            s3 := s3 + copy(s, 1, length(MaskList[i + 1]) + 1);
            delete(s, 1, length(MaskList[i + 1]) + 1);
            fm := true;
            i := i + 1;
            goto 1;
          end;
        s3 := s3 + copy(s, 1, 1);
        delete(s, 1, 1);
        fm := true;
        PrPos := 1;
      end;

      if (MaskList[i] <> '`') and (MaskList[i] <> '|') then
      begin
        if pos(MaskList[i], s) = 0 then
          goto 2;
        j := pos(MaskList[i], s);
        s3 := s3 + copy(s, j, length(MaskList[i]));
        delete(s, 1, j + length(MaskList[i]) - 1);
        fm := true;
        PrPos := length(MaskList[i]);
        fm := true
      end;
    end;

    if (PrPos <> 0) and (i = MaskList.Count - 1) then
    begin
      if (MaskList[i] = '`') then
      begin
        s3 := s3 + s;
        s := '';
        fm := true;
        PrPos := j;
      end;
      if (MaskList[i] = '|') then
      begin
        s3 := s3 + copy(s, 1, 1);
        delete(s, 1, 1);
        fm := true;
        PrPos := 1;
      end;
      if (MaskList[i] <> '`') and (MaskList[i] <> '|') then
      begin
        if pos(MaskList[i], s) <> 0 then
          j := pos(MaskList[i], s) + length(MaskList[i]) - 1
        else
          goto 2;
        s3 := s3 + copy(s, 1, j);
        delete(s, 1, j);
        fm := true;
        PrPos := j + length(s3);
      end;
    end;
    1: inc(i);
  end;
  s5 := s3;
  if s3 <> '' then
    for i := 0 to MaskList.Count - 1 do
      if (MaskList[i] <> '`') and (MaskList[i] <> '|') then
      begin
        if pos(MaskList[i], s3) = 0 then
          goto 2;
        s3 := StringReplace(s3, MaskList[i], '', []);
      end;

  s3 := s5;
  MaskList.Free;

  if fm then
  begin
    result := s3;
  end
    {
    {result:='';
    else
    if length(s)>=length(Mask) then
    result:=CompMask(s,Mask)
    else Result:='';}
end;

destructor TmaskObj.close;
begin
  Maschr.free;
  Masposish.free;
end;

constructor TmaskObj.open;
begin
  Maschr := TStringList.Create;
  Masposish := TStringList.Create;
end;
end.

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

s := 'asd r';
s := CompMask(s, 'd |');
//в результате s='d r';