БД без графического интерфейса и диалогового меню.
Используется для хранения информации о восхождениях в гору,каждое восхождение содержит список имен и адресов учувствовавших в нем.
UNIT1.PAS - меню выбора действия.
UNIT2.PAS - удаление,добавление,изменение эл-тов,запись,чтение их файла.
Unit1.pas
unit Unit1;
interface
{структура списка аресов и имен}
type list = ^Tlist;
Tlist=record
name:string;
addr:string;
next:list; {указатель на след элемент}
end;
{конец структуры}
{структура восхождений}
type Base = ^BD;
BD=record
beg_rise,end_rise:string;
mnt_name:string;
mnt_hg:string;
cntr:string;
rgn:string;
indx:integer;
names_addr:list; {указатель на список имен и адресов}
Next : base; {указатель на след элемент}
{конец структуры}
end;
{----------------------------------------------------------}
var
count,i:integer;str_temp:string;int_temp:integer;pntr_temp:pointer;
{счетчик записей,просто счетчик,временная строковая переменная,временная целочисленная переменная,временный указатель}
BList,p:base;q:list;
{указатели на списки}
f1:text;
{текстовый файл}
procedure Add; {добавление ел-та}
procedure Show; {вывод на экран}
procedure change; {изменение}
procedure delete(param:integer); {удаление}
procedure reindex; {реиндексирование записей}
procedure save_to_f; {сохранение в файл}
procedure read_from_f; {чтение из файла}
implementation
procedure Add;
begin
count:=count+1; {увеличение счетчика записей}
new(p); {выделение памяти}
p^.indx:=count; {индексирование записей}
{далее заполение всех полей}
write('Begin of rising:');
readln(str_temp);
p^.beg_rise:=str_Temp;
write('End of rising:');
readln(str_temp);
p^.end_rise:=str_temp;
write('Mount name:');
readln(str_temp);
p^.mnt_name:=str_temp;
write('Mount higth:');
readln(str_temp);
p^.mnt_hg:=str_temp;
write('Contry:');
readln(str_temp);
p^.cntr:=str_temp;
write('Region:');
readln(str_temp);
p^.rgn:=str_temp;
{создание списка имен и адресоов}
writeln('Enter names and adres of mens or type DONE');
while true do {цикл выполняется всегда}
begin
write('Name:');
readln(str_temp);
if str_temp='done' then {если введенная строка = done то выходим из цикла}
begin
{три строчки нижу надо обязательно делать перед выходом,иначе нарушится порядок построения структуры}
writeln('Add complete.');
p^.Next:=Blist;
Blist:=p;
exit;
end;
new(q); {если все таки слово было не done то выделяем память под новый элемент списка имен и адресов}
q^.name:=str_temp;
write('Addres:');
readln(str_temp);
{три строчки нижу это элементы создания структуры,если прочтешь как создаются списки,то поймешь зачем они нужны}
q^.addr:=str_temp;
q^.next:=p^.names_addr;
p^.names_addr:=q;
end;
writeln('Add complete.');
{две строчки ниже опять же для структуры}
p^.Next:=Blist;
Blist:=p;
reindex; {реиндексирование}
end;
{----------------------------------------------------------}
procedure show;
begin
p:=blist; {для того что бы указатель р,которым мы будем перемещаться по списку указывал на его первый лемент}
if blist=nil then {если список пуст}
begin
writeln('Base empty');
exit;
end;
while p <> nil do {до тех пор пока список не пустой}
begin
{ниже вывод информации о восхождении}
writeln('Begin of rising:',p^.beg_rise);
writeln('End of rising:',p^.end_rise);
writeln('Mount name:',p^.mnt_name);
writeln('Mount hight:',p^.mnt_hg);
writeln('Country:',p^.cntr);
writeln('Region:',p^.rgn);
{нижу вывод информации о именах и адресах}
q:=p^.names_addr; {передаем указателю q адрес начала списка адресов и имен}
writeln('Name-Adres.');
while q <> nil do {цикл будет до тех пор пока список адресов не пуст}
begin
write(q^.name,'-',q^.addr);
if q^.next=nil then {если текущий элемент последний}
writeln('.') {то выведем точку}
else
write(',');
q:=q^.next; {переход к след эл-ту списка адресов}
end;
writeln('Index:',p^.indx);
p:=p^.next; {переход к след элементу списка восхождений}
end;
end;
{----------------------------------------------------------}
procedure change;
begin
p:=blist;
if blist=nil then
begin
writeln('Base empty');
exit;
end;
{перезаполнение полей восхождения}
write('Index of rising:');
readln(int_temp);
while p^.indx<>int_temp do
p:=p^.next;
write('Begin of rising:');
readln(str_temp);
p^.beg_rise:=str_Temp;
write('End of rising:');
readln(str_temp);
p^.end_rise:=str_temp;
write('Mount name:');
readln(str_temp);
p^.mnt_name:=str_temp;
write('Mount higth:');
readln(str_temp);
p^.mnt_hg:=str_temp;
write('Contry:');
readln(str_temp);
p^.cntr:=str_temp;
write('Region:');
readln(str_temp);
p^.rgn:=str_temp;
writeln('Enter names and adres of mens or type DONE');
{удаление старого списка имен и адресов}
while p^.names_addr<>nil do
begin
q:=p^.names_addr;
p^.names_addr:=p^.names_addr^.next;
dispose(q);
end;
{создание нового,все как и в процедуре эдд}
while true do
begin
write('Name:');
readln(str_temp);
if str_temp='done' then
begin
writeln('Add complete.');
exit;
end;
new(q);
q^.name:=str_temp;
write('Addres:');
readln(str_temp);
q^.addr:=str_temp;
q^.next:=p^.names_addr;
p^.names_addr:=q;
end;
writeln('Change complete.');
end;
{----------------------------------------------------------}
procedure delete;
var pntr_temp:base;
begin
if blist=nil then
begin
writeln('Base empty');
exit;
end;
p:=blist;
if param=p^.indx then {если эл-т с нужным индексом стоит первым}
begin
blist:=blist^.next;
while p^.names_addr<>nil do {удаление списка адресов и имен этой записи}
begin
q:=p^.names_addr;
p^.names_addr:=p^.names_addr^.next;
dispose(q);
end;
dispose(p); {удаление самого эл-та}
count:=count-1;
reindex;
writeln('Delete comlete');
exit
end;
{ниже если непервым}
while p^.indx<>param do {листаем до нужного}
begin
pntr_temp:=p;
p:=p^.next;
end;
{а дальше все как и в первом случае}
pntr_temp^.next:=p^.next;
while p^.names_addr<>nil do
begin
q:=p^.names_addr;
p^.names_addr:=p^.names_addr^.next;
dispose(q);
end;
dispose(p);
count:=count-1;
reindex;
writeln('Delete comlete');
end;
{----------------------------------------------------------}
procedure reindex; {тут все просто до безобразия}
begin
p:=blist;
for i:=1 to count do
begin
p^.indx:=i;
p:=p^.next;
end;
end;
{----------------------------------------------------------}
procedure save_to_f;
begin
assign(f1,'base.dat');
rewrite(f1);
p:=blist;
for i:=1 to count do
begin
{пишем в файл информацию о восзождении}
writeln(f1,p^.beg_rise);
writeln(f1,p^.end_rise);
writeln(f1,p^.mnt_name);
writeln(f1,p^.mnt_hg);
writeln(f1,p^.cntr);
writeln(f1,p^.rgn);
q:=p^.names_addr;
while q<>nil do
begin
{пишем имена и адреса}
writeln(f1,q^.name);
writeln(f1,q^.addr);
q:=q^.next;
end;
{это нужно для чтения}
writeln(f1,'end');
p:=p^.next;
end;
close(f1);
writeln('Save complete');
end;
{----------------------------------------------------------}
procedure read_from_f;
begin
assign(f1,'base.dat');
reset(f1);
while count<>0 do {удаляем все предыдущие записи из памяти что бы не навлеч гнев ктулху}
delete(count);
p:=blist;
while not eof(f1) do
begin
{до тех пор,пока файл не закончился будем делать практически то же самое что и в простом добавлении}
new(p);
readln(f1,str_temp);
p^.beg_rise:=str_temp;
readln(f1,str_temp);
p^.end_rise:=str_temp;
readln(f1,str_temp);
p^.mnt_name:=str_temp;
readln(f1,str_temp);
p^.mnt_hg:=str_temp;
readln(f1,str_temp);
p^.cntr:=str_temp;
readln(f1,str_temp);
p^.rgn:=str_temp;
{после этого автоматом читаются имена и адреса}
while str_temp<>'end' do {если в файле найдется енд,то будет переход к следующему восхождению}
begin
new(q);
readln(f1,str_temp);
{четыре строчки ниже - это маленькие костыли}
if str_temp='end' then
begin
dispose(q);
break;
end;
{ну а дальше все по структуре списков}
q^.name:=str_temp;
readln(f1,str_temp);
q^.addr:=str_temp;
q^.next:=p^.names_addr;
p^.names_addr:=q;
end;
p^.Next:=Blist;
Blist:=p;
count:=count+1;
reindex;
end;
writeln('Read complete');
close(f1);
end;
end.
unit2.pas
program Project2;
uses
Unit1;
var c:byte;
i,j:integer;
procedure MenuAction(param:byte); {процедура распознавания действия}
begin
if param=10 then
add;
if param=11 then
show;
if param=12 then
change;
if param=13 then
begin
write('Enter index:');
readln(int_temp);
delete(int_temp);
end;
if param=14 then
save_to_f;
if param=15 then
read_from_f;
end;
begin
BList:=nil; {так надо для структуры,почитай списки}
while c<>16 do {до тех пор пока ты не введешь 12 цикл будет выполняться}
begin
readln(c);
menuaction(c);
end;
end.
|
Главная
Каталог файлов
