1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Ээхх, никакой помощи не дождешься. Ну да ладна, прогу доделал, вот готовый вариант. (ЕСЛИ НАЙДЕТЕ КАКИЕТО ОШИБКИ ИЛИ НЕДОЧЕТЫ - СООБЩИТЕ!!)
program lib; uses crt; type sel=(book, journal); books=record number:integer; name:string; avtor:string; srok:record d:byte; m:byte; god:longint; end; status:string; case s:sel of book:(izdanie:integer); journal:(nomer:integer); end; var book_file : file of books; rec : books; finder_d : byte; finder_m : byte; finder_god : longint; file_name : string; key : integer; exit : boolean; data : array[1..77] of books;
{CREATE NAME OF FILE}
procedure name_of_file; begin write('Enter name of file of data of book: '); readln(file_name); end;
{ADD RECORD IN THE FILE}
procedure add_record; var select : integer; begin writeln('Record N ',filepos(book_file)+1); Write('1 - Book 2 - Journal: '); ReadLn(select); case select of 1:rec.s := book; 2:rec.s := journal; end; with rec do begin write('Inventory number: '); readln(number); write('Name: '); readln(name); write('Author: '); readln(avtor); case s of book:begin write('Izdanie: '); readln(izdanie); end; journal:begin write('Nomer journala: '); readln(nomer); end; end; write('Srok vozvrata(day mes god): '); readln(srok.d, srok.m, srok.god); write('Status: '); readln(status);
end; write(book_file,rec); end;
{CREATE NEW NULL FILE}
procedure create_new_nul_file; begin name_of_file; assign(book_file,file_name); rewrite(book_file); end;
{CREATE NEW FILE}
procedure create_new_book_file; var i,n:integer; begin name_of_file; assign(book_file,file_name); rewrite(book_file); writeln('Create records of file ',file_name); write('Enter count records: '); readln(n); for i:=1 to n do add_record; writeln('FILE CREATED'); writeln('File of data have ',filesize(book_file),' records'); close(book_file); end;
{OUTPUT TEMP RECORD}
procedure output_record; begin read(book_file,rec); with rec do begin write('N ',filepos(book_file),' : '); writeln('Name: ',name); writeln('Author: ',avtor); case s of book : begin writeln('Indanie #: ',izdanie); end; journal: begin writeln('Nomer: ',nomer); end; end; writeln('Srok vozvrata (day mes god)): ',srok.d,'.',srok.m,'.',srok.god); writeln('Status: ',status); end; end;
{OUTPUT ALL RECORDS}
procedure output_all_records; begin name_of_file; assign(book_file,file_name); {$I-} reset(book_file); {$I+} if IOresult = 0 then begin seek(book_file,0); writeln('OUTPUT INFORMATION ABOUT BOOK ','"',file_name,'"'); while (not eof(book_file)) do output_record; end else writeln('File '+file_name+' is not'); end;
procedure add_records_in_the_end; begin name_of_file; assign(book_file,file_name); {$I-} reset(book_file); {$I+} if IOresult = 0 then begin seek(book_file,filesize(book_file)); add_record; writeln('Data is wrote. So ',filesize(book_file),' records'); close(book_file); end else writeln('File with name '+file_name+' is not'); end;
procedure find_book; var book_file2:file of books; finder:integer; flag:boolean; counter:integer; begin name_of_file; assign(book_file,file_name); write('Enter name of file for prosro4ennyx book: '); readln(file_name); assign(book_file2,file_name); rewrite(book_file2); {$I-} reset(book_file); {$I+} if IOresult = 0 then begin write('Enter current date: '); readln(finder_d, finder_m); flag:=false; counter:=0; while (not eof(book_file)) do begin read(book_file,rec); with rec do if (srok.god<finder_god) or ((srok.god=finder_god) and (srok.m<finder_m)) or ((srok.god=finder_god) and (srok.m=finder_m) and (srok.d<finder_d)) then begin flag:=true; inc(counter); write('N ',filepos(book_file),' : '); writeln('Name: ',name); writeln('Author: ',avtor); case s of book : begin writeln('Izdanie #: ',izdanie); end; journal: begin writeln('Nomer: ',nomer); end; end; writeln('Srok vozvrata(day mes god): ',srok.d,'.',srok.m,'.',srok.god); writeln('Status: ',status); write(book_file2,rec); status:='y'; srok.d:=finder_d; if finder_m=12 then begin srok.m:=1; srok.god:=finder_god+1; end else begin srok.m:=finder_m+1; srok.god:=finder_god; end; seek(book_file,filepos(book_file)-1); write(book_file,rec); end; end;
if flag then writeln('Finded ',counter,' records') else writeln('NO FIND RECORDS'); close(book_file); close(book_file2); end else writeln('File with name '+file_name+' is not'); end;
{SORT OF FILE}
Procedure sorting; var i,j,n:integer; begin name_of_file; assign(book_file,file_name); {$I-} reset(book_file); {$I+} if ioresult <> 0 then writeln('file with name '+file_name+' is not') else begin writeln; n:=0; while (not eof(book_file)) do begin read(book_file,rec); inc(n); data[n]:=rec; end; for i:=1 to n-1 do for j:=1 to n-i do if data[j].name>data[j+1].name then begin rec:=data[j]; data[j]:=data[j+1]; data[j+1]:=rec; end; Write('Enter name of file for result: '); Read(file_name); assign(book_file,file_name); rewrite(book_file); for i:=1 to n do begin seek(book_file,i-1); rec:=data[i]; write(book_file,rec); end; close(book_file); end; end;
Procedure casesort; var i,j,n,f,l:integer; begin i:=0; j:=0; n:=0; f:=0; l:=0; name_of_file; assign(book_file,file_name); {$I-} reset(book_file); {$I+} if ioresult <> 0 then writeln('file with name '+file_name+' is not') else begin writeln; n:=0; while (not eof(book_file)) do begin read(book_file,rec); inc(n); data[n]:=rec; end; for i:=1 to n-1 do for j:=1 to n-i do begin with data[j] do begin case s of book: f:=izdanie; journal: f:=nomer; end; end; with data[j+1] do begin case s of book: l:=izdanie; journal: l:=nomer; end; end; if (f>l) then begin rec:=data[j]; data[j]:=data[j+1]; data[j+1]:=rec; end; end; Write('Enter name of file for result: '); Read(file_name); assign(book_file,file_name); rewrite(book_file); for i:=1 to n do begin seek(book_file,i-1); rec:=data[i]; write(book_file,rec); end; close(book_file); end; end;
Procedure SearchingByField; var book_file2:file of books; FinderOfField:string; flag:boolean; counter:integer; selecter:integer; begin name_of_file; assign(book_file,file_name); write('Enter name of file for finded objects: '); readln(file_name); assign(book_file2,file_name); rewrite(book_file2); {$I-} reset(book_file); {$I+} if IOresult = 0 then begin write('Search by ... : 1 - Name 2 - Avtor '); readln(selecter); case selecter of 1:begin writeln('>>SEARCHING BY "NAME"<<'); writeln; write('Enter NAME of object: '); readln(FinderOfField); flag:=false; counter:=0; while (not eof(book_file)) do begin read(book_file,rec); with rec do if Pos(FinderOfField, name) <> 0 then begin flag:=true; inc(counter); write('N ',filepos(book_file),' : '); writeln('Name: ',name); writeln('Author: ',avtor); case s of book : begin writeln('Izdanie #: ',izdanie); end; journal: begin writeln('Nomer: ',nomer); end; end; writeln('Srok vozvrata(day mes god): ',srok.d,'.',srok.m,'.',srok.god); writeln('Status: ',status); write(book_file2,rec); seek(book_file,filepos(book_file)-1); write(book_file,rec); end; end; end; 2:begin writeln('>>SEARCHING BY "AVTOR"<<'); writeln; write('Enter AVTOR of object: '); readln(FinderOfField); flag:=false; counter:=0; while (not eof(book_file)) do begin read(book_file,rec); with rec do if Pos(FinderOfField, avtor) <> 0 then begin flag:=true; inc(counter); write('N ',filepos(book_file),' : '); writeln('Name: ',name); writeln('Author: ',avtor); case s of book : begin writeln('Izdanie #: ',izdanie); end; journal: begin writeln('Nomer: ',nomer); end; end; writeln('Srok vozvrata(day mes god): ',srok.d,'.',srok.m,'.',srok.god); writeln('Status: ',status); write(book_file2,rec); seek(book_file,filepos(book_file)-1); write(book_file,rec); end; end; end; end; if flag then writeln('Finded ',counter,' records') else writeln('NO FIND RECORDS'); close(book_file); close(book_file2); end else writeln('File with name '+file_name+' is not'); end; {=============MAIN PROGRAM==============}
begin exit:=false; clrscr; repeat writeln(' DATABASE OF BOOK'); writeln; writeln('1 - CREATE NEW FILE'); writeln('2 - VIEW INFORMATION ABOUT BOOKS'); writeln('3 - REWRITE OLD RECORD'); writeln('4 - ADD NEW RECORDS'); writeln('5 - SEARCH BY FIELDS: "NAME" or "AVTOR"'); writeln('6 - SEARCH PROSRO$ENNYX BOOK'); writeln('7 - SORTING BY NAME'); writeln('8 - SORTING BY CASE'); writeln('9 - EXIT'); write('Your choose: '); readln(key); case key of 1:create_new_book_file; 2:output_all_records; 3:update_records; 4:add_records_in_the_end; 5:SearchingByField; 6:find_book; 7:sorting; 8:casesort; 9:exit:=true; end; writeln('Executed. <ENTER>'); readln; clrscr; until exit; end.