Rambler's Top100
"Knowledge itself is power"
F.Bacon
Поиск | Карта сайта | Помощь | О проекте | ТТХ  
 Сокровищница
  
 

Фильтр по датам

 
 К н и г и
 
Книжная полка
 
 
Библиотека
 
  
  
 


Поиск
 
Поиск по КС
Поиск в статьях
Яndex© + Google©
Поиск книг

 
  
Тематический каталог
Все манускрипты

 
  
Карта VCL
ОШИБКИ
Сообщения системы

 
Форумы
 
Круглый стол
Новые вопросы

 
  
Базарная площадь
Городская площадь

 
   
С Л С

 
Летопись
 
Королевские Хроники
Рыцарский Зал
Глас народа!

 
  
ТТХ
Конкурсы
Королевская клюква

 
Разделы
 
Hello, World!
Лицей

Квинтана

 
  
Сокровищница
Подземелье Магов
Подводные камни
Свитки

 
  
Школа ОБЕРОНА

 
  
Арсенальная башня
Фолианты
Полигон

 
  
Книга Песка
Дальние земли

 
  
АРХИВЫ

 
 

Сейчас на сайте присутствуют:
 
  
 
Во Флориде и в Королевстве сейчас  06:27[Войти] | [Зарегистрироваться]

Обсуждение материала
Быстрая функция для замены строк
Полный текст материала


Другие публикации автора: Сергей Осколков

Цитата или краткий комментарий:

«... В Дельфи есть функция для замены одного образца в строке на другой - StringReplace. Эта функция позволяет заменить первое вхождение образца или все его вхождения, а также делать замену с учетом регистра букв (Case sensitive). Однако у этой функции есть один существенный недостаток: она очень медленно работает на больших строках при большом количестве вхождений заменяемого образца. ...»


Важно:
  • Страница предназначена для обсуждения материала, его содержания, полезности, соответствия действительности и так далее. Смысл не в разборке, а в приближении к истине :о) и пользе для всех.
  • Любые другие сообщения или вопросы, а так же личные эмоции в адрес авторов и полемика, не относящаяся к теме обсуждаемого материала, будут удаляться без предупреждения авторов, дабы не мешать жителям нормально общаться.
  • При голосовании учитывайте уровень, на который расчитан материал. "Интересность и полезность" имеет смысл оценивать относительно того, кому именно предназначался материал.
  • Размер одного сообщений не должен превышать 5К. Если Вам нужно сказать больше, сделайте это за два раза. Или, что в данной ситуации правильнее, напишите свою статью.
Всегда легче осудить сделанное, нежели сделать самому. Поэтому, пожалуйста, соблюдайте правила Королевства и уважайте друг друга.



Добавить свое мнение.

Результаты голосования
Оценка содержания

  Содержит полезные и(или) интересные сведения
[1]8100%
 
  Ничего особенно нового и интересного
[2]00%
 
  Написано неверно (обязательно укажите почему)
[3]00%
 
Всего проголосовали: 8

Оценка стиля изложения

  Все понятно, материал читается легко
[1]6100%
 
  Есть неясности в изложении
[2]00%
 
  Непонятно написано, трудно читается
[3]00%
 
Всего проголосовали: 6




Смотрите также материалы по темам:
[Поиск и сортировка] [Обработка текста]

Комментарии жителей
Отслеживать это обсуждение

Всего сообщений: 30

31-08-2009 01:00
Александр Алексеев
/ 25-02-2009 09:01 /
Взял за основу функцию Славы, убрал побайтовое копирование - заменил на блоковое. Плюс подчистил код, слил обе ветки в одну. Новая версия работает также и для Unicode.

Функция отличная, спасибо за всем, кто так или иначе принял участие в её создании, но только вот что-то в ней не так...

Маленькое испытание, дабы понять, в чём проблема

Допустим, есть такая строка:

<aa><bb><cc="2009" /><dd /><ee /><tt>qq</tt></bb>


Требуется первое вхождение /> заменить на /><WWW />

Со стандартной StringReplace всё нормально:

var
  S: String;
begin
  S:='<aa><bb><cc="2009" /><dd /><ee /><tt>qq</tt></bb>';
  S:=StringReplace(S, '/>', '/><WWW />', [rfIgnoreCase]);
  Memo.Text:=S;
end;

Конечное значение S:
<aa><bb><cc="2009" /><WWW /><dd /><ee /><tt>qq</tt></bb>



А вот Replace хулиганит, копирует лишнее:

var
  S: String;
begin
  S:='<aa><bb><cc="2009" /><dd /><ee /><tt>qq</tt></bb>';
  S:=Replace(S, '/>', '/><WWW />', [rfIgnoreCase]);
  Memo.Text:=S;
end;

Конечное значение S:
<aa><bb><cc="2009" /><WWW /><aa><bb><cc="2009" /><dd /><ee /><tt>qq</tt></bb>



Пока печатал это сообщение, уже сообразил, в каком месте кроется ошибка в функции Replace :^)
Вот оно:

      if not (rfReplaceAll in Flags) then
        Break;
      I := I + RLen;
      LastI := I;
      J := J + RLen;


Break нужно выполнять ПОСЛЕ операций с I, LastI и J, иначе нас с их неправильными значениями перебрасывает на вспомогательную функцию Add_Org, которая скопирует в результат лишнее

Пара простых телодвижений:


      I := I + RLen;
      LastI := I;
      J := J + RLen;
      if not (rfReplaceAll in Flags)
        then Break;


Вуаля :)


25-02-2009 10:40
сообщение от автора материала
StrReplace - функция Сергея Осколкова (она же - функция из QStrings. Там другая реализация, но идея та же).
Нет, реализация не моя, Дэвида Батлера. Я просто вынул её (зачем-то) из его большой библиотеки Fundamentals
http://sourceforge.net/projects/fundementals/
Впрочем, понятно зачем: функция актуальная, особенно была актуальна до появления FastMM и того, как FastMM вошла в Дельфи. А тащить в проект всю библиотеку Батлера не хотелось.


25-02-2009 09:28
Вот результаты тестов.
За основу взял текстовое представление своей последней статьи (более 300 Кб).
Здесь StringReplace - это стандартная функция Delphi. Replace - моя модификация, что я привёл. StrReplace - функция Сергея Осколкова (она же - функция из QStrings. Там другая реализация, но идея та же).
Время замерялось простым GetTickCount, процесс работал с RealTime-приоритетом. Сделал несколько прогонов и усреднил результаты. Всё под D2007.

10 итераций
     19109: StringReplace[case sensitive] 'вы' -> 'мы'
        16: Replace[case sensitive] 'вы' -> 'мы'
        15: StrReplace[case sensitive] 'вы' -> 'мы'

      8219: StringReplace[case sensitive] 'мы' -> 'There Is No Cow Level'
        31: Replace[case sensitive] 'мы' -> 'There Is No Cow Level'
        47: StrReplace[case sensitive] 'мы' -> 'There Is No Cow Level'

      3484: StringReplace[case sensitive] 'исключение' -> 'я'
        16: Replace[case sensitive] 'исключение' -> 'я'
        31: StrReplace[case sensitive] 'исключение' -> 'я'

     26812: StringReplace[ignore case] 'вы' -> 'мы'
        47: Replace[ignore case] 'вы' -> 'мы'
        47: StrReplace[ignore case] 'вы' -> 'мы'

     11609: StringReplace[ignore case] 'мы' -> 'There Is No Cow Level'
        63: Replace[ignore case] 'мы' -> 'There Is No Cow Level'
        62: StrReplace[ignore case] 'мы' -> 'There Is No Cow Level'

      4812: StringReplace[ignore case] 'исключение' -> 'я'
        78: Replace[ignore case] 'исключение' -> 'я'
        78: StrReplace[ignore case] 'исключение' -> 'я'


100 итераций
       188: Replace[case sensitive] 'вы' -> 'мы'
       203: StrReplace[case sensitive] 'вы' -> 'мы'

       375: Replace[case sensitive] 'мы' -> 'There Is No Cow Level'
       375: StrReplace[case sensitive] 'мы' -> 'There Is No Cow Level'

       219: Replace[case sensitive] 'исключение' -> 'я'
       218: StrReplace[case sensitive] 'исключение' -> 'я'

       485: Replace[ignore case] 'вы' -> 'мы'
       468: StrReplace[ignore case] 'вы' -> 'мы'

       594: Replace[ignore case] 'мы' -> 'There Is No Cow Level'
       594: StrReplace[ignore case] 'мы' -> 'There Is No Cow Level'

       797: Replace[ignore case] 'исключение' -> 'я'
       797: StrReplace[ignore case] 'исключение' -> 'я'


25-02-2009 09:01
Часть 2

...

var
  I, J, LastI: Integer;
  UC, LC: Char;
  Tmp: String;
begin
  if (S = '') or (OldPattern = '') then
  begin
    Result := S;
    Exit;
  end;

  RLen := Length(OldPattern);
  RToLen := Length(NewPattern);
  TextLen := Length(S);
  ResLen := 0;
  ResSize := TextLen;
  SetLength(Result, ResSize);

  if rfIgnoreCase in Flags then
  begin
    Tmp := OldPattern[1];
    UC := AnsiUpperCase(Tmp)[1];
    LC := AnsiLowerCase(Tmp)[1];
    CompareText := @CompareMemNC;
  end
  else
  begin
    UC := OldPattern[1];
    LC := OldPattern[1];
    CompareText := @CompareMemCS;
  end;

  I := 1;
  J := RLen;
  LastI := 1;
  while I <= TextLen do
  begin
    if J > TextLen then
      Break;

    if ((S[I] = LC) or (S[I] = UC)) and
       CompareText(@(PChar(Pointer(S))[I]), @(PChar(Pointer(OldPattern))[1]), RLen - 1) then
    begin
      Add_Org(LastI, I);
      Add_Replace(I);
      if not (rfReplaceAll in Flags) then
        Break;
      I := I + RLen;
      LastI := I;
      J := J + RLen;
    end
    else
    begin
      Inc(I);
      Inc(J);
    end;
  end;
  Add_Org(LastI, TextLen + 1);

  if Length(Result) <> ResLen then
    SetLength(Result, ResLen);
end;



25-02-2009 09:01
Взял за основу функцию Славы, убрал побайтовое копирование - заменил на блоковое. Плюс подчистил код, слил обе ветки в одну. Новая версия работает также и для Unicode. В результате новая функция в некоторых случаях обходит функцию в статье (а иногда наоборот). Проверял на 300 Кб тексте заменой как в сторону увеличения результата, так и уменьшения.
Быстрые варианты Move, CompareMem можно взять в исходниках D2006 и выше. А MoveChars - из D2009 (это простой Move с Len = Len * SizeOf(Char)).

function Replace(const S, OldPattern, NewPattern: String; Flags: TReplaceFlags): string;
var
  RLen, TextLen, ResLen, ResSize, RToLen: Integer;
  CompareText: function(const S1, S2: PChar; const ALen: Integer): Boolean;

  // Компаратор для сравнения с учётом регистра символов
  function CompareMemCS(const S1, S2: PChar; const ALen: Integer): Boolean;
  begin
    Result := CompareMem(S1, S2, ALen * SizeOf(Char));
  end;

  // Компаратор для сравнения с игнорированием регистра символов
  function CompareMemNC(const S1, S2: PChar; const ALen: Integer): Boolean;
  begin
    Result := (AnsiStrLComp(S1, S2, ALen) = 0);
  end;

  procedure Add_Replace(const Index: Integer);
  begin
    if ResLen + RToLen > ResSize then
    begin
      ResSize := ResSize * 2 + RToLen;
      SetLength(Result, ResSize);
    end;

    MoveChars(NewPattern[1], Result[ResLen + 1], RToLen);

    ResLen := ResLen + RToLen;
  end;

  procedure Add_Org(const LastI, Index: Integer);
  var
    Sz, Dest: Integer;

  begin
    Sz := Index - LastI;
    if Sz <= 0 then
      Exit;

    Dest := ResLen;
    Inc(Dest);
    ResLen := ResLen + Sz;

    if ResLen > ResSize then
    begin
      ResSize := ResSize * 2;
      SetLength(Result, ResSize);
    end;

    MoveChars(S[LastI], Result[Dest], Sz);
  end;



01-12-2008 01:01
часть 3:

  procedure DoReplace;
  var
  i: integer;
  FirstU, LastU: Char;
  begin
  WhatB:=AnsiUpperCase(ReplaceBegin);
  WhatE:=AnsiUpperCase(ReplaceEnd);
  FirstU:=WhatB[1];
  LastU:=WhatE[1];

  i:=1;
  Stop:=False;
  while i<=TextLen do
    begin{0}
    IF NOT Stop THEN
    BEGIN{1}
    IF StrBool THEN
      BEGIN{2}
      if UpperConv[Text[i]]=LastU then
        begin{3}
      if SameTextE(i) then
          begin{4}
        End_Replace(i);
        if not All then
        Stop:=True;
          end{4}
        else
      Add_Org(i);
        end{3}
        else
      Add_Org(i);
      END{2}
    ELSE
      BEGIN{5}
      if UpperConv[Text[i]]=FirstU then
        begin{6}
      if SameTextB(i) then
      Begin_Replace(i)
        else
      Add_Org(i);
        end{6}
        else
      Add_Org(i);
      END;{5}
    END{1}
      ELSE Add_Org(i);
    end;{0}

  if StrBool then
    begin{0}
    ResLen:=ResLen+IndexStr;
      if ResLen>ResSize then
        begin{1}
      ResSize:=ResLen*2;
      SetLength(Result, ResSize);
        end;{1}
    for i:=1 to IndexStr do
    result[PosStr+i-1]:=ReadStr[i];
    end;{0}    
  end;
  ////////////////////////////////////////
begin
if (ReplaceBegin='') or (ReplaceEnd='') or (Text='') then
  begin
result:=Text;
exit;
  end;

RLen:=Length(ReplaceBegin);
LLen:=Length(ReplaceEnd);
RToLen:=Length(ReplaceTo);
ResLen:=0;
PosStr:=1;
TextLen:=Length(Text);
ResSize:=TextLen;
SetString(result, nil, ResSize);
StrSize:=ResSize;
SetString(ReadStr, nil, StrSize);
StrBool:=False;

DoReplace;

if Length(result)<>ResLen then
SetLength(result, ResLen);
end;



Параметры функции:
Text - текст, где будет производиться поиск и замена;
ReplaceBegin - ищем вхожение первой строки;
ReplaceEnd - ищем вхожение второй строки;
ReplaceTo - то, на что будем заменять найденный текст, между ReplaceBegin и ReplaceEnd (они кстати тоже заменяются);
All - не обязательный параметр, True - заменять все вхождения сток, False - заменять только первое вхождение.

Насколько эффектива функция - я точно не скажу, т.к. другой подобной я не встречал (а искать лень), поэтому я сравнил её со функцией Славы - TextUtils.Replace

Для тестирования, взял книгу "Пикник на обочине", размером в 325 кб.
В своей функции заменял текст между "Рэдрик" и "Шухарт" на "*ЗАМЕНИЛИ*".
В функции Славы, заменял просто "Рэдрик" на "*ЗАМЕНИЛИ*".

Результаты в среднем:
ReplaceEx:         10,32
TextUtils.Replace: 10,73


01-12-2008 01:00
часть 2:

  procedure End_Replace(var Index: integer);
  var
  i: integer;
  begin
  StrBool:=False;

  if ResLen+RToLen>ResSize then
    begin
  ResSize:=ResSize*2+RToLen;
  SetLength(result, ResSize);
    end;

  for i:=1 to RToLen do
  result[ResLen+i]:=ReplaceTo[i];

  if LLen>StrSize then
    begin
  StrSize:=LLen*2;
  SetLength(ReadStr, StrSize);
    end;

  for i:=1 to LLen do
    begin
  inc(IndexStr);
  ReadStr[IndexStr]:=Text[Index+i-1];
    end;

  if Length(ReadStr)<>IndexStr then
  SetLength(ReadStr, IndexStr);
  //ShowMessage(ReadStr); в переменной ReadStr содержится текст строки, которую мы заменили
  //если этот текст вам нужен - быстрее берите отсюда.

  SetString(ReadStr, nil, ResSize);
  ResLen:=ResLen+RToLen;
  Index:=Index+LLen;
  end;
  ////////////////////////////////////////
  procedure Add_Org(var Index: integer);
  begin
  if StrBool then
    begin{0}
      if IndexStr>StrSize then
        begin{1}
      StrSize:=IndexStr*2;
      SetLength(ReadStr, StrSize);
        end;{1}
      inc(IndexStr);
    ReadStr[IndexStr]:=Text[Index];
    end{0}
  else
    begin{2}
    inc(ResLen);
      if ResLen>ResSize then
        begin{3}
      ResSize:=ResSize*2;
      SetLength(Result, ResSize);
        end;{3}
    result[ResLen]:=Text[Index];
    end;{2}
  inc(Index);
  end;
  ////////////////////////////////////////
  function SameTextB(Ind: integer): boolean;
  var
  i: integer;
  begin
  result:=Ind+RLen-1<=TextLen;

  if result then
  for i:=1 to RLen-1 do
    if UpperConv[Text[Ind+i]]<>WhatB[1+i] then
      begin
    result:=False;
    exit;
      end;
  end;
  ////////////////////////////////////////
  function SameTextE(Ind: integer): boolean;
  var
  i: integer;
  begin
  result:=Ind+LLen-1<=TextLen;

  if result then
  for i:=1 to LLen-1 do
    if UpperConv[Text[Ind+i]]<>WhatE[1+i] then
      begin
    result:=False;
    exit;
      end;
  end;
  ////////////////////////////////////////


продолжение следует...


01-12-2008 00:59
Всем большое спасибо, за предоставленную информацию.
to Слава:
На основе вашей функции - написал свою функцию ReplaceEx (под свою задачу), осуществляет поиск и замену текста между двумя вхождениями строк.
Вот исходный код, может кому пригодится:

var
  UpperConv: array [AnsiChar] of AnsiChar; {глобальная переменная}
  //Единственное, функция не учитывает регистр букв (т.к. в моей задаче это не требуется), но исправить это несложно :)

procedure Init_CaseConv; {вызывается при инициализации модуля}
var
i: integer;
s: string;
begin
SetLength(s, 256);

for i:=0 to 255 do
s[i+1]:=Chr(i);

s:=SysUtils.AnsiUpperCase(s);
for i:=0 to 255 do
UpperConv[Chr(i)]:=s[i+1];
end;

function ReplaceEx(const Text, ReplaceBegin, ReplaceEnd, ReplaceTo: string; All: boolean=True): string;
var
RLen, LLen, TextLen, ResLen, ResSize, StrSize, RToLen, PosStr, IndexStr: integer;
ReadStr, WhatB, WhatE: string;
StrBool, Stop: boolean;
  ////////////////////////////////////////
  procedure Begin_Replace(var Index: integer);
  var
  i: integer;
  begin
  StrBool:=True;
  PosStr:=ResLen+1;
  IndexStr:=0;

  if RLen>StrSize then
    begin
  StrSize:=RLen*2;
  SetLength(ReadStr, StrSize);
    end;

  for i:=1 to RLen do
    begin
  inc(IndexStr);
  ReadStr[IndexStr]:=Text[Index+i-1];
    end;

  Index:=Index+RLen;
  end;
  ////////////////////////////////////////


продолжение следует...


18-04-2008 11:25
Немного изменил код функции (сократил длину имен некоторых переменных), так как она не вмещалась в ограничение для сообщений форума в 2560 знаков.
Еще необходиы две гобальные переменные и функия, которая помещается в секцию инициализации модуля.

var
  UpperConv: array [AnsiChar] of AnsiChar;
  LowerConv: array [AnsiChar] of AnsiChar;

procedure Init_CaseConv; { вызывается при инициализации модуля }
var
  i: Integer;
  s: string;
begin
  SetLength(s, 256);
  for i := 0 to 255 do
    s[i+1] := Chr(i);

  s := SysUtils.AnsiUpperCase(s);
  for i := 0 to 255 do
    UpperConv[Chr(i)] := s[i+1];

  s := SysUtils.AnsiLowerCase(s);
  for i := 0 to 255 do
    LowerConv[Chr(i)] := s[i+1];
end;



18-04-2008 11:20
Вот.

function Replace(const Text, What, ReplaceTo: string;
  CaseSensitive: Boolean): string;
var
  RLen, TextLen, ResLen, ResSize, RToLen: Integer;
  WhatU: string;

  function SameText_Case(Ind: Integer): Boolean;
  var
    i: Integer;
  begin
    Result := Ind-1+RLen <= TextLen;

    if Result then
      for i := 1 to RLen-1 do
        if Text[Ind+i] <> What[1+i] then
        begin
          Result := False;
          Exit;
        end;
  end;

  function SameText_NoCase(Ind: Integer): Boolean;
  var
    i: Integer;
    CurU: Char;
  begin
    Result := Ind-1+RLen <= TextLen;

    if Result then
      for i := 1 to RLen-1 do
        if UpperConv[Text[Ind+i]] <> WhatU[1+i] then
        begin
          Result := False;
          Exit;
        end;
  end;

  procedure Add_Replace(var Index: Integer);
  var
    i: Integer;
  begin
    if ResLen+RToLen > ResSize then
    begin
      ResSize := ResSize*2+RToLen;
      SetLength(Result, ResSize);
    end;

    for i := 1 to RToLen do
      Result[ResLen+i] := ReplaceTo[i];

    ResLen := ResLen+RToLen;
    Index := Index+RLen;
  end;

  procedure Add_Org(var Index: Integer);
  begin
    Inc(ResLen);

    if ResLen > ResSize then
    begin
      ResSize := ResSize*2;
      SetLength(Result, ResSize);
    end;

    Result[ResLen] := Text[Index];
    Index := Index+1;
  end;

  procedure DoCase;
  var
    i: Integer;
    First: Char;
  begin
    First := What[1];

    i := 1;
    while i <= TextLen do
    begin
      if (Text[i] = First) and SameText_Case(i) then
        Add_Replace(i)
      else
        Add_Org(i);
    end;
  end;

  procedure DoNoCase;
  var
    i: Integer;
    FirstU: Char;
  begin
    WhatU := AnsiUpperCase(What);
    FirstU := WhatU[1];

    i := 1;
    while i <= TextLen do
    begin
      if (UpperConv[Text[i]] = FirstU) and SameText_NoCase(i) then
        Add_Replace(i)
      else
        Add_Org(i);
    end;
  end;

begin
  if (What = '') or (Text = '') then
  begin
    Result := Text;
    Exit;
  end;

  RLen := Length(What);
  RToLen := Length(ReplaceTo);
  TextLen := Length(Text);
  ResLen := 0;
  ResSize := TextLen;
  SetString(Result, nil, ResSize);

  if CaseSensitive then
    DoCase
  else
    DoNoCase;

  if Length(Result) <> ResLen then
    SetLength(Result, ResLen);
end;



18-04-2008 04:54
to Слава:
Так опубликуйте Вашу функцию. Все Вам будут признательны.
 Geo


18-04-2008 02:30
Увидел эту статью и рещил сравнить со своей процедурой (TextUtils.Replace) писанной принципиально на Паскале без всякого ассемблера и даже PChar. А также со включенным RangeCheckError.

Написал за 5 мин програмку.
Взял текстовый файл ~300кб, книжный вариант "ЧУЖОГО".

заменить "чужой" на "12345":
StrRepl CaseSens = True 375
StrRepl CaseSens = False 375
TextUtils.Replace CaseSens = True 500
TextUtils.Replace CaseSens = False 515

заменить "его" на "123":
StrRepl CaseSens = True 391
StrRepl CaseSens = False 391
TextUtils.Replace CaseSens = True 562
TextUtils.Replace CaseSens = False 563

заменить " " на "_":
StrRepl CaseSens = True 782
StrRepl CaseSens = False 765
TextUtils.Replace CaseSens = True 688
TextUtils.Replace CaseSens = False 687

заменить " " на "12345":
StrRepl CaseSens = True 1109
StrRepl CaseSens = False 1141
TextUtils.Replace CaseSens = True 844
TextUtils.Replace CaseSens = False 875

Вот и делайте выводы.
Но у меня ошибок то нет да и код куда короче.


15-04-2008 09:34
Ну вот ещё для коллекции:
http://www.fastcode.dk/fastcodeproject/fastcodeproject/10.htm


15-04-2008 07:37
>>> Если длина замены меньше длины образца, меняем на месте по ходу поиска, сдвигая все символы ближе к началу.
Учитывая то, что функция позиционировалась для работы со строками большого размера (по сути, с текстом, например, книги, представленным одной строкой), то мне от второго пункта уже стало страшно. Постоянно двигать мегабайт данных -- это уже слишком.
 Geo


15-04-2008 07:03
А кто-нибудь пробовал делать замену без запоминания позиций всех вхождений, а просто искать снова:

1. Если длина образца и замены совпадают, менять строку на месте. Иначе идём дальше.
2. Если длина замены меньше длины образца, меняем на месте по ходу поиска, сдвигая
  все символы ближе к началу. Освобождаем лишнюю память. Иначе идём дальше.
3. Вычисляем новый размер строки.
4. Увеличиваем размер строки до нового размера.
5. Копируем символы по ходу поиска начиная с конца строки в обратном направлении.

Интересно на сколько медленнее она будет работать, чем StrRepl.StrReplace,
при увеличении строки?


14-04-2008 14:55
сообщение от автора материала
Исправил наконец ошибку, на которую указал guest в сообщении 04-10-2005 00:17. Это очевидно ошибка или опечатка Д.Батлера. По ходу заметил еще одну свою ошибку - у Батлера используется символ условной компиляции  CPU_INTEL386, которым он заменил по каким-то причинам стандартный CPU386 и который был введен в другом модуле. Я этого не заметил и в функции MoveMem условие {$IFDEF CPU_INTEL386} не выполнялось и вместо варианта на ассемблере компилировался код по {$ELSE}. Собственно поэтому и происходила "странность" (сообщ. 14-01-2006 18:22), что несмотря на первую ошибку, в самой библиотеке Батлера функция работала правильно - там компилировался ассемблерный вариант.

И в очередной раз повторюсь, рекомендую пользоваться функцией в варианте автора - А.Дрязгова в его библиотеке AcedUtils: http://acedutils.narod.ru/


16-02-2008 06:35
Если кому интересно, обсуждение ошибки, упомянутой в сообщении от 15-02-2008 03:42 на Круглом Столе: »вопрос КС №59475«

Пардон, не увидел что по этому поводу уже есть обсуждение.


16-02-2008 06:32
При замене символов в файле равному 9 Мб. Вылетает ошибка!

Функция использует стек для хранения найденных позиций вхождения. Когда стек исчерпывается.. функция псоответсвенно вывалит StackOverflow. Я когда-то переделал для себя эту функцию под Unicode и исправил там работу со стеком (когда стек заканчивается  - используется куча для хранения данных). Если найду модуль могу выслать.


15-02-2008 14:19
Если кому интересно, обсуждение ошибки, упомянутой в сообщении от 15-02-2008 03:42 на Круглом Столе: »вопрос КС №59475«


15-02-2008 08:12
сообщение от автора материала
В приложеннном модуле осталась неисправленной ошибка, про которую написали в сообщ. от 04-10-2005 00:17 и 14-01-2006 18:22
Нужно в case исправить, поменять местами Source и Dest в каждой строке. Скорей всего причина вашей ошибки в этом. Сейчас проверил на нескольких примерах с исправленным (тогда ещё) модулем, вроде все работает нормально.
Но повторюсь, когда я написал эту заметку, то не был знаком с библиотекой Андрея Дрязгова Qstrings, откуда по сути взята эта функция. Про это в обсуждении уже писали. Рекомендую пользоваться библиотекой acedutils, "наследницей" QStrings: http://acedutils.narod.ru/ ,
а не моим модулем с позаимствованной оттуда функцией.
Честно говоря, сейчас даже не хочется возвращаться и тщательно смотреть и изучать код, собранный  мной из разных модулей у Д. Батлера, если можно взять авторский оригинал, причем не одну функцию, а библиотеку.
Для порядка, я конечно пришлю на сайт модуль с исправленной указанной выше ошибкой и перед этим найду время и пересмотрю весь код.


15-02-2008 03:42
При замене символов в файле равному 9 Мб. Вылетает ошибка!


14-01-2006 18:22
сообщение от автора материала
>>>при замене нескольких фрагментов в одной строке получается черт знает что...
Долго копался, пока не обратил внимание на код, указанный в сообщении 04-10-2005 00:17 (исключал возможные источники ошибки по очереди). Дошло, что действительно странный код: Source - источник, Dest - куда копируется. Поменял их местами в этом месте, заработало нормально (на том, что проверил), хотя полностью логику всех функций не разбирал до мелочей. Самое забавное, что у Батлера работает в первом варианте.

Впрочем, хотя ИМХО библиотека Батлера неплохая,
http://fundementals.sourceforge.net/

тем не менее, как он сам пишет и как тут указывали, эту функцию он позаимствовал у Андрея Дрязгова ("... adapted from a routine by Andrew N. Driazgov" - у него в юните) и можно воспользоваться этой функцией из первых, а не третьих рук.
http://acedutils.narod.ru/


14-01-2006 13:02
Код не рабочий.
Видимо, для исходной и результирующей строки используется один указатель позиции, поэтому при замене нескольких фрагментов в одной строке получается черт знает что...


04-10-2005 00:17
procedure MoveMem(const Source; var Dest; const Count: Integer);
begin
  if Count <= 0 then
    exit;
  if Count > 4 then
    Move(Source, Dest, Count) else
    Case Count of // optimization for small moves
      1 : PByte(@Source)^ := PByte(@Dest)^;
                 ^^^^^^             ^^^^ это шутка ?
      2 : PWord(@Source)^ := PWord(@Dest)^;
      4 : PLongWord(@Source)^ := PLongWord(@Dest)^;
    else
      Move(Source, Dest, Count);
    end;
end;


30-09-2004 12:59
Не "алгоритм один и тот же", а код практически совпадает


30-09-2004 11:20
сообщение от автора материала
действительно, зачем сравнивать разные реализации?
вдруг у Andrew N. Driazgov в qstrings - лучше  

?
Я же написал, что с qstrings просто незнаком. Я думаю, что если алгоритм один и тот же, то разница в скорости если и будет, то незначительная. Дело же не в том, кто лучше, кто хуже, а в том, что в определенных ситуациях, которые действительно встречаются в практике, стандартная функция из Дельфи на порядки медленнее и это неудобно.


30-09-2004 11:06
Объясните, плиз, неграмотному зачем целый параметр в функции объявлять как const? В чём тайный смысл сей записи?

procedure MoveMem(const Source; var Dest; const Count: Integer);


30-09-2004 09:40
действительно, зачем сравнивать разные реализации?
вдруг у Andrew N. Driazgov в qstrings - лучше ?
Сообщение не подписано


29-09-2004 18:51
сообщение от автора материала
Нет, не делалось. Я, честно сказать, не знаю библиотеку QStrings. На описанную функцию наткнулся пару лет назад, пользовался ей, решил вот предложить.


29-09-2004 14:05
Насколько предлагаемая ф-ия эффективнее упомянутого в статье варианта из известной бибилиотеки QStrings A.Driazgov'а? Делалось ли сравнение?
 777


Добавьте свое cообщение

Вашe имя:  [Войти]
Ваш адрес (e-mail):На Королевстве все адреса защищаются от спам-роботов
контрольный вопрос:
Зимой — белый, летом — серый. Кто?
в качестве ответа на вопрос или загадку следует давать только одно слово в именительном падеже и именно в такой форме, как оно используется в оригинале.
Надоело отвечать на странные вопросы? Зарегистрируйтесь на сайте.

Оценка содержания
 
Содержит полезные и(или) интересные сведения
 
Ничего особенно нового и интересного
 
Написано неверно (обязательно укажите почему)


Оценка стиля изложения
 
Все понятно, материал читается легко
 
Есть неясности в изложении
 
Непонятно написано, трудно читается

Текст:
Жирный шрифт  Наклонный шрифт  Подчеркнутый шрифт  Выравнивание по центру  Список  Заголовок  Разделительная линия  Код  Маленький шрифт  Крупный шрифт  Цитирование блока текста  Строчное цитирование
  • вопрос Круглого стола № XXX

  • вопрос № YYY в тесте № XXX Рыцарской Квинтаны

  • сообщение № YYY в теме № XXX Базарной площади
  • обсуждение темы № YYY Базарной площади
  •  
     Правила оформления сообщений на Королевстве
      
    Время на сайте: GMT минус 5 часов

    Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter.
    Функция может не работать в некоторых версиях броузеров.

    Web hosting for this web site provided by DotNetPark (ASP.NET, SharePoint, MS SQL hosting)  
    Software for IIS, Hyper-V, MS SQL. Tools for Windows server administrators. Server migration utilities  

     
    © При использовании любых материалов «Королевства Delphi» необходимо указывать источник информации. Перепечатка авторских статей возможна только при согласии всех авторов и администрации сайта.
    Все используемые на сайте торговые марки являются собственностью их производителей.

    Яндекс цитирования