Версия для печати темы

Автор: chizuru 21.12.2009 5:36

Помогите, пожалуйста, с задачей.
Дан текстовый файл (слова разделены не менее как одним пробелом). Найти и вывести в новый файл все слова, в которых есть хотя бы одна цифра. Максимальная длина строки в начальном файле - 255 символов, кол-во строк - как минимум две. Для поиска использовать процедуру или функцию...

Пока у меня столько лишь есть... Теоретически-то вроде понятно, а практически - нет...

 function count (stroka: string) :  string;
  const numbers = ['0'..'9'];
  var 
     i, j: integer;
     word, f: string;
     begin
             while length (stroka) > 0 do 
          begin 
            for i:= 1 to length (stroka) do
               if (word [i] in numbers) then 
     	 
{Вот тут уже не знаю как... }

           end;
end;
  
var f1, f2 :text;
      eil, nach, kon : string;

begin    
     writeln ('vvesti nazvanie isxodnogo fajla');
     readln (nach);
     assign (f1, 'input.txt');
     writeln('vvesti nazvanie vyxodnogo fajla');
     readln (kon);
     assign(f2,'output.txt');

  {$I-}
  reset(f1);
   if (ioresult = 0) then begin
      rewrite(f2);
  {$I+}
      if (ioresult = 0) then begin
              while not eof(f1) do begin
            readln(f1, eil);
            writeln(f2, count(eil));
         end;
      close(f2);
    end
   else writeln('nelzia otkryt fajl rezultatov');
  close(f1);
 end
else writeln ('neudalos otkryt isxodnyj fajl');

Автор: Lapp 21.12.2009 10:10

Я написал код (на основе твоего), он делает, что надо, но только:

1. В нем не используются ни процедуры, ни функции. Сделай это сама; если не получится - спрашивай, как.

2. Входной файл я читаю не как text, а как file of char - в данном случае это упрощает задачу. Если этот вариант не годится, все будет сложнее..

3. Я немного упростил структуру проверки файлов, привлекши Halt. Это O'kay?

Задавай вопросы, если что неясно.

var
  f1: file of char;
  f2 :text;
  w, InFile, OutFile: string;
  c: char;
  Dig: boolean;

begin
   write ('vvedite nazvanie isxodnogo fajla: ');
   readln (InFile);
   assign (f1, InFile);
   write('vvedite nazvanie vyxodnogo fajla: ');
   readln (OutFile);
   assign(f2, OutFile);

  {$I-} reset(f1); {$I+}
  if (ioresult >0) then begin
    WriteLn('Could not open the input file, quitting now');
    Halt
  end;
  {$I+}  {$I-} rewrite(f2); {$I+}
  if (ioresult >0) then begin
    WriteLn('Could not open a file for output, exiting');
    Halt
  end;
  Dig:=false;
  while not eof(f1) do begin
    read(f1, c);
    case c of
      'a'..'z','A'..'Z','_': w:=w+c;
      '0'..'9': begin
        w:=w+c;
        Dig:=true
      end;
      else begin
        if Dig then begin
          WriteLn(f2, w);
          Dig:=false
        end;
        w:='';
      end
    end;
  end;
  close(f2);
  close(f1);
  WriteLn('The output file ',OutFile,' has been created.  Push Enter');
  ReadLn
end.

Автор: andriano 21.12.2009 15:16

Какая-то славянофобская программа, почему она игнорирует кириллицу?

Автор: Lapp 21.12.2009 15:52

Автор темы писала интерфейс на латинице, вот я и решил, что так тому и быть )). Расширение на кириллицу можно добавить в тот мой список, 4-м пунктом.

Автор: andriano 21.12.2009 16:30

Ну, латинница в консольном приложении - мера, вынужденная несоблюдением Майкрософт ГОСТ 19768-87.
К содержимому файла, который будет обрабатываться программой, это никакого отношения не имеет.
Вообще же я только обратил внимание chizuru, что в данной редакции программа может неверно обрабатывать файлы, предложенные ей в качестве тестовых.
И полностью согласен насчет 4-го пункта.

Автор: chizuru 22.12.2009 3:04

Lapp, Большое спасибо за помощь!!! Доделала и с процедурой.