Файлы Турбо Паскаля

Начнём этот раздел с небольшого замечания о том, что часто бывает удобно отдельные виды обработки файлов оформлять как отдельные процедуры. В число формальных параметров таких процедур обычно включается или имя файловой переменной (обязательно передоваемой по ссылке, т.е. VAR !), или стринг, определяющий физическое имя обрабатываемого в процедуре файла.

В первом случае (передаётся файловая переменная) файл может описываться и привязываться (возможно, и открываться) в главной программе, а во втором - всё это может делаться в подпрограмме, в которой соответствующая файловая переменная локальна.

В качестве примера, воспроизведём здесь вариат уже представленного на сайте решения следующей сформулированной мною на лекции задачи:

Задача "Треугольник". Написать программу, которая формирует по заданному натуральному N, текстовый файл следующей треугольной структуры :
1
2 3
4 5 6
7 8 9 10
...
Каждая следующая строка этого файла содержит на один элемет больше предыдущей, а последней считается та, в которую попадёт заданное натуральное N.

  1. Program txtFileOut;
  2.    // обошлись без переменных!
  3.     procedure triangle(n:integer; var f: Text);
  4.         Var i, inLn, lnCount: LongInt;
  5.     Begin
  6.         i:=1;  // значение первого элемента
  7.         inLn:=1; // число элементов в 1-й строке
  8.         Repeat
  9.            For lnCount:=1 to inLn Do Begin  // формируем строку
  10.               Write(f,i:3); Inc(i)
  11.            End;
  12.            WriteLn(f); // к следующей строке ...
  13.            Inc(inLn); //... в которой будет на один элемент больше
  14.         Until i>n;
  15.     End;
  16.  
  17. Begin
  18.    triangle(20, output);
  19.    readln;
  20. End.

Заметьте, для проверки решающей задачу процедуры в главной программе использован стандартный текстовый файл output. Это позволяет обойтись без его описания, привязки и открытия в главной программе. Правда, результат мы получим на экране, а не на диске. Запустите и убедитесь что всё работает!
Теперь измените главную программу с тем, чтобы файл выводился на диск. И снова проверьте!

Вот несколько типовых задач, понимание решения которых гарантирует успех в контрольной работе по данной теме:

Задача fl1. Дана входная последовательность натуральных чисел, завершающаяся нулём. Написать процедуру, позволяющую ввести эту последователность с клавиатуры и переписать её в выходной файл, который можно было бы далее просмотреть с помощью Блокнота. Дополнить решение вызывающей программой.

Задача fl2. В Блокноте набран и сохранён под именем 'ttt.txt' текстовый файл, содержащий по одному символу (Char) в каждой строке. Длина файла не превышает 255. Написать программу, которая читает этот файл как типизированный и формирует объединяющий все его символы стринг.

Задача fl3. В Блокноте набран и сохранён под именем 'D.txt' текстовый файл, содержащий по одному символу (Char) в каждой строке. Длина файла произвольна. Написать программу, которая читает этот файл и формирует на его основе файл 'R.txt' в котором символы исходного файла расположены в обатном порядке.

Задача fl4. Описать функцию, которая по данному текстовому файлу определяет число содержащихся в ней строк.

Задача fl5.Для задаваемых M, N <= 20 сформировать матрицу A(M,N) из случайных натуральных значений (меньших ста) и вывести её построчно (т.е. в "естественном" виде), в текстовый файл. Проверить результат вывода в Блокноте.

Задача fl6.Матрицу, сформированную в задаче fl5 ввести из файла и вывести в транспонированном виде на экран.

Fl3

Еще один вариант задачи Fl3, но и он выводит лишние пробелы(

  1. program FL3;
  2.   var i,t:longint;
  3.       n:char;
  4.       f,d:file of char;
  5.       S,L:string;
  6.  
  7. begin
  8.    assign(f,'F.txt');
  9.    reset(f);
  10.    assign(d,'D.txt');
  11.    rewrite(d);
  12.    S:='';
  13.    for i:=4 to filesize(f) do begin
  14.       if (n<>'#13') or (n<>'#10') then
  15.         read(f,n);
  16.         s:=s+n;
  17.    end;
  18.    for i:=length(s) downto 1 do begin
  19.      write(d,S[i],#13,#10);
  20.    end;
  21.   close(f);
  22.   close(d);
  23. end.

Ксения

Попробуй заменить с 13 по 17 строки своего кода, на этот код:

  1. for i:=1 to filesize(f) do begin
  2.        read(f,n);
  3.        if n<>#13 then if n<>#10 then s:=s+n;
  4.  end;

Ксения

По поводу строки 14, скажу что ты не можешь проверить n до тех пор, пока ты его не считаешь из файла...
Но опять же, ситуация заключается в том, что файл может иметь произвольное количество символов, а стринг ограничен 256 байтами...

Я попробую. Просто возникла

Я попробую. Просто возникла мысль-почему выводятся пробелы лишние и как их устранить, но что-то не видно,что она работает.Хорошо,я попробую

Валентин

Условие для добавления стринга можно записать иначе: if (n<>#13) and (n<>#10) then s:=s+n;

В постах каждого из четырёх

В постах каждого из четырёх участников последней дискуссии есть элементы здравого смысла. Не вдаваясь пока в подробности представленных реализаций, сделаю несколько общих замечаний.
1. Программист не вправе упрощать УСЛОВИЕ задачи (оно диктуется заказчиком) в угоду простоты реализации. Упрощайте в рамках условия. Если в задаче fl5 не выводились размерности, то их не следует ожидать и во входных данных задачи fl6.
2. Принимаю предлагаемую Валентином отфильтровку управляющих символов перед выводом в результирующий файл. А вот по структуре цикла с брейками полностью согласен с Дмитрием.
3. Решение Дмитрия fl5 некорректно, т.к. выводит в каждой строке неструктурированный поток цифр, который затем невозможно интерпретировать при последующем вводе в fl6.
4. Длиные коды, Дмитрий, по-прежнему не читаю (где модульность?!!).

P.S. Подключение ещё одного (к тому же, толкового) студента к активу могу только приветствовать. Свои несколько баллов, Дмитрий, Вы заработали. Кстати, где сегодня Никита?

Никита и Сурен уехали на

Никита и Сурен уехали на олимпиаду:-)

Ксения, условие (n<>'#13') or

Ксения, условие (n<>'#13') or (n<>'#10') истинно всегда! Любой символ либо не равен #13 либо не равен #10.
Кстати, ещё ошибка: '#13' - это трёхсимвольный String, а вот #13 - это Сhar.

В своем коде я отделяю модули

В своем коде я отделяю модули пустыми линиями, вроде все наглядно... ну а большой код в силу сложности задачи.

Дмитрий

Модульность, означает разбиение программы на процедуры и функции...

У Вас своебразное толкование

У Вас своебразное толкование модуля, Дмитрий. Настоятельно рекомендуемая мною длина кода МОДУЛЯ (программы, подпрограммы, юнита) 25-30 строк при любой сложности задачи.

Как говорил Валерий

Как говорил Валерий Шахамболетович, любую программу можно превратить в подпрограмму, на общую длину кода это не повлияет. И тем более, если мы не используем одно и то же действие более одного раза и нас не просят написать отдельно функции и процедуры, зачем это делать? (хотя, конечно, можно)

Дмитрий

Дело не только в многократном использовании участка кода, а в наведении порядка в своем коде, чтобы сам потом не запутался...

Валентин

Если присмотреться, в моем коде есть определенная закономерность, основные части программы как то отделены, "кирпичом" не пишу - соблюдаю элегантность (если это можно так назвать). Призываю всех писать красиво, а не только правильно!

Дело далеко не только в

Дело далеко не только в повторах.
Грамотно построенный модуль должен быть как компактен, так и функционально обособлен, что позволяет легко его понять, независимо оттестировать, а если понадобится - скорректировать, не затрагивая других частей кода. Помодульно разрабатывать, собирать и демонстрировать программу состоящую из автономных модулей - единственный путь преодаления возрастающей её сложности. Вот это я тоже говорил.
Мне казалось, это понимают уже все.

Очень жаль, Дмитрий, что Вы

Очень жаль, Дмитрий, что Вы не разобрались в технологии разработки проектов SetCalc и LogCalc ...

Вариант решения 6 задачи

Вот вариант решения 6 задачи с помощью функций и процедур

  1. program fl6;
  2. type mass=array [1..20, 1..20] of byte;
  3. var a,b:mass;
  4.     strok,chisel,i,j:byte;
  5.     mass_f:text;
  6.     s:string;
  7.  
  8. function kol_strok(var c:text):byte;
  9.   var i:byte;
  10. begin
  11.   reset(c);  //открываем файл заново для подсчета всех строк
  12.   i:=0;
  13.   while (not eof(c)) do begin
  14.     readln(c);
  15.     inc(i);
  16.   end;
  17.   kol_strok:=i;
  18. end;
  19.  
  20. function kol_chisel(var s:string):byte;
  21.   var i,p:byte;
  22. begin
  23.   i:=0;
  24.   while (pos(' ',s)<>0) do begin
  25.     p:=pos(' ',s);
  26.     inc(i);
  27.     delete(s,1,p);
  28.   end;
  29.   kol_chisel:=i+1;
  30. end;
  31.  
  32. procedure print_mass(m,n:byte; var k:mass);
  33.   var i,j:byte;
  34. begin
  35.   for I := 1 to m do begin
  36.     for J := 1 to n do write(k[i,j]:3);
  37.     writeln;
  38.   end;
  39. end;
  40.  
  41. begin
  42.   assign(mass_f,'mass_f.txt');
  43.   reset(mass_f);
  44.   readln(mass_f,s);  //считываем строку для подсчета количества элементов
  45.   chisel:=kol_chisel(s);  //передаем эту самую строку.
  46.   strok:=kol_strok(mass_f);
  47.   close(mass_f);
  48.   reset(mass_f);
  49.  
  50.   for I := 1 to strok do begin
  51.     for J := 1 to chisel do read(mass_f, a[i,j]);  //считывание матрицы
  52.     readln(mass_f);
  53.   end;
  54.  
  55.   writeln('Исходные данные:');
  56.   print_mass(strok,chisel,a);
  57.  
  58.   for I := 1 to chisel do begin
  59.     for J := 1 to strok do b[i,j]:=a[j,i];  //транспонирование
  60.   end;
  61.  
  62.   writeln('Результат:');
  63.   print_mass(chisel,strok,b);
  64.   close(mass_f);
  65. end.

Как сократить код - не знаю, ибо тут ничего лишнего вроде нету.

Валерий Шахамболетивич,

Валерий Шахамболетивич, сегодня на лабораторном занятии, как одно из заданий, вы дали задачу и разрешили выложить её решение на сайт, чтобы разобрались те, кому непонятно как её решать. Условие задачи: создать текстовый файл, состоящий из 30 строк, в каждой строке по i звездочек, т.е. файл должен выглядеть так:
*
* *
* * * и так далее.
Решение:

  1. program Zvezd;
  2. var f:text;
  3.     Ln,i,k:byte;
  4. begin
  5.     assign(f,'zvezd.txt');
  6.     rewrite(f);
  7.     Ln:=1;//число звездочек в первой строке
  8.     repeat
  9.       for i:=1 to Ln do
  10.          write(f,'*':2);
  11.       writeln(f);
  12.       inc(Ln);
  13.     until Ln=31;
  14.     close(f);
  15. end.

А вот треугольник из звездочек

А вот треугольник из звездочек, мы делали на какой то из пар.
Для заданной высоты, в текстовый файл рисуем треугольник.
Пример: n=3;

  1.   *
  2.  ***
  3. *****

  1. program treug;
  2. var a:text;
  3.     i,j,n:integer;
  4. begin
  5.   assign(a,'treug.txt');
  6.   rewrite(a);
  7.   write('Введите высоту ');
  8.   readln(n);
  9.   for I := 1 to n do begin
  10.     for J := 1 to n*2-1 do if ((i+j<n+1) or (i+j>i*2+n-1)) then write(a,' ')
  11.     else write(a,'*');
  12.     writeln(a);
  13.   end;
  14.   close(a);
  15. end.

Задача про звездочки

Еще один вариант решения этой задачи:)

  1. program stars;
  2. var f:text;
  3.     i,j,n:byte;
  4. begin
  5.  assign(f,'stars.txt');
  6.  rewrite(f);
  7.   n:=1;
  8.   for i:=1 to 30 do begin
  9.     for j:=1 to n do begin
  10.       write(f,'*');
  11.     end;//for i
  12.     writeln(f);
  13.     inc(n);
  14.   end;//for j
  15.  close(f);
  16. end.

Звёздочки

  1. program Project1;
  2. const lim=10;
  3. var f:text;
  4.     n,i:integer;
  5. begin
  6.   assign(f,'ZV.txt');
  7.     rewrite(f);
  8.     i:=0;
  9.     while i<>lim do begin
  10.       for n := 0 to n do
  11.           write(f,'*':3);
  12.       i:=i+1;
  13.       writeln(f);
  14.     end;//while
  15.   Close(f);
  16. end.

Валерий

Ты тестировал то что прислал? Какое условие у твоей задачи?
Переменная n всегда будет равняться нулю, lim почему то у тебя равен 10

Валерий

И что это вообще за код  for n := 0 to n do ? Как n может быть от нуля до n?

Исправленный вариант кода

Исправленный вариант кода Валерия

  1. program Project1;
  2. const lim=30;
  3. var n, i:integer;
  4.      f:text;
  5.  
  6. begin
  7.     assign(f,'ZV.txt');
  8.     rewrite(f);
  9.     n:=1;
  10.    while i<>lim do begin
  11.       for i := 1 to n do
  12.         write(f,'*':3);
  13.        n:=n+1;
  14.       writeln(f);
  15.    end;//while
  16.    Close(f);
  17. end.

Хотя мне кажется, что раз

Хотя мне кажется, что раз Валерий решился хоть что-то выложить, то это уже шаг... Просто нужно внимательно читать условие, тщательно писать код и всегда проверять, что выходит в результате...

Валентин

О цикле For: в качестве его границ могут быть ЛЮБЫЕ значения интервального типа, например, for i:=a to b do или for i:=-a to b do , где a,b значения интервального типа

Виктория

Благодарю за внесенные в мой код изменения, но тогда у меня с твоим исправлением в TXT файле получается в место 30, 29 строк и столбцов.

  1. program Project1;
  2. const lim=30;
  3. var f:text;
  4.     n,i:integer;
  5. begin
  6.   assign(f,'ZV.txt');
  7.     rewrite(f);
  8.     n:=0;
  9.     while i<>lim do begin
  10.       for i := 0 to n do
  11.           write(f,'*');
  12.           n:=n+1;
  13.       writeln(f);
  14.     end;//while
  15.   Close(f);
  16. end.

Этот исправленный мной, мой код выведет 30 строк и столбцов из звездочек как в TXT файл, так и на дисплей (соответственно для вывода на дисплей нужно внести изменения в строке 6).

логичней так ...

  1. ...
  2. For n:=1 to Lim do begin
  3.       For j:=1 to n do begin
  4.            Write(f, '*')
  5.       End;
  6.       WriteLn(f)
  7. End;
  8. ...

Никита

...любое ВЫРАЖЕНИЕ порядкового (!) типа. Формально (если значение n определено) можно и так:
"for n:=1 to n do ..." Надо только вспомнить, что значения границ параметра цикла считываются только один раз непосредственно перед входом в цикл. Далее переменные, входящие в выражения для этих границ, могут меняться в теле цикла как угодно - на число повторений это не влияет.

Валерий Шахамболетович, а

Валерий Шахамболетович, а можно узнать, из чего именно будет состоять предстоящая контрольная работа? А еще не подскажите, как правильно будет выглядеть реализация циклической очереди? Не совсем понятен её смысл, от этого не получается её реализовать

В лециях были даны различные

В лекциях были даны различные задания для самостоятельного решения. Вот одно из них: "Написать процедуру, позволяющую включить элемент в конец односвязного списка". Реализация:

  1.  procedure add(var top:PEL; inf:integer; s:integer);
  2.  var p:PEL;// указатель на создаваемый элемент
  3.      t:PEL;// указатель для просмотра списка
  4.  begin
  5.    new(p);// создание элемента
  6.    p^.inf:=inf;  p^.s:=s;//заполнение элемента
  7.    p^.nxt:=nil;
  8.    if top = nil then top:=p//список был пуст
  9.    else begin//список не пуст
  10.       t:=top;
  11.       while t^.nxt <> nil do //проход по списку до конца
  12.          t:=t^.nxt;
  13.       t^.nxt:=p;//привязка нового элемента
  14.    end;
  15.  end;

Валерий Шахамболетович, возможно получилось не то, что Вы имели в виду, пока эта тема для меня несколько туманна

Вика, ты не могла бы для

Вика, ты не могла бы для "особо одаренных" прислать и код главной программы и объяснить, где ты писала эту процедуру: в юните или в главной прог-е? не получается связать процедуру с прог-ой

У меня вот что получилось

  1.  procedure add( pntr:PEL; x:integer);//pntr - указатель, х-добавляемый элемент
  2.   var p:PEL;
  3.  begin
  4.    new(p);// выделили ячейку памяти из кучи
  5.    p^.inf:=x;  ;// в информационное поле этой ячейки записывается х
  6.    p^.nxt:=nil;
  7.    if pntr = nil then pntr^.nxt:=p// если в  списке один элемент, переносим  указатель pntr  на p(содержит добавленный элемент)
  8.    else begin//элементов более двух
  9.       while pntr^.nxt <> nil do pntr:=pntr^.nxt; //перематываем список до предпоследнего эл-та списка
  10.       pntr^.nxt:=p;// переносим указатель pntr  на р (содержит добавленный элемент)
  11.    end;
  12.  end;

Ксюша, например, так begin 

Ксюша, например, так

  1.  begin
  2.    for i:=1 to 5 do add(top,i,a[i]);
  3.    writeln('spisok');
  4.    print(top);
  5.  end.

где а - у меня определено как массив целых чисел, а print - процедура вывода на экран. Юнит здесь не использовала

Добрый вечер, Валерий

Добрый вечер, Валерий Шахамболетович! Сегодня, на контрольной я не справилась с заданиями, но все же разобралась и довела их до конца и хотела бы Вас попросить проверить правильность решений.
1. Описать функцию, которая создает копию односвязного списка

  1. function CopyLst(ffrst:PEL):pel;//ffrst - указатель ссылочного типа
  2. var p,p1,p2:PEL;
  3. Begin
  4.    if (ffrst=nil) then ffrst:=nil // если список пуст, то его значение таковым и останется
  5.    else begin
  6.       new(p);// выделение памяти под динамическую переменную
  7.       p^.inf:=ffrst^.inf;// в информационное поле p записывается значение инф.поля ffrst
  8.       p2:=ffrst^.nxt;// дошли до предпоследнего элемента списка ffrst
  9.       CopyLst:=p;
  10.       while p2<>nil  do begin //пока список p2 не пуст
  11.          new(p1);
  12.          p1^.inf:=p2^.inf;
  13.          p^.nxt:=p1;// перенесли указатель p на p1
  14.          p2:=p2^.nxt;
  15.          p:=p1;// связали списки
  16.       end;
  17.       p^.nxt:=nil;
  18.    end;
  19. end;

2. Описать процедуру,

2. Описать процедуру, позволяющую два односвязных списка слить в один

  1. procedure AddLst(var frst1,frst2,frst:PEL);//frst1,frst2,frst - списки, где frst - результирующий
  2. Var p:pel;// указатель
  3. begin
  4.    if (frst1=nil) then frst1:=frst2 // если первый список пуст, то ему присваиваем значения второго
  5.    else begin
  6.       frst:=frst1;// присвоим результирующему списку первый список
  7.       p:=frst1;//связали указатель и список
  8.       while p^.nxt <> nil do // проход по списку
  9.          p:=p^.nxt;// прошлись по списку до предпоследнего элемента
  10.       p^.nxt:=frst2; // перенесли указатель p на frst2
  11.    end;
  12. end;
  13.  

Здравствуйте, Вика!

Здравствуйте, Вика! Представленные Вами реализации содержат ошибки. В частности, в обоих случаях возможны ситуации с неопределённым результатом.

Ошибка в 4 строке в первой

Ошибка в 4 строке в первой задаче, нужно чтобы было так:

  1. if (ffrst=nil) then CopyLst:=nil

Остальных ошибок пока не нашла...но работаю над этим

Реализация процедуры AddLst

Реализация процедуры AddLst возможно, эффективнее была бы такой:

  1. procedure addLst(var frst1,frst2,frst:PEL);
  2. Var p:pel;
  3. begin
  4.    if (frst=nil) then frst:=frst2;// если первый список будет пуст, то результирующим будет второй список
  5.    if (frst2=nil) then frst:=frst1;//если второй список пуст, то вместо результата будет первый список
  6.    if (frst1=nil) and (frst2=nil) then frst:=nil//если оба списка пустые, то и результат будет пустой
  7.    else
  8.      begin
  9.       p:=frst1;// указатель на первый список
  10.       while p^.nxt <> nil do// проход по списку
  11.          p:=p^.nxt;// дошли по списку до предполеднего элемента
  12.       p^.nxt:=frst2;//перенесли указатель на второй список
  13.       frst:=frst1;// получили результирующий список
  14.    end;
  15. end;
  16. <pre>

Упор может быть сделан на

Упор может быть сделан на ясность или на эффективность решения. Ясные, короткие и с большей вероятностью, правильные решения безусловно требуют модульного подхода, основанного, в частности, на подпрограммах. Вот пример такого решения первой из указанных Викторией задач:

  1.  Function CopyLst(Lst:Pel):Pel;
  2. //возвращает ссылку на созданную копию исходного списка Lst
  3.     Var newLst, p: Pel;
  4. Begin
  5.     p:=Lst; // зацепим исходный список
  6.     newLst:=nil; // создадим пустую очередь
  7.     While p<>nil do Begin // пока в списке есть текущий элемент ...
  8.           CopyElAsLast(p, newLst); //... его копию добавим в конец очереди
  9.           p:=p^.nxt // и пойдём по списку дальше
  10.     End;
  11.     CopyLst:=newLst
  12. End;

  1. Procedure  CopyElAsLast(p:Pel; var newLst: Pel);
  2. //добавляет значение p^.inf в конец списка newLst
  3.     Var t,q: Pel;
  4. Begin
  5.     new(t); // создаём и ...
  6.     t^.inf:=p^.inf; t^.nxt:=nil; // ... инициализируем копию
  7.     If newLst=nil then //Eсли список пуст,
  8.            newLst:=t  //тут же её подключаем.
  9.      Else Begin //Eсли же список не пуст,
  10.            q:=newLst; // то заходим на него и ...
  11.            While q^.nxt <> nil Do q:=q^.nxt; // ... ищем последний его элемент,
  12.            q^.nxt:=t  // к которому и подключаем построенную копию
  13.      End
  14. End      

Вместо запутанного решения с

Вместо запутанного решения с тремя бессистемно блуждающими указателями p, p1, p2 (как будто нет других букв и имён!), в котором, признаюсь, и я заблудился, мы получили два коротких, логично комментированных и НЕЗАВИСИМЫХ друг от друга модуля, которые легко обсуждать, анализировать, изменять, а при желании, даже по отдельности тестировать. Более того, не исключено, что модули эти пригодятся и в других проектах. Общая длина кода примерно та же, а преимуществ - масса!

Не бойтесь подпрограмм, бойтесь избегать их!

Да, Вы безусловны правы, я не

Да, Вы безусловно правы, я не догадалась о модульности в подпрограммах

Вторая задача проще, можно

Вторая задача проще, можно без подпрограмм:

  1. procedure addLst(var frst1,frst2,frst:PEL);
  2.     Var p:pel;
  3. begin
  4.      If frst1=nil then first:=first2
  5.      Else Begin
  6.          p:=frst1;
  7.          While p^.nxt <> nil do p:=p^.nxt;
  8.          p^.nxt:=frst2;
  9.          frst:=frst1
  10.      End
  11. End

(В Вашем решении, Вика, в 4-й строке описка; 5,6 строки лишние)

Вариант решения задачи fl1

  1. program fl1;
  2.     var f:file of char;
  3.     x:string;
  4. procedure s2c(x:string);
  5.     var i:Byte;
  6.     c:Char;
  7. begin
  8.   for i:=1 to Length(x) do begin
  9.       c:=x[i];
  10.       write(f,c)
  11.   end;
  12. c:=' ';
  13. write(f,c)
  14.   end;
  15. begin
  16. Assign(f,'C:\test\1.txt');
  17. Rewrite(f);
  18. readln(x);
  19.   while x<>'0' do begin
  20.   s2c(x);
  21.   readln(x);
  22.   end;
  23. close(f);
  24. end.

Вариант решения задачи fl2

  1. program fl2;
  2.     var d:string;
  3. begin
  4.    if not((x=#13) or (x=#10)) then  begin
  5.    d:=d+x;
  6.    end;
  7.    s2c:=d;
  8. end;
  9. begin
  10. Assign(f,'C:\test\ttt.txt');
  11. Reset(f);
  12.   while not(eof(f)) do begin
  13.   read(f,x);
  14.   k:=k+s2c(x);
  15.   end;
  16. write(k);
  17. close(f);
  18. readln;
  19. readln
  20. end.

Николай по задаче fl1 ...

в условии же сказано что "Дана входная последовательность натуральных чисел, завершающаяся нулём."
да и использование глобального файла не есть хорошо и можно было в самой процедуре вводить числа
тогда процедура имела бы следующую структуру:

  1. procedure InFile(s:string);// s имя файла
  2.   var f:text;
  3.       n:word;
  4.  begin
  5.   assign(f,s);// привязка
  6.   rewrite(f);// открытие для записи
  7.   write('n= ');
  8.   readln(n);// прочитали  число
  9.   while n<>0 do begin // пока истина:
  10.    write(f,n,' ');// запись числа в файл
  11.    write('n= ');
  12.    readln(n);// прочитали очередное число
  13.   end;//while
  14.   close(f);// закрытие файла
  15.  end; //InFile

А в задаче fl2 что это за странная конструкция с 3-ей по 8-ю строки ?

Здравствуйте... вот решил

Здравствуйте... вот решил зайти и увидел что для ЗАДАЧИ №3 нет толкового решения.

Вот что получилось у меня:

  1. program ch;
  2.         {$APPTYPE CONSOLE}
  3.         uses
  4.         SysUtils;
  5.         var f: file of char;
  6.                 f1:Text;
  7.                 x:char;
  8.                 i:LongInt;
  9. begin
  10.         Assign(f,'D.txt');
  11.         Assign(f1,'R.txt');
  12.         Reset(f); Rewrite(f1);
  13.         for i:=filesize(f)-1 downto 0 do begin
  14.                 seek(f,i);
  15.                 read(f,x);
  16.                 write(f1,x,#13);
  17.         end;
  18.         write('gotovo');
  19.         close(f); close(f1);
  20.         Readln;
  21.         readln
  22. end.

Вариант решения задачи fl4

  1. program fl4;
  2.   var f:Text;
  3.       v:Word;
  4.       z:string;
  5. function CalcStr (s:string): integer;
  6.   var Rez:Integer;
  7. begin
  8. Rez := 0;
  9. Assign(f, 'C:\test\4isLoStrok.txt');
  10. Reset(f);
  11.   while not EOF(f) do begin
  12.   Readln(f, s);
  13.   Rez:=rez+1;
  14.   CalcStr:=Rez;
  15. end;
  16. end;
  17. begin
  18. v:= CalcStr (z);
  19. Writeln (v);
  20. Readln
  21. end.

Добрый вечер, Валерий

Добрый вечер, Валерий Шахамболетович! При работе с бинарными деревьями, у меня возник вопрос. Например, если элементы бинарного дерева таковы: 54, 86, 13, 68, 57, то как будет вырисовываться картинка? Корнем будет число 54, 86 - его правым поддеревом, а вот число 13 - левым поддеревом числа 86 или нет?

Вика

примерно вот так