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

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

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

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


Новичок
*

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

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


Тема про файлы конечно животрепещущая и требует большого внимания, но на данный момент мне бы хотелось увидеть советы по своему вопросу.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
not_programmer
сообщение 20.12.2007 15:42
Сообщение #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

 



- Текстовая версия 25.06.2025 22:25
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"