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

[}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]

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

procedure Vvod(var first:point);
var r, last:point;
begin
  first:= nil; last := nil;

  writeln('HABEPITE C/\OBO C "." HA KOHCE ');
  while r^.ch <> '.' do begin
      new( r );
      r^.next := nil;
      read(r^.ch);

      if first = nil then first := r
      else last^.next := r;

      last := r;
  end;
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 (i <= length(stroka)) and (C[i] <> r^.ch) do inc(i);
  if i <= length(stroka) 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 inc(i)
    else begin
      inc(k); // counter
      i := j;
    end;

  end;
until i > length(stroka);
poisk:=k;
end;

Так лучше работает?

P.S. Измени вывод: у тебя СЛОВО ищется с строке, а не СТРОКА в слове...