IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V < 1 2  
 Ответить  Открыть новую тему 
> Структурированные файлы (Библиотека)
сообщение
Сообщение #21


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


Тема про файлы конечно животрепещущая и требует большого внимания, но на данный момент мне бы хотелось увидеть советы по своему вопросу.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #22


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


Ээхх, никакой помощи не дождешься. Ну да ладна, прогу доделал, вот готовый вариант.
(ЕСЛИ НАЙДЕТЕ КАКИЕТО ОШИБКИ ИЛИ НЕДОЧЕТЫ - СООБЩИТЕ!!)


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;

{REWRITE PARTS OF FILE}

procedure update_records;
var
number_of_record:integer;
begin
name_of_file;
assign(book_file,file_name);
{$I-}
reset(book_file);
{$I+}
if IOresult = 0 then
begin
writeln('Enter number of rewrite record :');
readln(number_of_record);
seek(book_file,number_of_record-1);
writeln('Zna4enie of this record: ');
output_record;
seek(book_file,number_of_record-1);
writeln('Enter new zna4enie ',number_of_record,' record');
add_record;
close(book_file);
end
else
writeln('” ©«  б Ё¬Ґ­Ґ¬ '+file_name+' ­Ґ бгйҐбвўгҐв');
end;

{ADD RECORDS IN THE END OF FILE}

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.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V < 1 2
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.10.2020 7:28
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name