Poisk

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.

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

   bad: boolean;
begin
  k := 0;
  i := 1;
repeat
  r := first;
  while (r<>nil) and (C[i] <> r^.ch) do r:=r^.next;
  if r<>nil then begin
    j := i;
    bad := false;
    while (r^.ch <> '.') and (not bad) do begin

      bad := (r^.ch) <> C[j];
      r := r^.next;
      inc(j);
    end;

    if bad then r:=r^.next;
    else begin
      inc(k);
      i := j;
    end;

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

if not bad then begin