Однонаправленные списки Опции

[}0pa]

Помогите, пожалуйста, исправить функцию

Код

Poisk

...
Задача. Использовав, однонаправленные списки, подсчитать кол-во вхождений в слово, заканчивающимся точкой, подстроки, вводимой с клавиатуры...Фукнция поиска таких слов работает лишь для длины подстроки = 1

Код

uses crt;
const n=20;
Type
  point = ^MyWord;
  MyWord = record
    ch: char;
    next: point
  end;
Type massiv = array[1..n] of char;
var
   slovo:point;
   c:char;
   M:massiv;
   stroka: string[100];
   i:integer;
{---------------------------------------------------------------------------}
Procedure VvodEl;
var i:integer;
begin
for i:=1 to length(stroka) do
  begin
   M[i]:=stroka[i];
  end;
end;
{---------------------------------------------------------------------------}
procedure Print (first: point);
Var r: point;
begin
  R:= first;
  write('CLOBO = ');
  While r<>nil do
    begin
      Write (r^.ch);
      R:=r^.Next;
  end;
  writeln;
end;
{---------------------------------------------------------------------------}
procedure Vvod(first:point);
var r:point;
begin
  first:= nil;
  writeln('HABEPITE C/\OBO C "." HA KOHCE ');
  while r^.ch<>'.' do
    begin
      new(r);
      r^.Next:=slovo;
      read(r^.ch);
      slovo:=r;
    end;
end;
{---------------------------------------------------------------------------}

function Poisk(first:point;C:massiv):integer;
var r:point;
   k,j,z:integer;
begin
k:=0;
r:=first;
j:=1;
while (r<>nil) do
begin
  if (r^.ch=c[j]) then
    begin
      if j=length(stroka) then
         begin
          k:=k+1;
          j:=1;
          r:=r^.next
         end
     else
        begin
         r:=r^.next;
         j:=j+1;
         if j>length(stroka) then j:=1;
        end
    end
  else
   begin
    r:=r^.next;
    j:=1;
   end;
end;
poisk:=k;
end;

begin
clrscr;
write('BBEDuTE TEKCT: ');
readln(stroka);
VvodEl;

for i:= 1 to length(stroka) do write(M[i]);

  writeln;
  vvod(slovo);
  print(slovo);
  writeln(stroka,' BCTPE4AETCYA B C/\OBE ',poisk(slovo,M),' PA3');
  readkey;
  end.

[volvo]

Неужели было настолько сложно просто зеркально поменять ту функцию, которую я тебе предложил?

function Poisk(first:point;C:massiv):integer;
var
  p, r:point;
  k,j,z:integer;

  bad: boolean;
begin
  k := 0;
  i := 1;

  r := first;
  repeat

    while (r <> nil) and (C[1] <> r^.ch) do r := r^.next;
    if r <> nil then begin

      j := 1;
      p := r;
      bad := false;
      while (p^.ch <> '.') and (not bad) do begin

        bad := (p^.ch) <> C[j];

        if not bad then begin
          p := p^.next;
          inc(j);
        end;
      end;

      if C[j] <> #0 then r := r^.next
      else begin
        inc(k);
        r := p;
      end;

    end;

  until r = nil;
  poisk:=k;
end;

Моя функция Vvod из поста №2 остается в силе...

Вот результат прогона программы:


Это тебе нужно, или опять что-то не так?