Паскаль(Файлы) Помогите

[Артемdgty]

7. Книга: название, автор, количество страниц.
Поиск по автору и выводить книги, объем которых меньше заданного количества страниц.
что нужно исправить или добавить ,что бы выполнялось условие, выделенное синим цветом. Заранее спасибо.

Uses crt;
Const 
 n='D:\Users\vpr2012.IIVT.001\Desktop\File.txt';
type
 kniga=record
  name,avtor,kol:string;
 end;
Var
 F:text;
 t:char;
 
Function ReadString(F2:text; S:string): string;
begin
 While not eoln(f2) do 
  read(f2,S);
 Result:=S;
end;
 

Procedure OutputObject(F1:text);
Var
 d:string;
Begin
 assign(f1,n);
 reset(f1);
 clrscr;
 While not eof(f1) do begin
  d:=ReadString(f1,d);
  Writeln(d);
  Readln(f1);
  d:='';
 end;
 Close(f1);
 repeat
 until keypressed;
 end;

 
Procedure AddObject(F1:text);
Var
 d:string;
begin
 clrscr;
 assign(f1,n);
 append(f1);
 writeln(f1);
 write('Введите название книги: ');
 readln(d); write(f1,d,' '); 
 write('Введите автора книги: ');
 readln(d); write(f1,d,' '); 
 write('Введите количество страниц: ');
 readln(d); write(f1,d,' ');
 close(f1);
end;

Procedure Preobrazovanie(d1:string; c:char; var a:kniga);
Var
i,p1:integer;
Begin
  For i:=1 to length(d1) do
   if d1[i]=c then inc(p1)
    else case p1 of
     0:a.name:=a.name+d1[i];
     1:a.avtor:=a.avtor+d1[i];
     2:a.kol:=a.kol+d1[i];
       end;  
end;


Procedure SearchObject(F1:text);
Var
 a:kniga;
 d,k:string;
begin
 clrscr;
 Assign(f1,n);
 reset(f1);
 Write('Введите название книги: ');
 readln(k);
 While not eof(f1) do begin
  d:=ReadString(f1,d);
  Preobrazovanie(d,' ',a);
   If k=a.name then
    writeln('Искомая книга: ',a.name,' автор: ',a.avtor,' количество страниц: ',a.kol);
   Readln(f1);
   a.name:='';
   a.avtor:='';
   a.kol:='';
   d:='';end;
   Close(F1);
   repeat
   until keypressed;
 end;

Function CompareDate(Date1,Date2:string):integer;
Var
a,b,c,a1,b1,c1:string;
i,p1:integer;
Begin
  For i:=1 to length(Date1) do
   if Date1[i]='.' then inc(p1)
    else case p1 of
     0:a:=a+Date1[i];
     1:b:=b+Date1[i];
     2:c:=c+Date1[i]; end;
  p1:=0;
  For i:=1 to length(Date2) do
   if Date2[i]='.' then inc(p1)
    else case p1 of
     0:a1:=a1+Date2[i];
     1:b1:=b1+Date2[i];
     2:c1:=c1+Date2[i]; end;
  If (StrToInt(a)<StrToInt(a1))and(StrToInt(b)<=StrToInt(b1))and(StrToInt(c)<=StrToInt(c1))or(StrToInt(b)<StrToInt(b1))and(StrToInt(c)<=StrToInt(c1))or(StrToInt(c)<StrToInt(c1)) then result:=1 
   else result:=0;
end;
    

Procedure SearchOverdue(F1:text);
Var
 a:kniga;
 d,k:string;
 l:integer;
begin
 clrscr;
 Assign(f1,n);
 reset(f1);
 write('Введите количество страниц :');
 readln(k);
 writeln('книга,объем которой меньше заданного количества страниц :');
 While not eof(f1) do begin
  d:=ReadString(f1,d);
  Preobrazovanie(d,' ',a);
  l:=CompareDate(a.kol,k);
  If l=1 then 
   writeln('Название книги: ',a.name,' автор: ',a.avtor,' количество страниц: ',a.kol);
  Readln(f1);
  a.name:='';
  a.avtor:='';
  a.kol:='';
  d:=''; end;
  Close(F1);
  repeat
   until keypressed;
end;
   
BEGIN
 repeat
  clrscr;
  Writeln('1: Вывести список всех объектов');
  Writeln('2: Добавить новый объект');
  Writeln('3: Поиск объекта по наименованию');
  Writeln('4: Вывод книги,объем которой меньше заданного числа страниц');
  t:=readkey;
  case t of
   '1': OutputObject(F);
   '2': AddObject(F);
   '3': SearchObject(F);
   '4': SearchOverdue(F);
  end;
 until t=#27;
END.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(это кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

[Dozent]

засунь код в тег а то читать сложно

[Dozent]

Procedure SearchOverdue(F1:text);
Var
a:kniga;
d,k:string;
l:integer;
begin
clrscr;
Assign(f1,n);
reset(f1);
write('Введите количество страниц :');
readln(k);
writeln('книга,объем которой меньше заданного количества страниц :');
While not eof(f1) do begin
d:=ReadString(f1,d);
Preobrazovanie(d,' ',a);

где а инициализируется?

[Артемdgty]

Вот для удобства

Uses crt;
Const 
 n='C:\Users\Артем\Desktop\File.txt';
type
 kniga=record
  name,avtor,kol:string;
 end;
Var
 F:text;
 t:char;
 
Function ReadString(F2:text; S:string): string;
begin
 While not eoln(f2) do 
  read(f2,S);
 Result:=S;
end;
 

Procedure OutputObject(F1:text);
Var
 d:string;
Begin
 assign(f1,n);
 reset(f1);
 clrscr;
 While not eof(f1) do begin
  d:=ReadString(f1,d);
  Writeln(d);
  Readln(f1);
  d:='';
 end;
 Close(f1);
 repeat
 until keypressed;
 end;

 
Procedure AddObject(F1:text);
Var
 d:string;
begin
 clrscr;
 assign(f1,n);
 append(f1);
 writeln(f1);
 write('Введите название книги: ');
 readln(d); write(f1,d,' '); 
 write('Введите автора книги: ');
 readln(d); write(f1,d,' '); 
 write('Введите количество страниц: ');
 readln(d); write(f1,d,' ');
 close(f1);
end;

Procedure Preobrazovanie(d1:string; c:char; var a:kniga);
Var
i,p1:integer;
Begin
  For i:=1 to length(d1) do
   if d1[i]=c then inc(p1)
    else case p1 of
     0:a.name:=a.name+d1[i];
     1:a.avtor:=a.avtor+d1[i];
     2:a.kol:=a.kol+d1[i];
       end;  
end;


Procedure SearchObject(F1:text);
Var
 a:kniga;
 d,k:string;
begin
 clrscr;
 Assign(f1,n);
 reset(f1);
 Write('Введите название книги: ');
 readln(k);
 While not eof(f1) do begin
  d:=ReadString(f1,d);
  Preobrazovanie(d,' ',a);
   If k=a.name then
    writeln('Искомая книга: ',a.name,' автор: ',a.avtor,' количество страниц: ',a.kol);
   Readln(f1);
   a.name:='';
   a.avtor:='';
   a.kol:='';
   d:='';end;
   Close(F1);
   repeat
   until keypressed;
 end;

Function CompareKol(Kol1,Kol2:string):integer;
Var
a,b,c,a1,b1,c1:string;
i,p1:integer;
Begin
  For i:=1 to length(Kol1) do
   if Kol1[i]='.' then inc(p1)
    else case p1 of
     0:a:=a+Kol1[i];
     1:b:=b+Kol1[i];
     2:c:=c+Kol1[i]; end;
  p1:=0;
  For i:=1 to length(Kol2) do
   if Kol2[i]='.' then inc(p1)
    else case p1 of
     0:a1:=a1+Kol2[i];
     1:b1:=b1+Kol2[i];
     2:c1:=c1+Kol2[i]; end;
  If (StrToInt(a)<StrToInt(a1))and(StrToInt(b)<=StrToInt(b1))and(StrToInt(c)<=StrToInt(c1))or(StrToInt(b)<StrToInt(b1))and(StrToInt(c)<=StrToInt(c1))or(StrToInt(c)<StrToInt(c1)) then result:=1 
   else result:=0;
end;
    

Procedure SearchOverdue(F1:text);
Var
 a:kniga;
 d,k:string;
 l:integer;
begin
 clrscr;
 Assign(f1,n);
 reset(f1);
 write('Введите количество страниц :');
 readln(k);
 writeln('книга,объем которой меньше заданного количества страниц :');
 While not eof(f1) do begin
  d:=ReadString(f1,d);
  Preobrazovanie(d,' ',a);
  l:=CompareKol(a.kol,k);
  If l=1 then 
   writeln('Название книги: ',a.name,' автор: ',a.avtor,' количество страниц: ',a.kol);
  Readln(f1);
  a.name:='';
  a.avtor:='';
  a.kol:='';
  d:=''; end;
  Close(F1);
  repeat
   until keypressed;
end;
   
BEGIN
 repeat
  clrscr;
  Writeln('1: Вывести список всех объектов');
  Writeln('2: Добавить новый объект');
  Writeln('3: Поиск объекта по наименованию');
  Writeln('4: Вывод книги,объем которой меньше заданного числа страниц');
  t:=readkey;
  case t of
   '1': OutputObject(F);
   '2': AddObject(F);
   '3': SearchObject(F);
   '4': SearchOverdue(F);
  end;
 until t=#27;
END.

не надо использовать тег [HTML], есть тег [CODE] (это кнопочка с решёточкой # на панели форматирования сообщения)
Модератор.

[Serge_Bliznykov]

во-первых,

 n='C:\Users\Артем\Desktop\File.txt';

у Вас же TurboPascal?
Если да, тогда то, что Вы поместили файл в папку, где путь содержит только имена в формате DOS (не более 8 символов на имя и не более 3-х на расширение) - это ВЕРНО!

но я бы и русские буквы не использовал в именах папок в данном случае.
Сделайте на диске C в папке Users папку Artem и туда складывайте ваш файл
например,

 n='C:\Users\Artem\File.txt';

можно и любую другую папку создать, хоть на диске C:, хоть на любом другом.
главное, чтобы имя каждой папки в пути было латиницей и не более 8 символов


во-вторых, в коде имеются ошибки и неточности.
например, так:

Function ReadString(F2:text; S:string): string;
begin
 While not eoln(f2) do 
  read(f2,S);
 Result:=S;
end;

Вы строку НЕ ПРОЧИТАЕТЕ!
для чтения строки из текстового файла достаточно написать так:

 Readln(f2, S);

и не надо никаких бесполезных (к тому же неверно написанных) функций!