Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
Предоплата всего
Подписываем
МИНИСТЕРСТВО ОБРАЗОВАНИЯ И НАУКИ РОССИЙСКОЙ ФЕДЕРАЦИИ
ФЕДЕРАЛЬНОЕ ГОСУДАРСТВЕННОЕ БЮДЖЕТНОЕ ОБРАЗОВАТЕЛЬНОЕ
УЧРЕЖДЕНИЕ ВЫСШЕГО ПРОФЕСИОНАЛЬНОГО ОБРАЗОВАНИЯ
«ГОСУДАРСТВЕННЫЙ УНИВЕРСИТЕТ – УЧЕБНО-НАУЧНО-
ПРОИЗВОДСТВЕННЫЙ КОМПЛЕКС»
Кафедра «Информационные системы»
О Т Ч Е Т
о выполнении лабораторной работы № 1
по дисциплине «Базы данных»
Выполнил: Забелин В.В., Коняхин В.В. Шифр: 090265, 091102
Факультет УНИИ ИТ
Направление / специальность: Прикладная информатика (в экономике)
Группа: 31 – ЭИ
Преподаватель: Рыженков Д.В.
Орел, 2012
Исходный код программы
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TMode = (_add,_delete,_change,_search);
TCatalog=record
first,last: integer;
end;
TZap=record
info: boolean;
ID: integer;
SName: string[20];
Fam: string[20];
Otch: string[30];
NumGr: integer;
end;
// 82
TBlockForTZap=record
hndl: integer;
block: array [0..4] of TZap;
RestArea: array[1..20] of byte;
end;
TBlock0=record
About: string[253];
RestArea: array[1..118] of byte;
last_block: integer;
catalog: array [0..3] of TCatalog
end;
TDB_Heap = class(TForm)
Memo1: TMemo;
leID: TLabeledEdit;
leSName: TLabeledEdit;
leFam: TLabeledEdit;
leNumGr: TLabeledEdit;
Add: TButton;
Search: TButton;
Delete: TButton;
Edit: TButton;
Show: TButton;
Bevel1: TBevel;
Bevel2: TBevel;
Button1: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
leOtch: TLabeledEdit;
procedure FormCreate(Sender: TObject);
procedure AddClick(Sender: TObject);
procedure SearchClick(Sender: TObject);
procedure ShowClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure DeleteClick(Sender: TObject);
procedure ClearPole;
procedure RadioButton2Click(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
function hash (const key: integer): integer;
function fSearch_res (const hash_val: integer; const current_mode: TMode; var last: integer): integer;
function fSearch_by_key (const key: integer): boolean;
function fSearch_by_no_key(const Name,Fam: string; Com: real): boolean;
procedure EditClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
rec0:TZap=(Info:true; ID:0; SName:'None';Fam:'None';Otch:'None';NumGr:0);
var
Mode: TMode;
schema:TBlock0=(About:'Отношение студенты - ID:integer; '+'SName:string[133]; '+'Fam:string[97]; '+'NumGr:real');
DB_Heap: TDB_Heap;
list: TBlockForTZap;
rec,search_rec: TZap;
f: file;
i,j,condition,last_elem,c: integer;
implementation
{$R *.dfm}
function TDB_Heap.fSearch_by_key (const key: integer): boolean;
begin
reset(f,410);
repeat
Seek(f,condition);
BlockRead(f,list,1);
for i:=0 to 4 do
begin
if not(list.block[i].info) and (key=list.block[i].ID)
then
begin
leSName.Text:=list.block[i].SName;
leFam.Text:=list.block[i].Fam;
leOtch.Text:=list.block[i].Otch;
leNumGr.Text:=IntToStr(list.block[i].NumGr);
Result:=true;
CloseFile(f);
exit;
end;
end;
condition:=list.hndl;
until condition=0;
Result:=false;
CloseFile(f);
end;
function TDB_Heap.hash (const key: integer): integer;
begin
Result:= key mod 4;
end;
function TDB_Heap.fSearch_res (const hash_val: integer; const current_mode: TMode; var last: integer): integer;
begin
reset(f,410);
If FileSize(f)<>0 then
begin
//Читаем служебную инфу в первом блоке
Seek(f,0);
//Прочитали в спец. переменную
BlockRead(f,schema,1);
//Если у нас по полученному значению хеш-функции (т.е. по номеру бакета) нет ниодного блока
//то тогда возвращаем функции 0. Иначе возвращаем номер последнего бакет для данного файла
if schema.catalog[hash_val].first=0 then Result:=0
else
begin
case current_mode of
_delete,_change,_search: Result:=schema.catalog[hash_val].first;
_add:
begin
Result:=schema.catalog[hash_val].first;
last:=schema.catalog[hash_val].last;
end;
end;
end;
end
else
Result:=-1;
end;
procedure TDB_Heap.FormCreate(Sender: TObject);
begin
for i:=0 to 3 do
begin
schema.catalog[i].first:=0;
schema.catalog[i].last:=0;
end;
schema.last_block:=0;
AssignFile (f, 'file.dat');
end;
procedure TDB_Heap.AddClick(Sender: TObject);
begin
reset(f,410);
rec.info:=false;
rec.ID:=StrToInt(leID.Text);
rec.SName:=leSName.Text;
rec.Fam:=leFam.Text;
rec.Otch:=leOtch.Text;
rec.NumGr:=StrToInt(leNumGr.Text);
condition:=fSearch_res(hash(rec.ID),_add,last_elem);
if condition=-1 then
begin
//файл пустой
inc(schema.last_block);
//увеличиваем число блоков
//далее вносим изменения в каталог
schema.catalog[hash(rec.ID)].first:=schema.last_block;
schema.catalog[hash(rec.ID)].last:=schema.last_block;
//пишем изменения в файл
BlockWrite(f,schema,1);
//Пишем блок
list.block[0]:=rec;
list.block[1]:=rec0;
list.block[2]:=rec0;
list.block[3]:=rec0;
list.block[4]:=rec0;
list.hndl:=0;
BlockWrite (f,list,1);
CloseFile(f);
exit;
end
else
if condition=0 then
begin
reset(f,410);
//То есть по данному бакету не создано ни одного блока
inc(schema.last_block);
//Вносим изменения
schema.catalog[hash(rec.ID)].first:=schema.last_block;
schema.catalog[hash(rec.ID)].last:=schema.last_block;
//Пишем
BlockWrite(f,schema,1);
//Пишем блок
Seek(f,Filesize(f));
list.block[0]:=rec;
list.block[1]:=rec0;
list.block[2]:=rec0;
list.block[3]:=rec0;
list.block[4]:=rec0;
list.hndl:=0;
BlockWrite (f,list,1);
end
else
//вход сюда,если мы обнаружили по хешу уже начатый бакет
begin
reset(f,410);
c:=condition;
//Перемещаемся на первый блок и осуществляем поиск дубликатов
repeat
Seek(f,c);
BlockRead(f,list,1);
for i:=0 to 4 do
begin
if not(list.block[i].info) and (Rec.ID=list.block[i].ID)
then
begin
ShowMessage('Такая запись уже существует.');
CloseFile(f);
ClearPole;
exit;
end;
end;
c:=list.hndl;
until c=0;
repeat
Seek(f,condition);
BlockRead(f,list,1);
//проверяем на заполненность
for i:=0 to 4 do
begin
//если нашли "пусто",то впихиваем на это место и полностью переписываем блок
if list.block[i].info
then
begin
Seek(f,condition);
list.block[i]:=rec;
BlockWrite (f,list,1);
CloseFile(f);
ClearPole;
exit;
end;
end;
condition:=list.hndl;
until condition=0;
//Если все полностью забито,то меняем схему и в бакете указываем на прибавление
//и пишем нужный блок
//увеличиваем общее число блоков
inc(schema.last_block);
list.hndl:=schema.last_block;
Seek(f,last_elem);
BlockWrite (f,list,1);
schema.catalog[hash(rec.ID)].last:=schema.last_block;
Seek(f,0);
BlockWrite (f,schema,1);
Seek(f,Filesize(f));
list.block[0]:=rec;
list.block[1]:=rec0;
list.block[2]:=rec0;
list.block[3]:=rec0;
list.block[4]:=rec0;
list.hndl:=0;
BlockWrite(f,list,1);
CloseFile(f);
end;
end;
procedure TDB_Heap.ClearPole;
begin
leID.Clear;
leID.Focused;
Memo1.Lines.Clear;
end;
procedure TDB_Heap.SearchClick(Sender: TObject);
begin
if (length(leID.Text)<>0) then search_rec.ID:=StrToInt(leID.Text);
search_rec.SName:=leSName.Text;
search_rec.Fam:=leFam.Text;
if (length(leNumGr.Text)<>0) then search_rec.NumGr:=StrToInt(leNumGr.Text)
else search_rec.NumGr:=-1;
condition:=fSearch_res(hash(search_rec.ID),_add,last_elem);
if condition=-1 then
begin
Memo1.Lines.add('Файл пуст');
end
else
begin
if RadioButton2.Checked then
if condition=0 then
begin
ShowMessage('Не найдено');
CloseFile(f);
exit;
end
else
if not fSearch_by_key(search_rec.ID) then ShowMessage('Не найдено');
if RadioButton1.Checked then
if (not fSearch_by_no_key(search_rec.SName,search_rec.Fam,search_rec.NumGr))
then ShowMessage('Не найдено');
end;
end;
procedure TDB_Heap.ShowClick(Sender: TObject);
begin
Memo1.Clear;
reset(f,410);
if FileSize(f)<>0 then
begin
//Читаем служебную инфу в первом блоке
Seek(f,0);
//Прочитали в спец. переменную
BlockRead(f,schema,1);
Memo1.Lines.Add(schema.About+' и всего блоков '+IntTostr(schema.last_block));
for i:=0 to 3 do
if schema.catalog[i].first=0 then
begin
Memo1.Lines.Add(' Бакет №'+IntToStr(i)+' пуст');
end
else
begin
Memo1.Lines.Add(' Бакет №'+IntToStr(i)+' :');
Seek(f,schema.catalog[i].first);
BlockRead(f,list,1);
Memo1.Lines.Add('Блок №'+IntToStr(schema.catalog[i].first));
for j:=0 to 4 do
begin
rec:=list.block[j];
Memo1.Lines.Add(IntToStr(rec.ID));
Memo1.Lines.Add(rec.SName);
Memo1.Lines.Add(rec.Fam);
Memo1.Lines.Add(rec.Otch);
Memo1.Lines.Add(IntToStr(rec.NumGr));
Memo1.Lines.Add('------------------');
end;
while list.hndl<>0 do
begin
Memo1.Lines.Add('Блок №'+IntToStr(list.hndl));
Seek(f,list.hndl);
BlockRead(f,list,1);
for j:=0 to 4 do
begin
rec:=list.block[j];
Memo1.Lines.Add(IntToStr(rec.ID));
Memo1.Lines.Add(rec.SName);
Memo1.Lines.Add(rec.Fam);
Memo1.Lines.Add(rec.Otch);
Memo1.Lines.Add(IntToStr(rec.NumGr));
Memo1.Lines.Add('------------------');
end;
end;
end;
end
else Memo1.Lines.Add('Файл пуст');
end;
procedure TDB_Heap.Button1Click(Sender: TObject);
begin
Rewrite(f);
schema.last_block:=0;
end;
procedure TDB_Heap.DeleteClick(Sender: TObject);
begin
search_rec.ID:=StrToInt(leID.Text);
condition:=fSearch_res(hash(search_rec.ID),_add,last_elem);
reset(f,410);
repeat
Seek(f,condition);
BlockRead(f,list,1);
for i:=0 to 4 do
begin
if not(list.block[i].info) and (search_rec.ID=list.block[i].ID)
then
begin
list.block[i]:=rec0;
Seek(f,condition);
BlockWrite(f,list,1);
CloseFile(f);
Showmessage('Запись успешно стерта');
exit;
end;
end;
condition:=list.hndl;
until condition=0;
Showmessage('Такая запись не найдена');
CloseFile(f);
end;
procedure TDB_Heap.RadioButton2Click(Sender: TObject);
begin
RadioButton2.Checked:=true;
RadioButton1.Checked:=false;
end;
procedure TDB_Heap.RadioButton1Click(Sender: TObject);
begin
RadioButton1.Checked:=true;
RadioButton2.Checked:=false;
end;
procedure TDB_Heap.EditClick(Sender: TObject);
begin
rec.info:=false;
rec.ID:=StrToInt(leID.Text);
rec.SName:=leSName.Text;
rec.Fam:=leFam.Text;
rec.Otch:=leOtch.Text;
rec.NumGr:=StrToInt(leNumGr.Text);
search_rec.ID:=StrToInt(leID.Text);
condition:=fSearch_res(hash(search_rec.ID),_add,last_elem);
reset(f,410);
repeat
Seek(f,condition);
BlockRead(f,list,1);
for i:=0 to 4 do
begin
if not(list.block[i].info) and (search_rec.ID=list.block[i].ID)
then
begin
list.block[i]:=rec;
Seek(f,condition);
BlockWrite(f,list,1);
CloseFile(f);
Showmessage('Запись успешно изменена');
exit;
end;
end;
condition:=list.hndl;
until condition=0;
Showmessage('Такая запись не найдена');
CloseFile(f);
end;
end.