Реализовать удаление подстроки из строки (не используя функций для работы со строками) - Pascal

[hunter_321]

Нужно реализовать процедуру удаления подстроки из данной строки не используя стандартных функций работы над строками(delete, insert и т.д) вот наброски но пока что не работает

var
  s1: string; 
  s2: string; 
  s3: string;
  i, j, k: byte;
  flag: boolean;
 
begin
  k := 0;
  s3 := '';
  flag := false;
  i := 1;
  j := 1;
  while i >= length(s1) do
    while j >= length(s2) do 
      if s1[i] <> s2[j] then
      begin
        flag := true;
        while j >= length(s2) - 1 do j := j + 1;
      end
      else
      begin
        flag := false;
        while i >= length(s1) - 1 do i := i + 1;
        j := 1;
      end;
    if flag then
    begin
      inc(k);
      s3 := s3 + s1[i];
    end;
  write(s3)
end.

[min@y™]

Строка - это непрерывный массив в памяти. Поэтому юзай move() и не мучайся.

[hunter_321]

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

[min@y™]

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

Ну так и я про то же.

[Stilet]

Нужно реализовать процедуру удаления подстроки

var s,s2,r:string; i,j,k:integer;
...
s:='строка'; s2:='подстрока'; r:='';
i:=1; while i<=Length(s) do begin
 if s[i]<>s2[1] then begin r[j]:=s[i]; inc(j); end else begin
  k:=1; while (s[i+k]=s2[k]) and (k<=Length(s2)) do inc(k);
  if k=length(s2) then inc(i,k);
 end;
 inc(i);
end;
...
Выводим r

Вот так вот я представляю себе это дело...

[Aleksandr H.]

Stilet, в каком паскале работает структура

r:='';
r[j]=s[i]

?

мой вариант на многа букаф

Function MyDelete(txt,subtxt:string):String;
var s,s3:string;
    i,ls2,j : integer;
begin
  i:=1;s:='';s3:='';
  ls2:=length(subtxt);
  while i<=length(txt) do
  begin
   if txt[i] <> subtxt[1] then
    begin
     s:=s+txt[i];
     inc(i)
    end
   else
     begin
         s3 := '';
         for j:=1 to ls2 do
          begin
            if txt[i+j-1] <> subtxt[j] then  break;
            s3 := s3+txt[i+j-1];
          end;
         if subtxt <> s3 then s := s + s3;
         inc(i,length(s3))
     end;
 end;
 MyDelete:=s;
end;

[Stilet]

Тупанул. Хотел написать так:

r=r+s[i]

Видимо что-то отвлекло )))

[min@y™]

Да чо вы, в натуре ваще?

procedure DeleteEx(var S: string; const Index, Count: Integer);
var
  L: Integer;
begin
  L:= Length(S);
  if (L = 0) or (Count <= 0) or (Index > L)
    then Exit;
  Move(S[Index + Count], S[Index], SizeOf(Char) * (L - Index - Count + 1));
  S[L - Count + 1]:= #0;
end;

Ни одной строковой функции!
СЛАВА МНЕ!!!

Скачать демо-прогу с исходником.

[min@y™]

Ну а если быть совсем честным и выкинуть inline compiler magic "Length()"...

procedure DeleteEx(var S: string; const Index, Count: Integer);
var
  L: Integer;
  p: PChar;
begin
  p:= PChar(S);
  while p^ <> #0 do inc(p);
  L:= p - PChar(S);

  if (L = 0) or (Count <= 0) or (Index > L) or (Count > L + 1 - Index)
    then Exit;
  Move(S[Index + Count], S[Index], SizeOf(Char) * (L - Index - Count + 1));
  S[L - Count + 1]:= #0;
end;

Задача решена, ура, землекопа 1.5!

[Serge_Bliznykov]

Дядь Миш, а ложечку дёгтя можно?


1) код из пост #9 не компилируется в Turbo Pascal, PascalABC, PascalABC.NET
2) код из пост #8 не компилируется в PascalABC, PascalABC.NET

3) обе процедуры работают неверно (проверял в TurboPascal, Delphi 2006):

program Project18;

{$APPTYPE CONSOLE}

uses
  SysUtils;


procedure DeleteEx(var S: string; const Index, Count: Integer);
var
  L: Integer;
  p: PChar;
begin
  p:= PChar(S);
  while p^ <> #0 do inc(p);
  L:= p - PChar(S);

  if (L = 0) or (Count <= 0) or (Index > L) or (Count > L + 1 - Index)
    then Exit;
  Move(S[Index + Count], S[Index], SizeOf(Char) * (L - Index - Count + 1));
  S[L - Count + 1]:= #0;
end;


(*
procedure DeleteEx(var S: string; const Index, Count: Integer);
var
  L: Integer;
begin
  L:= Length(S);
  if (L = 0) or (Count <= 0) or (Index > L)
    then Exit;
  Move(S[Index + Count], S[Index], SizeOf(Char) * (L - Index - Count + 1));
  S[L - Count + 1]:= #0;
end;
*)

var s: string;
begin
  s:='123456789';
  DeleteEx(s, 2, 5);
  WriteLn(s);
  ReadLn
end.

результат:

1789 6789