Дипломная работа: Разработка базы данных

end;

F.Free;

end;

procedure TMainForm.ApplicationEvents1Hint(Sender: TObject);

begin

StatusBar1.SimpleText:=Application.Hint;

end;

procedure TMainForm.RadioGroup1Click(Sender: TObject);

begin

DataSetRefrashExecute(Sender);

end;

procedure TMainForm.RadioGroup2Click(Sender: TObject);

begin

DataSetRefrashExecute(Sender);

end;

procedure TMainForm.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn;

State: TGridDrawState);

begin

if (DataModule1.fWriter) and (gdFocused in State) then

if (Column.Field.FieldName = 'Author') or

(Column.Field.FieldName = 'Title') or

(Column.Field.FieldName = 'Language') then

begin

EditField:=Column.Field.FieldNo-1;

Edit1.Text:=Column.Field.AsString;

with Edit1 do

begin

Left := Rect.Left + DBGrid1.Left;

Top := Rect.Top + DBGrid1.Top+PanelGrid.Top+PanelMain.Top;

Width := Rect.Right - Rect.Left + 2;

Visible := True;

end;

procedure TMainForm.DBGrid1ColExit(Sender: TObject);

var

FldName : ShortString;

begin

if DataModule1.fWriter then

begin

FldName:=DBGrid1.SelectedField.FieldName;

if (FldName = 'Author') or

(FldName = 'Title') or

(FldName = 'Language') then

begin

Edit1.Visible := False;

end;

procedure TMainForm.DBGrid1KeyPress(Sender: TObject; var Key: Char);

var

FldName : ShortString;

begin

if DataModule1.fWriter then

begin

FldName:=DBGrid1.SelectedField.FieldName;

if (FldName = 'Author') or

(FldName = 'Title') or

(FldName = 'Language') then

if (Key <> Chr(9)) then

begin

Edit1.SetFocus;

SendMessage(Edit1.Handle, WM_CHAR, Word(Key), 0);

end;

procedure TMainForm.Edit1Exit(Sender: TObject);

const

NamePre='Update';

ParPre ='ip';

Par: array [1..5] of ShortString=('Aut', 'Tit', 'Lan', 'Typ' ,'Ext');

begin

with DataModule1, DataModule1.IBStoredProc1 do

if IBDataSet1.Fields.Fields[EditField].AsString<>Edit1.Text then

begin

StoredProcName:=NamePre+IBDataSet1.FieldList.Strings[EditField];

ParamByName(ParPre+Par[EditField]).Value:=Edit1.Text;

ParamByName('ipNum').Value:=IBDataSet1.Fields.Fields[0].AsInteger;

Prepare;

ExecProc;

DataSetRefrashExecute(Sender);

end;

procedure TMainForm.DataSetInsertExecute(Sender: TObject);

var

N : Integer;

ArcName: ANSIString;

Stream : TMemoryStream;

Res : Boolean;

begin

if not Assigned (EditForm) then

EditForm:= TEditForm.Create (Application);

with EditForm do

begin

Caption:=InsertWinName;

ShowModal;

if ModalResult=mrOK then

begin

case RadioGroupSource.ItemIndex of

begin

if Trim(EditNewArc.Text)<>'' then

ArcName:=GetNewArcName(EditNewArc.Text+ArcExt)

else

begin

ArcName:=ExtractFileLastDir(EditDir.Text);

ArcName:=GetNewArcName(LibDir+ArcName+ArcExt);

end;

Res:=PackFiles(ArcName,EditDir.Text+'\*.*');

end;

begin

if (Trim(EditNewArc.Text)<>'') then

begin

ArcName:=GetNewArcName(EditNewArc.Text+ArcExt);

Res:=(CopyFiles(Application.Handle,EditArc.Text,ArcName)=0);

end

else

begin

ArcName:=EditArc.Text;

Res:=True;

end;

begin

if Trim(EditNewArc.Text)<>'' then

ArcName:=GetNewArcName(EditNewArc.Text+ArcExt)

else

begin

ArcName:=ExtractFileName(EditFile.Text);

DeleteFileExt(ArcName);

ArcName:=GetNewArcName(LibDir+ArcName+ArcExt);

end;

Res:=PackFiles(ArcName,EditFile.Text);

end;

if Res then

begin

Stream:=TMemoryStream.Create;

Memo1.Lines.SaveToStream(Stream);

DataModule1.CallInsertBook(ComboBoxAut.Text,

ComboBoxTit.Text,

ComboBoxLan.Text,

Stream,

ArcName,

ExtractFileName(EditFile.Text),N);

Stream.Free;

MainForm.DataSetRefrashExecute(Sender);

DataModule1.IBDataSet1.Locate('Number',N,[loPartialKey]);

end;

procedure TMainForm.DataSetDeleteExecute(Sender: TObject);

begin

if ConfirmDelete then

begin

if not Assigned (DeleteForm) then

DeleteForm:= TDeleteForm.Create (Application);

with DeleteForm do

begin

Caption:=DeleteWinName;

ShowModal;

end;

if (DeleteForm.ModalResult = mrYes) then

DataModule1.CallDeleteBook;

end

else

DataModule1.CallDeleteBook;

DataSetRefrashExecute(Sender);

end;

procedure TMainForm.DataSetUpdateExecute(Sender: TObject);

var

N : Integer;

ArcName: ANSIString;

Str : ANSIString;

Stream : TStream;

MStream: TMemoryStream;

Res : Boolean;

begin

if not Assigned (EditForm) then

EditForm:= TEditForm.Create (Application);

with EditForm do

begin

Caption:=EditWinName;

with DataModule1.IBDataSet1 do

begin

N:=Fields.Fields[0].AsInteger;

ComboBoxAut.Text:=Fields.Fields[1].AsString;

ComboBoxTit.Text:=Fields.Fields[2].AsString;

ComboBoxLan.Text:=Fields.Fields[3].AsString;

RadioGroupSource.ItemIndex:=1;

EditDir.Text:='';

EditArc.Text:='';

EditFile.Text:=FieldByName('File').AsString;

Stream:=CreateBLOBStream(FieldByName('Sections'),bmRead);

Memo1.Lines.LoadFromStream(Stream);

EditArc.Text:=FieldByName('Archive').AsString;

Stream.Free;

end;

ShowModal;

if ModalResult=mrOK then

begin

ArcName:=Root+TmpDir+TmpFile+'.rar';

case RadioGroupSource.ItemIndex of

begin

if EditDir.Text<>'' then

begin

ArcName:=Concat(Root+TmpDir+TmpFile);

Res:=PackFiles(ArcName,EditDir.Text+'\*.*');

ArcName:=ArcName+'.rar';

end;

begin

if EditArc.Text<>'' then

begin

ArcName:=EditArc.Text;

Res:=True;

end;

begin

Str:=DataModule1.IBDataSet1.FieldByName('File').AsString;

if EditFile.Text<>Str then

begin

ArcName:=Root+TmpDir+TmpFile+'.rar';

Res:=PackFiles(ArcName,EditFile.Text);

end;

if Res then

begin

MStream:=TMemoryStream.Create;

Memo1.Lines.SaveToStream(MStream);

DataModule1.CallUpDateBook(N, ComboBoxAut.Text,

ComboBoxTit.Text,

ComboBoxLan.Text,

MStream,

ArcName,

ExtractFileName(EditFile.Text));

MStream.Free;

end;

if (RadioGroupSource.ItemIndex<>1) then

DeleteFiles(EditForm.Handle,ArcName);

DataSetRefrashExecute(Sender);

DataModule1.IBDataSet1.Locate('Number',N,[loPartialKey]);

end;

procedure TMainForm.DataSetRefrashExecute(Sender: TObject);

var

S: ShortString;

B: TBookmark;

begin

with DataModule1.IBDataSet1 do

begin

B:=GetBookMark;

Close;

SelectSQL.Clear;

SelectSQL.Add('SELECT * FROM "Library" ');

end;

if SortByNum.Checked then S:=SQLSortBy[0]

else if SortByAut.Checked then S:=SQLSortBy[1]

else if SortByTit.Checked then S:=SQLSortBy[2]

else if SortByLan.Checked then S:=SQLSortBy[3]

else if SortByNo.Checked then S:=SQLSortBy[4];

DataModule1.IBDataSet1.SelectSQL.Add(S);

if (not SortByNo.Checked) then

begin

if SortDirInc.Checked then S:=SqlSortDir[0]

else S:=SqlSortDir[1];

DataModule1.IBDataSet1.SelectSQL.Add(S);

end;

with DataModule1.IBDataSet1 do

begin

Open;

GotoBookmark(B);

FreeBookmark(B);

end;

procedure TMainForm.DataSetOpenExecute(Sender: TObject);

var

ArcPath: ANSIString;

FName : ANSIString;

OpenDir: ShortString;

begin

Inc(OpenCounter);

OpenDir:=Root+TmpDir+IntToStr(OpenCounter)+'\';

MkDir(OpenDir);

ArcPath:=DataModule1.IBDataSet1.FieldByName('Archive').AsString;

UnPackFiles(ArcPath,OpenDir);

FName:=DataModule1.IBDataSet1.FieldByName('File').AsString;

FName:=Concat(OpenDir+FName);

OpenFile(FName,OpenDir);

end;

procedure TMainForm.DataSetFindExecute(Sender: TObject);

begin

if not Assigned (FindForm) then

FindForm:= TFindForm.Create (Application);

FindForm.ShowModal;

if (DataModule1.fSearchRec>=0) then

DatasetFindNext.Enabled:=True

else

DatasetFindNext.Enabled:=False;

end;

procedure TMainForm.DataSetFindNextExecute(Sender: TObject);

const

Txt=’Источник не найден';

WinName='Поиск источника';

var

KeyFlds : ShortString;

KeyVals : Variant;

Loc : TLocateOptions;

Res : Boolean;

BM : TBookmark;

begin

BM:=DataModule1.IBDataSet1.GetBookmark;

FindForm.GetLocateParams(KeyFlds,KeyVals,Loc);

Res:=DataModule1.IBDataSet1.LocateNext(KeyFlds,KeyVals,Loc);

with DataModule1 do

fSearchRec:=IBDataSet1.RecNo;

if not Res then

begin

DataModule1.IBDataSet1.GotoBookmark(BM);

DataModule1.fSearchRec:=-1;

DataSetFindNext.Enabled:=False;

Application.MessageBox(Txt,WinName,mb_OK);

end;

DataModule1.IBDataSet1.FreeBookmark(BM);

end;

procedure TMainForm.DataSetFilterExecute(Sender: TObject);

begin

if not Assigned (FilterForm) then

FilterForm:= TFilterForm.Create(Application);

FilterForm.ShowModal;

end;

procedure TMainForm.DataSetAllExecute(Sender: TObject);

begin

DataModule1.IBDataSet1.Filtered:=False;

end;

procedure TMainForm.FileDataBasePathExecute(Sender: TObject);

begin

if not Assigned (PathForm) then

PathForm:= TPathForm.Create(Application);

PathForm.ShowModal;

DataSetRefrashExecute(Sender);

end;

procedure TMainForm.FileUserExecute(Sender: TObject);

var

Path : AnsiString;

User : ShortString;

Pass : ShortString;

begin

if not Assigned (UserForm) then

UserForm:= TUserForm.Create(Application);

with UserForm do

begin

ShowModal;

if ModalResult=mrOK then

begin

Path:=DataModule1.IBDatabase1.DatabaseName;

User:=UserForm.leUser.Text;

Pass:=UserForm.lePass.Text;

if not DataModule1.Connect(Path,User,Pass) then Close;

DataSetRefrashExecute(Sender);

DataModule1.SetAccess;

DataSetInsert.Enabled:=DataModule1.fWriter;

DataSetDelete.Enabled:=DataModule1.fWriter;

DataSetUpdate.Enabled:=DataModule1.fWriter;

end;

procedure TMainForm.OptColorExecute(Sender: TObject);

begin

if ColorDialog1.Execute then

begin

DBGrid1.Color:=ColorDialog1.Color;

DBMemo1.Color:=ColorDialog1.Color;

Edit1.Color:=ColorDialog1.Color;

end;

procedure TMainForm.OptFontExecute(Sender: TObject);

begin

if FontDialog1.Execute then

begin

DBGrid1.Font.Assign(FontDialog1.Font);

DBMemo1.Font.Assign(FontDialog1.Font);

Edit1.Font.Assign(FontDialog1.Font);

end;

procedure TMainForm.OptConfDelExecute(Sender: TObject);

begin

ConfirmDelete:=not ConfirmDelete;

end;

procedure TMainForm.HelpAboutExecute(Sender: TObject);

begin

if not Assigned (AboutBox) then

AboutBox:= TAboutBox.Create (Application);

AboutBox.ShowModal;

end;

end.

Приложение Г

Листинг модуля DBUnit.pas

unit DBUnit;

interface

uses

SysUtils, Classes, DB, IBDatabase, IBCustomDataSet, IBQuery, IBStoredProc;

type

TDataModule1 = class(TDataModule)

DataSource1: TDataSource;

IBDatabase1: TIBDatabase;

IBTransaction1: TIBTransaction;

IBDataSet1: TIBDataSet;

IBStoredProc1: TIBStoredProc;

function Connect(Path:ANSIString;

User, Password: ShortString): Boolean;

function InitDBParams: Boolean;

procedure SetAccess;

procedure CallInsertBook(Aut, Tit, Lan: ShortString;

Sec: TStream;

Arc: ANSIString;

Fil: ShortString;

var Num: Integer);

procedure CallUpdateBook(Num: Integer;

Aut, Tit, Lan: ShortString;

Sec: TStream;

Arc: ANSIString;

Fil: ShortString);

procedure CallDeleteBook;

procedure SetFilter(CaseFlag: Boolean; Aut, Tit, Lan, Sec: ShortString);

function IsFieldContainStr(Field, S: ShortString): Boolean;

procedure IBDataSet1FilterRecord(DataSet: TDataSet; var Accept: Boolean);

procedure IBDataSet1AfterScroll(DataSet: TDataSet);

private

fCase : Boolean;

fFltrAut: ShortString;

fFltrTit: ShortString;

fFltrLan: ShortString;

fFltrSec: ShortString;

public

fSearchRec : Integer;

fSearchKey : ShortString;

fSearchCase: Boolean;

fWriter : Boolean;

fUser : ShortString;

fPass : ShortString;

fServer : ShortString;

fFile : ShortString;

end;

var

DataModule1: TDataModule1;

implementation

uses StrUtils, DBTables, Dialogs, Main, Data;

{$R *.dfm}

{ TDataModule1 }

function TDataModule1.Connect(Path:ANSIString;

User, Password: ShortString): Boolean;

const

ParamNames: array[0..3] of ShortString = (

'lc_ctype=',

'sql_role_name=',

'user_name=',

'password=');

CharSet='WIN1251';

SQLRole='3';

ErrPathUserPass='Неверный путь к базе или пароль пользователя';

ErrFatal='Соединение с базой данных не возможно';

var

OldUser: ShortString;

OldPass: ShortString;

OldPath: AnsiString;

begin

OldPath:='';

OldUser:='';

OldPass:='';

with IBDataBase1 do

begin

IBDataBase1.Connected:=False;

if Params.Count<>0 then

begin

OldUser:=fUser;

OldPass:=fPass;

OldPath:=DataBaseName;

end;

IBDataBase1.Params.Clear;

Params.Add(Concat(ParamNames[0],CharSet));

Params.Add(Concat(ParamNames[1],SQLRole));

Params.Add(Concat(ParamNames[2],User));

Params.Add(Concat(ParamNames[3],Password));

LoginPrompt:=False;

DatabaseName:=Path;

end;

try

IBDataBase1.Connected:=True;

fUser:=User;

fPass:=Password;

except

ShowMessage(ErrPathUserPass);

if (OldPath<>'') and (OldUser<>'') and (OldPass<>'') then

with IBDataBase1 do

begin

DatabaseName:=OldPath;

Params[2]:=OldUser;

Params[3]:=OldPass;

Connected:=False;

try

Connected:=True;

fUser:=User;

fPass:=Password;

except

ShowMessage(ErrFatal);

end;

Result:=IBDataBase1.Connected;

end;

function TDataModule1.InitDBParams: Boolean;

var

Path: ANSIString;

begin

fUser:=ParamStr(1);

fPass:=ParamStr(2);

fServer:=Paramstr(3);

fFile:=Paramstr(4);

if (fUser='') then fUser:=DBDefaultUser;

if (fPass='') then fPass:=DBDefaultPass;

if (fServer='') then fServer:=DBDefaultServer;

if (fFile='') then fFile:=DBDefaultFile;

Path:=Concat(fServer,':',fFile);

Result:=DataModule1.Connect(Path,fUser,fPass);

end;

procedure TDataModule1.SetAccess;

begin

with IBStoredProc1 do

begin

StoredProcName:='IsWriter';

Prepare;

try

ExecProc;

fWriter:=True;

except

fWriter:=False;

end;

procedure TDataModule1.CallInsertBook(Aut, Tit, Lan: ShortString;

Sec: TStream;

Arc: ANSIString;

Fil: ShortString;

var Num: Integer);

begin

with IBStoredProc1 do

begin

StoredProcName:='InsertBook';

ParamByName('ipAut').Value:=Aut;

ParamByName('ipTit').Value:=Tit;

ParamByName('ipLan').Value:=Lan;

ParamByName('ipSec').LoadFromStream(Sec,ftMemo);

ParamByName('ipArc').Value:=Arc;

ParamByName('ipFil').Value:=Fil;

Prepare;

ExecProc;

Num:=ParamByName('opNum').Value;

end;

procedure TDataModule1.CallUpdateBook(Num: Integer;

Aut, Tit, Lan: ShortString;

Sec: TStream;

Arc: ANSIString;

Fil: ShortString);

begin

with IBStoredProc1 do

begin

StoredProcName:='UpdateBook';

ParamByName('ipNum').Value:=Num;

ParamByName('ipAut').Value:=Aut;

ParamByName('ipTit').Value:=Tit;

ParamByName('ipLan').Value:=Lan;

ParamByName('ipSec').LoadFromStream(Sec,ftMemo);

ParamByName('ipArc').Value:=Arc;

ParamByName('ipFil').Value:=Fil;

Prepare;

ExecProc;

end;

procedure TDataModule1.CallDeleteBook;

begin

if (IBDataSet1.RecNo<>0) then

with IBStoredProc1 do

begin

StoredProcName:='DeleteBook';

ParamByName('Num').Value:=IBDataSet1.Fields.Fields[0].Value;

Prepare;

ExecProc;

end;

procedure TDataModule1.SetFilter(CaseFlag: Boolean;

Aut, Tit, Lan,Sec: ShortString);

begin

fCase:=CaseFlag;

fFltrAut:=Aut;

fFltrTit:=Tit;

fFltrLan:=Lan;

fFltrSec:=Sec;

IBDataSet1.Filtered:=False;

IBDataSet1.Filtered:=True;

end;

function TDataModule1.IsFieldContainStr(Field, S: ShortString): Boolean;

begin

if Trim(S)<>'' then

if fCase then

Result:=ANSIContainsStr(Field,S)

else

Result:=ANSIContainsText(Field,S)

else

Result:=True;

end;

procedure TDataModule1.IBDataSet1FilterRecord(DataSet: TDataSet;

var Accept: Boolean);

var

Aut: Boolean;

Tit: Boolean;

Lan: Boolean;

Sec: Boolean;

begin

Aut:=IsFieldContainStr(DataSet['Author'],fFltrAut);

Tit:=IsFieldContainStr(DataSet['Title'],fFltrTit);

Lan:=IsFieldContainStr(DataSet['Language'],fFltrLan);

Sec:=IsFieldContainStr(DataSet['Sections'],fFltrSec);

Accept:=Aut and Tit and Lan and Sec;

end;

procedure TDataModule1.IBDataSet1AfterScroll(DataSet: TDataSet);

var

Stream: TStream;

begin

if not IBDataSet1.FieldByName('Sections').IsNull then

begin

Stream:=IBDataSet1.CreateBlobStream(IBDataSet1.FieldByName('Sections'),bmRead);

Stream.Free;

end;

end.

Приложение Д

Листинг модуля Edit.pas

unit Edit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Buttons, CheckLst, Mask, Menus, ActnList;

type

TEditForm = class(TForm)

Panel1: TPanel;

BCancel: TBitBtn;

BOK: TBitBtn;

Panel2: TPanel;

RadioGroupSource: TRadioGroup;

OpenDialogArc: TOpenDialog;

GroupBoxData: TGroupBox;

LabelTit: TLabel;

LabelLan: TLabel;

LabelTyp: TLabel;

LabelAut: TLabel;

ComboBoxAut: TComboBox;

ComboBoxTit: TComboBox;

ComboBoxLan: TComboBox;

GroupBoxSections: TGroupBox;

GroupBoxPath: TGroupBox;

LabelDir: TLabel;

EditDir: TEdit;

BBrowseDir: TBitBtn;

LabelArc: TLabel;

EditArc: TEdit;

BBrowseArc: TBitBtn;

LabelFile: TLabel;

EditFile: TEdit;

BBrowseFile: TBitBtn;

EditNewArc: TEdit;

LabelNewArc: TLabel;

Memo1: TMemo;

procedure FormActivate(Sender: TObject);

procedure SetComboBox(FieldNum: Integer; CBox: TComboBox);

procedure BBrowseArcClick(Sender: TObject);

procedure BBrowseFileClick(Sender: TObject);

procedure RadioGroupSourceClick(Sender: TObject);

procedure BBrowseDirClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

EditForm: TEditForm;

implementation

uses DB, DirSource, DBUnit, Files, Data;

{$R *.dfm}

procedure TEditForm.FormActivate(Sender: TObject);

begin

SetComboBox(1,ComboBoxAut);

SetComboBox(2,ComboBoxTit);

SetComboBox(3,ComboBoxLan);

RadioGroupSourceClick(Sender);

end;

procedure TEditForm.SetComboBox(FieldNum: Integer; CBox: TComboBox);

var

B : TBookmark;

S : ShortString;

Present: Boolean;

I : Integer;

begin

CBox.Items.Clear;

with DataModule1.IBDataSet1 do

begin

B:=GetBookmark;

First;

DisableControls;

while not EOF do

begin

S:=Fields.Fields[FieldNum].AsString;

if S<>'' then

begin

Present:=False;

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12

МЕНЮ

Дипломная работа: Разработка базы данных