Из текста выделить все слова, содержащие буквы, входящие в первое слово этого текста

var
  s: string;
  i, j, g, k: integer;
  buf: string;
  temp: string;
  pSlovo: string;
  npos: integer;
 
begin
  writeln('Введите строку: ');
  readln(s);
  {-- Проверяем количество слов --}
  while pos('  ', s) > 0 do
    delete(s, pos('  ', s), 1);
  s := s + ' ';
  for i := 1 to length(s) do
    if s[i] = ' ' then inc(k);
  if k > 10 then begin
    writeln('Количество слов превышает требуемый!');
    exit;
  end;
  {-- Считываем первое слово --}
  for i := 1 to length(s) do
    if s[i] <> ' ' then pSlovo := pSlovo + s[i] else begin
      npos := i;
      break;
    end;
  writeln('Первое слово: ', pSlovo);
  {-- Выполняем основное условие --}
  for i := npos + 1 to length(s) do
    if s[i] <> ' ' then buf := buf + s[i] else begin
      //Если s[i]=' ' то
      if length(buf) < length(pSlovo) then begin
        for j := 1 to length(buf) do 
        begin
          for g := 1 to length(pSlovo) do
            if buf[j] = pSlovo[g] then begin
              writeln(buf);
              break;
            end;
          break;
        end;
        buf := '';  
      end else begin
        for j := 1 to length(pSlovo) do 
        begin
          for g := 1 to length(buf) do
            if buf[g] = pSlovo[j] then begin
              writeln(buf);
              break;
            end;
          break;
        end;
        buf := ''; 
      end;
    end;
end.

n:=length(s);
  if s[n]<>' ' then s:=s+' ';

var
  s: string;
  i, k: integer;
  n: integer;
  buf: string;
  f_out: text;
 
begin
  assign(f_out, 'output.txt');
  rewrite(f_out);
  writeln('Введите строку: ');
  readln(s);
  writeln(f_out, 'Исходная строка:');
  writeln(f_out, s);
  writeln(f_out);
  writeln(f_out, 'Результаты:');
  while pos('  ', s) > 0 do
    delete(s, pos('  ', s), 1);
  n := length(s);
  if s[n] <> ' ' then s := s + ' ';
  for i := 1 to length(s) do
    if s[i] = ' ' then inc(k);
  if k < 13 then begin
    writeln(f_out, 'Количество слов не соответствует требуемому!');
    exit;
  end;
  for i := 1 to length(s) do
    if s[i] <> ' ' then buf := buf + s[i] else
    begin
      if (length(buf) > 5) and (length(buf) < 8) then writeln(f_out, buf);
      buf := '';      
    end;
  close(f_out);
end.

uses crt;
const n=3;
      tgod=2012;
 
type trains = record
     katg: string[15];
     nome: string[8];
     godr: integer;
     kolv: byte;
     end;
 
var t:array [1..n] of trains;
    i,r:integer;
 
begin
writeln('Введите данные о поездах: ');
for i:=1 to n do
    with t[i] do
         begin
         writeln('Категория ',i,' поезда: ');
         writeln('1 - скорый, 2 - пассажирский, 3 - грузовой ');
         repeat
         readln(r);
         until r in [1..3];
         case r of
         1: katg:='скорый';
         2: katg:='пассажирский';
         3: katg:='грузовой';
         end;
         write('Номер состава: '); readln(nome);
         write('Год последнего текущего ремента: '); readln(godr);
         write('Количество вагонов: '); read(kolv);
         end;
clrscr;
writeln('Список поездов, для которых срок службы ');
writeln('после последнего ремента превышает 2 года ');
r:=0;
for i:=1 to n do
    with t[i] do
         if tgod-godr>2 then
            begin
            inc(r);
            if r=1 then
               begin
               writeln('-----------------------------------------------------');
               writeln('|','Категория':15,'|':3,' Номер':9,'|':3,'Ремонт':8,'|':3,'Вагонов':8,'|':3);
               end;
            writeln('-----------------------------------------------------');
            writeln('|',katg:15,'|':3,nome:9,'|':3,godr:8,'|':3,kolv:8,'|':3);
            end;
if r>0 then
   begin
   writeln('-----------------------------------------------------');
   writeln('Общее количество ',r,' поезд(а/ов)');
   end else
   writeln('отсутствуют');
writeln('press any key to continue');
readln;
clrscr;
writeln('Список грузовых поездов с количеством вагонов от 50 до 100 ');
r:=0;
for i:=1 to n do
    with t[i] do
         if (katg='грузовой') and (kolv>49) and (kolv<101) then
            begin
            inc(r);
            if r=1 then
               begin
               writeln('-----------------------------------------------------');
               writeln('|','Категория':15,'|':3,' Номер':9,'|':3,'Ремонт':8,'|':3,'Вагонов':8,'|':3);
               end;
            writeln('-----------------------------------------------------');
            writeln('|',katg:15,'|':3,nome:9,'|':3,godr:8,'|':3,kolv:8,'|':3);
            end;
if r>0 then
   begin
   writeln('-----------------------------------------------------');
   writeln('Общее количество ',r,' поезд(а/ов)');
   end else
   writeln('отсутствуют');
end.

uses crt;
const n=3;
      line='---------------------------------------------------------------';
      shap='|        Фирма        |Изготовлено|  Продано  |    Выручка    |';
 
type firma = record
     nome: string[18];
     koiA: integer;
     koiB: integer;
     kopA: integer;
     kopB: integer;
     end;
 
var f:array [1..n] of firma;
    i,imin:integer;
    vmin,zA,zB,vyr: real;
 
begin
writeln('Введите данные о фирмах-производителях: ');
for i:=1 to n do
    with f[i] do
         begin
         write('Название ',i,' фирмы: '); readln(nome);
         writeln('Количество изделий, изготовленных фирмой за месяц: ');
         write('- категории А '); readln(koiA);
         write('- категории B '); readln(koiB);
         writeln('Количество изделий, проданных за месяц: ');
         write('- категории А '); readln(kopA);
         write('- категории B '); readln(kopB);
         end;
write('Цена изделия категории А: '); readln(zA);
write('Цена изделия категории B: '); read(zB);
clrscr;
writeln('Выручка фирм от продажи изделий категории А: ');
writeln(line);
writeln(shap);
writeln(line);
imin:=1; vmin:=f[1].kopa*za;
vyr:=0;
for i:=1 to n do
    with f[i] do
         begin
         writeln('|',nome:19,'|':3,koia:9,'|':3,kopa:9,'|':3,za*kopa:12:2,'|':4);
         writeln(line);
         if kopa*za<vmin then
            begin
            vmin:=kopa*za;
            imin:=i;
            end;
         vyr:=vyr+(kopa*za);
         end;
writeln('Суммарная выручка фирм от продажи изделия А: ',vyr:8:2);
writeln('Мин.выручку, равную ',vmin:8:2,', за изделие А получила фирма ',f[imin].nome);
writeln('press any key to continue');
readln;
clrscr;
writeln('Выручка фирм от продажи изделий категории B: ');
writeln(line);
writeln(shap);
writeln(line);
imin:=1; vmin:=f[1].kopb*zb;
vyr:=0;
for i:=1 to n do
    with f[i] do
         begin
         writeln('|',nome:19,'|':3,koib:9,'|':3,kopb:9,'|':3,zb*kopb:12:2,'|':4);
         writeln(line);
         if kopb*zb<vmin then
            begin
            vmin:=kopb*zb;
            imin:=i;
            end;
         vyr:=vyr+(kopb*zb);
         end;
writeln('Суммарная выручка фирм от продажи изделия B: ',vyr:8:2);
writeln('Мин.выручку, равную ',vmin:8:2,', за изделие B получила фирма ',f[imin].nome);
end.

var s,s1,sl:string;
    f,g:text;
    i,k: integer;
 
 begin
 assign(f,'C:\in.txt');
 assign(g,'C:\out.txt');
 repeat
 writeln('Введите текст, не более 10 слов');
 readln(s);
 for i:=1 to length(s) do
     if s[i]=' ' then inc(k);
 if k+1>10 then writeln('Нарушено условие, текст состоит более чем из 10 слов!');
 until k<11;
 rewrite(f);
 writeln(f,s);
 writeln('Текст записан в файл');
 reset(f);
 rewrite(g);
 readln(f,s);
 s:=s+' ';
 i:=1;  s1:='';
 repeat
 s1:=s1+s[i];
 inc(i);
 until (s[i]=' ') or (i>length(s));
 writeln('Первое слово:',s1); sl:='';
 for i:=length(s1)+1 to length(s) do
     if s[i]<>' ' then sl:=sl+s[i] else
        if length(sl)>0 then
        begin
        for k:=1 to length(sl) do
            if pos(sl[k],s1)<>0 then
               begin
               write(g,sl+' ');
               break;
               end;
        sl:='';
        end;
 close(f);
 close(g);
 end.