Опять не могу разобраться с задачей

[biowoooooolf]

Всем доброго времени суток.
Опять не могу разобраться с задачей помогите пожалуйста
Вот текст задачи (Для заданного текста определить длину содержащейся в нем максимальной серии символов, отличных от букв).
Вот что у меня получилось:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
    d:text;
 x,n,m,i:integer;
  v, c,  k,j,j1:string;
const
    znak=['А','Б','В','Г','Д','Е','Ж','З',
    'И','К','Л','М','Н','О','П','Р','С','Т',
    'У','Ф','Х','Ц','Ч','Ш','Щ','Э','Я','A',
    'B','C','D','E','F','G','H','I','J','K',
    'L','M','N','O','P','Q','R','S','T','U',
    'V','W','X','Y','Z'];
begin
    i:=0;
    k:='';
    assign(d,'D:\t.txt') ;
    writeln(d,j);
    reset(d);
    readln(c);
    m:=pos(d,k);
    j1:=inttostr  (c);
    x:=length(d,j1);
        while not eof(d) do
        begin
        v:=copy(c,m+1,x-m);
        if znak<>v then repeat i:=i+1 until v=k ;
        if n<i then n:=i else n:=n;
        end;
    writeln (n,v);
    read;
    close(d);
end.

На всякий случай текст программы с помощью которой создаю сам файл с текстом.

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

Var
	d:text;
  i:byte;
  j:string;

begin
	assign
		(d,'D:\d.txt');
Rewrite  (d);
 for i:= 1  to 1 do

     begin
  Writeln ('text');
	Readln(j);
  writeln  (d,j)
  end;
  Close (d);
End.

Заранее всем спасибо)))

[mss]

Полнейшая ахинея в твоем алгоритме.

[biowoooooolf]

ясно ...........

[Летучий_СкилетиК]

так:

uses crt;
var
    m : set of char;
    i,j,k,max:integer;
    a:string;
begin
     read(a);
     m:=['a'..'z','A'..'Z','а'..'я','А'..'Я'];
     i := 1;
     max:=0;
     while (i <= length(a)) do
     begin
          while ((a[i] in m) and (i <= length(a))) do
             inc (i);
          k := 0;
          while (not(a[i] in m) and (i <= length(a))) do
          begin
              inc(k);
              inc(i);
          end;
          if max < k then max := k;
     end;
write(max);
end.