Проектирование и разработка базы данных для реализации транспортного контроля

..............................................................
function closed_IfItemExists(It:ItemType;var _Pos:integer):Boolean;
var cFile:file;
cItem:ItemType;
cPos:integer;
cHead:bHeader;
Count,Counter:integer;
begin
Result:=false;
//Open Base file
AssignFile(cFile,OpenedFile);
Reset(cFile,1);
Blockread(cFile,cHead,BaseHeaderTypeSize);
Count:=cHead.TotalItem;
Seek(cFile,BaseHeaderTypeSize);
for Counter:=0 to Count-1 do
begin
cPos:=FilePos(cFile);
BlockRead(cFile,cItem,ItemTypeSize);
if cItem.Name = It.name then
begin
_Pos:=cPos;
Result:=true;
CloseFile(cFile);
exit;
end;
end;
//Close Base file
CloseFile(cFile);
end;
//......................................................
function opened_IfItemExists(It:ItemType;var _Pos:integer):Boolean;
var cFile:file;
cItem:ItemType;
cPos:integer;
cHead:bHeader;
Count,Counter:integer;
begin
Result:=false;
//Open Base file
AssignFile(cFile,OpenedFile);
Reset(cFile,1);
Blockread(cFile,cHead,BaseHeaderTypeSize);
Count:=cHead.TotalItem;
Seek(cFile,BaseHeaderTypeSize);
for Counter:=0 to Count-1 do
begin
cPos:=FilePos(cFile);
BlockRead(cFile,cItem,ItemTypeSize);
if cItem.Name = It.name then
begin
_Pos:=cPos;
Result:=true;
CloseFile(cFile);
exit;
end;
Zakupka.Enabled:=False;
Zakupka.Color:=$00000000;
Opt.Enabled:=False;
Opt.Color:=$00000000;
Roznica.Enabled:=False;
Roznica.Color:=$00000000;
SendEdit.Enabled:=False;
SendEdit.Color:=$00000000;
Prixod.Enabled:=False;
Prixod.Color:=$00000000;
CountEdit.Enabled:=False;
CountEdit.Color:=$00000000;
BuyTime.Enabled:=false;
btOk.Enabled:=false;
CreateBtn.Enabled:=false;
//.......................
btAddItem.Enabled:=true;
btDelItem.Enabled:=true;
//.................................
AssignFile(tmpBase,'tmpBase.dat');
Rewrite(tmpbase,1);
TmpPos:=0;
//.................................
Caption:='';
Caption:='Новая цена';
ItemList.Clear;
BuyTime.DateTime:=Date;
end;
//................................................
procedure TnkNew1.CreateBtnClick(Sender: TObject);
var counter:word;
Base:file;
tHeader:bHeader;
SearchItem:ItemType;
TmpItem:ItemType;
SavePosition:integer;
begin
if FileExists('tmpBase.dat') then
begin
Seek(tmpBase,0);
AssignFile(Base,OpenedFile);
Reset(Base,1);
BlockRead(Base,tHeader,BaseHeaderTypeSize);
Seek(Base,BaseHeaderTypeSize+(tHeader.TotalItem*ItemTypeSize));
for counter:=0 to ItemList.Items.Count-1 do
begin
BlockRead(TmpBase,cItem,ItemTypeSize);
BlockWrite(Base,cItem,ItemTypeSize);
Inc(tHeader.TableCategory[cItem.CategoryNumber].ItemsCount,cItem.Count);
end;
tHeader.TotalItem:=tHeader.TotalItem+ItemList.Items.Count;
Seek(Base,0);
BlockWrite(Base,tHeader,BaseHeaderTypeSize);
CloseFile(Base);
CloseFile(tmpBase);
Erase(tmpBase);
end;
end;
//...................................................................
end.
About;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TAboutForm = class(TForm)
Image1: TImage;
PathLabel: TLabel;
procedure Image1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AboutForm: TAboutForm;
procedure ShowAboutForm;
procedure HideAboutForm;
implementation
{$R *.DFM}
procedure ShowAboutForm;
begin
AboutForm.Show;
end;
//......................
procedure HideAboutForm;
begin
AboutForm.Hide;
end;
//......................
procedure TAboutForm.Image1Click(Sender: TObject);
begin
HideAboutForm;
end;
procedure TAboutForm.FormActivate(Sender: TObject);
begin
AboutForm.Repaint;
end;
end.
unit BaseFile;
interface
uses SysUtils, cForm, MyTypes, CategoryAdd_Dialog, Controls, Forms, Dialogs,
StdCtrls, Windows, GetText;
procedure CreateBaseFile(FileName:String);
procedure OpenBaseFile(FileName:String);
procedure AddCategory;
procedure DeleteCategory(CategoryName:string);
procedure _RefreshCategoryes;
function GetCategory(CurrentCategory:string):integer;
function ReturnItem(Number:word;var Pos:integer):ItemType;
function GetItemCount:integer;
function closed_IfItemExists(It:ItemType;var _Pos:integer):Boolean;
function opened_IfItemExists(It:ItemType;var _Pos:integer):Boolean;
var CategoryStartPosition:integer;
BaseHeader:bHeader;
OpenedFile:String;
CurrentCategoryNumber:word;
ItemsCount:integer;
SelectedItem:word;
implementation
var bFile:file;
{........................................}
procedure CreateBaseFile(FileName:String);
var c:word;
pass:string[16];
begin
OpenedFile:=FileName;
AssignFile(bFile,FileName);
Rewrite(bFile,1);
{Fill info about empty base file}
with BaseHeader do
begin
Creator:='Creator: The Counter, v1.0 (C) 1999';
{CreateDate:=Date;}
Version:=$0100;
CategoryCount:=0;
TotalItem:=0;
for c:=1 to TotalCategoryes do
with TableCategory[c] do
begin
Name:='';
ItemsCount:=0;
Number:=-1;
OldNumber:=-1;
//...
OptSel.Hand:=true;
OptSel.percent:=false;
OptSel.digit:=false;
OptSel.PercentValue:=0;
OptSel.DigitValue:=0;
//...
RoznicaSel.Hand:=true;
RoznicaSel.percent:=false;
RoznicaSel.digit:=false;
RoznicaSel.PercentValue:=0;
RoznicaSel.DigitValue:=0;
end;
end;
CategoryStartPosition:=SizeOf(BaseHeader);
Pass:=ReturnText('Введите пароль');
if mResult = mrCancel then Pass:='';
BaseHeader.Password:=Pass;
{Write to Begin of the file Base Header}
BlockWrite(bFile,BaseHeader,SizeOf(BaseHeader));
CloseFile(bFile);
end;
{........................................}
procedure OpenBaseFile(FileName:String);
begin
if FileName = '' then exit;
AssignFile(bFile,FileName);
Reset(bFile,1);
BlockRead(bFile,BaseHeader,BaseHeaderTypeSize);
OpenedFile:=FileName;
CategoryStartPosition:=BaseHeaderTypeSize;
CloseFile(bFile);
end;
{........................................}
Procedure _RefreshCategoryes;
begin
AssignFile(bFile,OpenedFile);
Reset(bFile,1);
BlockRead(bFile,BaseHeader,SizeOf(BaseHeader));
CategoryStartPosition:=SizeOf(BaseHeader);
CloseFile(bFile);
end;
{........................................}
procedure AddCategory;
var FillCategory:CategoryType;
check:byte;
begin
cAddDialog.ShowModal;
if cAddDialog.ModalResult = mrCancel then exit;
if cAddDialog.ModalResult = mrNone then exit;
AssignFile(bFile,OpenedFile);
Reset(bFile,1);
BlockRead(bFile,BaseHeader,SizeOf(BaseHeader));
{Fill category}
If BaseHeader.CategoryCount = TotalCategoryes then
begin
MessageBeep(MB_ICONASTERISK);
MessageDlg(#13+'Количество категорий не может превышать 50!',mtError, [mbOk], 0);
CloseFile(bFile);
exit;
end;
if FillCategory.Name = #32 then FillCategory.Name := 'Категория не задана';
if FillCategory.Name = #32#32 then FillCategory.Name := 'Категория не задана';
if FillCategory.Name = #32#32#32 then FillCategory.Name := 'Категория не задана';
{end fill category}
for check:=1 to TotalCategoryes do
begin
if FillCategory.Name = BaseHeader.TableCategory[check].Name then
begin
MessageBeep(MB_ICONASTERISK);
MessageDlg(#13+'Такая категория уже существует!',mtError, [mbOk], 0);
CloseFile(bFile);
exit;
end;
end;
//...
for check:=1 to TotalCategoryes do
begin
if BaseHeader.TableCategory[check].number = -1 then
begin
FillCategory := BaseHeader.TableCategory[check];
FillCategory.Name := cAddDialog.Edit1.Text;
FillCategory.ItemsCount := 0;
FillCategory.Number:=check;
BaseHeader.CategoryCount:=BaseHeader.CategoryCount+1;
BaseHeader.TableCategory[check]:=FillCategory;
Seek(bFile,0);
BlockWrite(bFile,BaseHeader,SizeOf(BaseHeader));
Break;
{end of write changes to disk}
end;
end;
CloseFile(bFile);
end;
{........................................}
procedure DeleteCategory(CategoryName:string);
var FillCategory:CategoryType;
OldCategory:CategoryType;
c:word;
begin
AssignFile(bFile,OpenedFile);
Reset(bFile,1);
BlockRead(bFile,BaseHeader,SizeOf(BaseHeader));
for c:=1 to TotalCategoryes do
begin
If BaseHeader.TableCategory[c].name = CategoryName then
begin
OldCategory:=BaseHeader.TableCategory[c];
{Fill category}
FillCategory.Name:='';
FillCategory.ItemsCount:=0;
FillCategory.Number:=-1;
{FillCategory.OldNumber:=OldCategory.Number;}
FillCategory.OptSel.Hand:=true;
FillCategory.OptSel.percent:=false;
FillCategory.OptSel.digit:=false;
FillCategory.OptSel.PercentValue:=0;
FillCategory.OptSel.DigitValue:=0;
FillCategory.RoznicaSel.Hand:=true;
FillCategory.RoznicaSel.percent:=false;
FillCategory.RoznicaSel.digit:=false;
FillCategory.RoznicaSel.PercentValue:=0;
FillCategory.RoznicaSel.DigitValue:=0;
{end fill category}
BaseHeader.TableCategory[c]:=FillCategory;
BaseHeader.CategoryCount:=BaseHeader.CategoryCount-1;
Break;
end;
end;
{Write changes to disk}
Seek(bFile,0);
BlockWrite(bFile,BaseHeader,SizeOf(BaseHeader));
{end of write changes to disk}
CloseFile(bFile);
end;
{........................................}
function GetCategory(CurrentCategory:string):integer;
var count:word;
begin
Result:=1;
OpenBaseFile(OpenedFile);
for count:=1 to TotalCategoryes do
begin
if BaseHeader.TableCategory[count].Name = CurrentCategory then
begin
Result:=BaseHeader.TableCategory[count].Number;
exit;
end;
end;
end;
//..................................................................
function ReturnItem(Number:word;var Pos:integer):ItemType;
var cFile:file;
RetItem:ItemType;
Position:integer;
begin
//Open Base file
AssignFile(cFile,'TmpItem.lst');
Reset(cFile,1);
Position:=Number*(ItemTypeSize+4);
Seek(cFile,Position);
BlockRead(cFile,Pos,4);
BlockRead(cFile,RetItem,ItemTypeSize);
Result:=RetItem;
CloseFile(cFile);
end;
//..................................................................
//..................................................................
function GetItemCount:integer;
begin
OpenBaseFile(OpenedFile);
Result:=BaseHeader.TotalItem;
end;
//..................................................................
function closed_IfItemExists(It:ItemType;var _Pos:integer):Boolean;
var cFile:file;
cItem:ItemType;
cPos:integer;
cHead:bHeader;
Count,Counter:integer;
begin
Result:=false;
//Open Base file
AssignFile(cFile,OpenedFile);
Reset(cFile,1);
Blockread(cFile,cHead,BaseHeaderTypeSize);
Count:=cHead.TotalItem;
Seek(cFile,BaseHeaderTypeSize);
for Counter:=0 to Count-1 do
begin
cPos:=FilePos(cFile);
BlockRead(cFile,cItem,ItemTypeSize);
if cItem.Name = It.name then
begin
_Pos:=cPos;
Result:=true;
CloseFile(cFile);
exit;
end;
end;
//Close Base file
CloseFile(cFile);
end;
//......................................................
function opened_IfItemExists(It:ItemType;var _Pos:integer):Boolean;
var cFile:file;
cItem:ItemType;
cPos:integer;
cHead:bHeader;
Count,Counter:integer;
begin
Result:=false;
//Open Base file
AssignFile(cFile,OpenedFile);
Reset(cFile,1);
Blockread(cFile,cHead,BaseHeaderTypeSize);
Count:=cHead.TotalItem;
Seek(cFile,BaseHeaderTypeSize);
for Counter:=0 to Count-1 do
begin
cPos:=FilePos(cFile);
BlockRead(cFile,cItem,ItemTypeSize);
if cItem.Name = It.name then
begin
_Pos:=cPos;
Result:=true;
CloseFile(cFile);
exit;
end;
Zakupka.Enabled:=False;
Zakupka.Color:=$00000000;
Opt.Enabled:=False;
Opt.Color:=$00000000;
Roznica.Enabled:=False;
Roznica.Color:=$00000000;
SendEdit.Enabled:=False;
SendEdit.Color:=$00000000;
Prixod.Enabled:=False;
Prixod.Color:=$00000000;
CountEdit.Enabled:=False;
CountEdit.Color:=$00000000;
BuyTime.Enabled:=false;
btOk.Enabled:=false;
CreateBtn.Enabled:=false;
//.......................
btAddItem.Enabled:=true;
btDelItem.Enabled:=true;
//.................................
AssignFile(tmpBase,'tmpBase.dat');
Rewrite(tmpbase,1);
TmpPos:=0;
//.................................
Caption:='';
Caption:='Новая цена';
ItemList.Clear;
BuyTime.DateTime:=Date;
end;
//................................................
procedure TnkNew1.CreateBtnClick(Sender: TObject);
var counter:word;
Base:file;
tHeader:bHeader;
SearchItem:ItemType;
TmpItem:ItemType;
SavePosition:integer;
begin
if FileExists('tmpBase.dat') then
begin
Seek(tmpBase,0);
AssignFile(Base,OpenedFile);
Reset(Base,1);
BlockRead(Base,tHeader,BaseHeaderTypeSize);
Seek(Base,BaseHeaderTypeSize+(tHeader.TotalItem*ItemTypeSize));
for counter:=0 to ItemList.Items.Count-1 do
begin
BlockRead(TmpBase,cItem,ItemTypeSize);
BlockWrite(Base,cItem,ItemTypeSize);
Inc(tHeader.TableCategory[cItem.CategoryNumber].ItemsCount,cItem.Count);
end;
tHeader.TotalItem:=tHeader.TotalItem+ItemList.Items.Count;
Seek(Base,0);
BlockWrite(Base,tHeader,BaseHeaderTypeSize);
CloseFile(Base);
CloseFile(tmpBase);
Erase(tmpBase);
end;
end;
//...................................................................
end.

[] Фуфаев Э.В., Базы данных: Учебное пособие для студентов учреждений среднего профессионального образования, М.: ИЦ Академия, 2013. c.120-132

[] Фуфаев Э.В., Базы данных: Учебное пособие для студентов учреждений среднего профессионального образования, М.: ИЦ Академия, 2013. c.206

[] Агальцов В.П., Базы данных. В 2-х т.Т. 1. Локальные базы данных: Учебник, М.: ИД ФОРУМ, НИЦ ИНФРА-М, 2013. - c.12
[] Фуфаев Э.В., Базы данных: Учебное пособие для студентов учреждений среднего профессионального образования, М.: ИЦ Академия, 2013. c.203

[] Панкратов А.С., Подход к построению интегрирующей системы, объединяющей медицинские базы данных, РУДН, 2010. c.69















1







Груз

Код груза
Наименование груза
Цена

Получатель

Код получателя
Наименование получателя
Адрес получателя




Договор

Номер подпункта
Код получателя
Код груза
Количество
Стоимость

Количество

Наименование груза

Наименование получателя

№ п/п #

Код получателя #

Код груза #

Адрес получателя

Стоимость

Цена