Самое длинное слово (строки)

[isst]

Решаю следующую задачу:

Дана строка. Найдите в этой строке самое длинное слово и выведите его. Если в строке несколько слов одинаковой максимальной длины, выведите первое из них. Решение оформите в виде функции LongestWord (S), возвращающей значение типа str.

Ввод
In a hole in the ground there lived a hobbit.

Вывод
ground

Это №111314 на informatics.mccme.ru

Вот мои попытки:
8 из 22

function LongestWord(s:StRing):StRing;

var rez, buf:StRing;
    count, index:LongInt;

begin
  index:= 1;
  while (index <= Length(s)) do
  begin
    if (s[index] = '.') then Delete(s, index, 1)
    else inc(index);
  end;
  index:= 1;
  rez:= '';
  while (s[index] <> ' ') do
  begin
    rez:= rez + s[index];
    inc(index);
  end;
  count:= Length(rez);
  Delete(s, 1, index);
  while (Length(s) > 0) do
  begin
    index:= 1;
    buf:= '';
    while (index <= Length(s)) and (s[index] <> ' ') do
    begin
      buf:= buf + s[index];
      inc(index);
    end;
    if (Length(buf) > count) then
    begin
      rez:= buf;
      count:= Length(buf);
    end;
    Delete(s, 1, index);
  end;
  LongestWord:= rez;
end;

var s:StRing;

begin
  readln(s);
  writeln(LongestWord(s));
end.

Большинство не пройденных тестов - Ошибка во время выполнения (подозреваю, что где-то за пределы строки вылез, тока не вижу, где)

12 из 22

var
    s: string;
    i, id, len, max, count: byte;
 
begin
    readln(s);
    while (Pos('.', s) > 0) do Delete(s, Pos('.', s), 1);
    while (Pos(',', s) > 0) do Delete(s, Pos(',', s), 1);
    while (s[1] = ' ') do Delete(s, 1, 1);
    while (s[Length(s)] = ' ') do Delete(s, Length(s), 1);
    while (Pos('  ', s) > 0) do Delete(s, Pos('  ', s), 1);
    len := length(s);
    max := 0; // ����� ������ �������� �����
    id := 0; // ������ ������ ������ �������� �����
    count := 0;
    for i:=1 to len do
        if s[i] <> ' ' then
            count := count + 1
        else begin
            if count > max then begin
                max := count;
                id := i - count;
            end;
            count := 0
        end;
 
    if count > max then begin // �������� ���������� �����
        max := count;
        id := len - count + 1;
    end;           
 
    writeln(copy(s,id,max));
end.

Прошу помочь мне разобраться с этой проблемой. Заранее спасибо

[Poma][a]

var
    s: string;
    i, id, len, max, count: byte;
 
begin
    readln(s);
   
    len := length(s);
    max := 0;
    id := 0; 
    count := 0;
    for i:=1 to len do
        if s[i] in ['a'..'z']+['A'..'Z'] then
            count := count + 1
        else begin
            if count > max then begin
                max := count;
                id := i - count;
            end;
            count := 0
        end;
 
    if count > max then begin 
        max := count;
        id := len - count + 1;
    end;           
 
    writeln(copy(s,id,max));
end.

Уже 21 из 22

[isst]

Сообщение от Poma][a

var
    s: string;
    i, id, len, max, count: byte;
 
begin
    readln(s);
   
    len := length(s);
    max := 0;
    id := 0; 
    count := 0;
    for i:=1 to len do
        if not (s[i] in [#0..#255]-['a'..'z']-['A'..'Z']) then
            count := count + 1
        else begin
            if count > max then begin
                max := count;
                id := i - count;
            end;
            count := 0
        end;
 
    if count > max then begin 
        max := count;
        id := len - count + 1;
    end;           
 
    writeln(copy(s,id,max));
end.

Уже 21 из 22

Ром, спешу таки поставить тебя перед фактом. Во-первых, уже решил, спасибо за помощь. Во-вторых, твой код не проходит лишь из-за Byte, нужен Integer, т.к. там видимо строка есть больше 255 (сам на этом засыпался в последний раз) и, соответственно, компилятор PascalABC. Вот мой код, он 100%-ый:

var
  s: string;
  i, id, len, max, count: Integer;

begin
  readln(s);
  i := 1;
  while (i <= Length(s)) do
  begin
    if not (UpCase(s[i]) in ['A'..'Z', ' ']) then s[i] := ' '
    else inc(i);
  end;
  len := length(s);
  max := 0;
  id := 0;
  count := 0;
  for i := 1 to len do 
    if s[i] <> ' ' then
      count := count + 1
    else begin
      if count > max then begin
        max := count;
        id := i - count;
      end;
      count := 0
    end;
  if count > max then begin
    max := count;
    id := len - count + 1;
  end;			
  writeln(copy(s, id, max));
end.

Ну и твой, соответсна, не пашет на ФриПаске, лажает блок удаления всяких "небукв"