Найти и сохранить в строке те слова, в которых цифры и буквы латинского алфавита чередуются

program EvgeniiSp;
uses Crt;
var
 st: string;
//----------------------
 procedure InputData;
  begin
   writeln('Ââåäèòå ñòðîêó(òî÷êà â êîíöå ñòðîêè îáÿçàòåëüíà):');
   readln(st);
  end;
//----------------------
 procedure AnalysisData;
  var
   i: byte;
   flag: boolean;
   word,symb: string;
   chars,numb: set of char;
  begin
   numb:=['0'..'9'];
   chars:=['0'..'9','A'..'Z'];
   for i:=1 to length(st) do
    begin
     word:='';
     flag:=true;
     while (st[i]<>' ') and (st[i]<>'.') do
      begin
       word:=word+st[i];
       st[i]:=UpCase(st[i]);
       if st[i] in chars
        then if st[i] in numb
              then symb:=symb+'+' else symb:=symb+'-';
       if symb[length(symb)-1] = symb[length(symb)] then flag:=false;
       i:=i+1;
      end;
     if flag = true then writeln(word);
    end;
  end;
  
begin
 ClrScr;
 InputData;
 AnalysisData;
end.

program EvgeniiSp;
uses Crt;
var
 st: string;
//----------------------
 procedure InputData;
  begin
   writeln('Ââåäèòå ñòðîêó(òî÷êà â êîíöå ñòðîêè îáÿçàòåëüíà):');
   readln(st);
  end;
//----------------------
 procedure AnalysisData;
  var
   i: byte;
   flag: boolean;
   words,word,symb: string;
   chars,numb: set of char;
  begin
   numb:=['0'..'9'];
   chars:=['0'..'9','A'..'Z'];
   for i:=0 to length(st) do
    begin
     word:='';
     symb:=' ';
     flag:=true;
     while (st[i]<>' ') and (st[i]<>'.') do
      begin
       word:=word+st[i];
       st[i]:=UpCase(st[i]);
       if st[i] in chars
        then if st[i] in numb
              then symb:=symb+'+' else symb:=symb+'-';
       if symb[length(symb)-1] = symb[length(symb)] then flag:=false;
       i:=i+1;
      end;
     if flag = true then words:=words+' '+word;
    end;
   write(words,'.');
  end;
 
begin
 ClrScr;
 InputData;
 AnalysisData;
end.

uses crt;
const bk=['A'..'Z','a'..'z'];{множество латинских букв}
         cf=['0'..'9'];{множество цифр}
procedure Vvod(var s:string);{ввод строки с проверкой правильности ввода}
var i,k:byte;
begin
repeat
writeln;
writeln('Введите строку из латинских букв и цифр,':60);
writeln('слова разделены пробелами, в конце точка':60);
readln(s);
k:=0;
for i:=1 to length(s)-1 do{смотрим до точки(если она есть)}
if (not (s[i] in bk))and(not(s[i] in cf))and(s[i]<>' ') then{если не латинские буквы, цифры и пробелы}
 begin
  k:=1;
  break;
 end;
if k=1 then writeln('Введены недопустимые символы!');
if pos(' ',s)=0 then writeln('В строке нет пробелов!');
if (s[1]=' ')or(s[length(s)-1]=' ')then writeln('Пробел стоит не на месте!');{если пробел первый, или перед точкой}
if s[length(s)]<>'.' then writeln('Строка не оканчивается точкой!');
if (k=1)or(pos(' ',s)=0)or(s[1]=' ')or(s[length(s)]<>'.')or(s[length(s)-1]=' ')
then writeln('Повторите ввод.');
until(k=0)and(pos(' ',s)<>0)and(s[1]<>' ')and(s[length(s)]='.')and(s[length(s)-1]<>' ');{если все нормально, заканчиваем ввод}
end;
procedure NewStr(s:string;var s2:string);{основная процедура, преобразование строки}
var i,j,k,l:byte;
    s1:string;
begin
i:=1;{первый символ}
s2:='';{новая строка}
while i<=length(s) do{идем по строке}
if (s[i]<>' ')and(s[i]<>'.')then{если не пробел и не точка}
 begin
  j:=i;s1:='';{начинаем составлять слово}
  while (s[j]<>' ')and(s[j]<>'.')do{пока не пробел и не точка}
    begin
     s1:=s1+s[j];{составляем}
     j:=j+1;
    end;
  k:=0;
  for l:=1 to length(s1)-1 do{смотрим от первого до предпоследнего символа}
  if ((s1[l] in cf)and(s1[l+1] in cf))or((s1[l] in bk)and(s1[l+1] in bk)) then{если рядом буквы или цифры}
  k:=k+1;{считаем}
  if k=0 then s2:=s2+s1;{если нет такого, записываем слово в новую строку}
  i:=i+length(s1);{перепрыгиваем через слово к следующему}
 end
else
 begin
  s2:=s2+s[i];{иначе записываем символ(пробел или точка)в новую строку}
  i:=i+1;{к следующему символу} 
 end;
k:=0;
for i:=1 to length(s2) do{смотрим получившуюсю строку }
if(s2[i] in bk)or(s2[i] in cf) then k:=k+1;{считаем буквы и цифры}
if k=0 then write('Все слова удалены!')
else write(s2);{иначе выводим строку}
readln
end;
var st,new:string;
begin
clrscr;
Vvod(st);
NewStr(st,new);
end.

uses crt;
const
    lat=['A'..'Z','a'..'z'];{//Множество латинских букв}
    numb=['0'..'9'];{//Множество цифр}
var s,temp:string;k,i,j,l:byte;p1:boolean;
function kolsl(s:string):byte;var i,b:byte;{//Количество слов в предложении}
begin
    b:=0;
    for i:=1 to length(s) do
    if s[i]=' ' then inc(b);
    kolsl:=b+1;
end;
procedure del_space(var s:string);{//Удаляем все пробелы, и точку(если она есть)}
var i,j:byte;
begin
    for i:=1 to length(s)-1 do
    if(s[i]=' ')and(s[i+1]=' ')then
    while s[i+1]=' ' do
    delete(s,i+1,1);
    if pos('.',s)<>0 then
    delete(s,length(s),1);
end;
function slovo(s:string;a:byte;var f:byte):string;{//Берём из предложения слово}
var s1:string;j,l:byte;begin j:=0;f:=0;
for l:=1 to a do
begin
    s1:='';inc(j);f:=j;
while(s[j]<>' ')and(j<>length(s)+1)do
begin
    s1:=s1+s[j];
    inc(j);
end;
end;
    slovo:=s1;end;
begin clrscr;
    write('Stroka: ');
    readln(s);
    del_space(s);
    i:=1;
    while i<=kolsl(s) do{//Пока все слова не проверены}
    begin
        temp:=slovo(s,i,k);{//Записываем слово}
        l:=length(temp);{//Длина слова}
        p1:=true;
        {//Анализ}
        for j:=1 to l do
        if((temp[j] in lat)and(temp[j+1] in numb))or
        ((temp[j] in numb)and(temp[j+1] in lat))then
                p1:=true
                else if(j<>l)then begin
                p1:=false;
                break;end;
        {//Если слово нам не нужно, удаляем его}
        if(p1=false)or(l mod 2=1)then delete(s,k,l+1)
        {//Иначе, ищем следующее слово}
        else inc(i);
    end;
    {//Выводим оставшиеся слова}
    writeln('Stroka:',s);
    readkey;
end.

procedure del_space(var s:string);{//Удаляем все пробелы, и точку(если она есть)}