Дипломная работа: Разработка базы данных
for I:=0 to CBox.Items.Count-1
do
if S=CBox.Items.Strings[I] then
begin
Present:=True;
Break;
end;
if (not Present) then
CBox.Items.Add(S);
end;
Next;
end;
GotoBookmark(B);
FreeBookmark(B);
EnableControls;
end;
end;
procedure
TEditForm.BBrowseArcClick(Sender: TObject);
begin
with OpenDialogArc do
begin
Title:='Поиск архива';
Filter :=
'Любые архивы|*.RAR;*ZIP;*ARJ'+
'Любые файлы|*.*'+
'RAR-архивы
(*.rar)|*.RAR|'+
'ZIP-архивы
(*.zip)|*.ZIP|'+
'ARJ-архивы
(*.arj)|*.ARJ'; InitialDir:=InitDir;
if Execute then
begin
EditArc.Text:=FileName;
BBrowseFile.Enabled:=True;
EditFile.Text:='';
end;
end;
end;
procedure
TEditForm.BBrowseFileClick(Sender: TObject);
var
ArcPath: ANSIString;
OpenDir: ANSIString;
Res : Boolean;
OpenDialogFile: TOpenDialog;
begin
Res:=True;
if RadioGroupSource.ItemIndex =
1 then
begin
Res:=CopyFiles(EditForm.Handle,EditArc.Text,
Root+TmpDir+ExtractFileName(EditArc.Text))=0;
if Res then
begin
ArcPath:=Concat(Root,TmpDir,ExtractFileName(EditArc.Text));
OpenDir:=Concat(Root,BrowseDir);
Res:=UnPackFiles(ArcPath,OpenDir);
end;
end;
if Res then
begin
OpenDialogFile:=TOpenDialog.Create(Application);
with OpenDialogFile do
begin
InitialDir:='E:\Andrew\';
Title:='Главный файл';
Filter :=
'Любые документы |'+
'*.TXT;*.DOC;*.RTF;*.WRI;*.PDF;*.HTM;*.HTML;*.SHTML;*.XML|'+
'Любые файлы (*.*)|*.*|'+
'Текстовые файлы (*.txt)|*.TXT|'+
'Докуметы Word(*.doc)|*.DOC|'+
'Rich Text
Format(*.rtf)|*.RTF|'+
'Текст в формате WRI(*.wri)|*.WRI|'+
'Документы Acrobat (*.pdf)|*.PDF|'+
'Web-страницы(*.htm, *.html,
*.shtml, *.xml)|*.HTM;*.HTML;*.SHTML;*. case RadioGroupSource.ItemIndex of
0:
InitialDir:=DirSourceForm.ShellComboBox1.Path;
1: InitialDir:=Root+BrowseDir;
2: InitialDir:=InitDir;
end;
if Execute then
case RadioGroupSource.ItemIndex
of
0:
EditFile.Text:=ExtractFileName(FileName);
1:
EditFile.Text:=ExtractFileName(FileName);
2: EditFile.Text:=FileName;
end;
end;
OpenDialogFile.Free;
end;
if RadioGroupSource.ItemIndex =
1 then
begin
DeleteFiles(EditForm.Handle,Root+BrowseDir+'*.*');
DeleteFiles(EditForm.Handle,Root+TmpDir+ExtractFileName(EditArc.Text));
end;
end;
procedure
TEditForm.RadioGroupSourceClick(Sender: TObject);
begin
LabelDir.Enabled:=RadioGroupSource.ItemIndex
= 0;
EditDir.Enabled:=RadioGroupSource.ItemIndex
= 0;
BBrowseDir.Enabled:=RadioGroupSource.ItemIndex
= 0;
LabelArc.Enabled:=RadioGroupSource.ItemIndex
= 1;
EditArc.Enabled:=RadioGroupSource.ItemIndex
= 1;
BBrowseArc.Enabled:=RadioGroupSource.ItemIndex
= 1;
end;
procedure
TEditForm.BBrowseDirClick(Sender: TObject);
begin
if not Assigned (DirSourceForm)
then
DirSourceForm:=
TDirSourceForm.Create (Application);
DirSourceForm.ShowModal;
if DirSourceForm.ModalResult =
mrOK then
EditDir.Text:=DirSourceForm.ShellComboBox1.Path;
end;
end.
Приложение Е
Листинг модуля Delete.pas
unit Delete;
interface
uses Windows, SysUtils,
Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;
type
TDeleteForm = class(TForm)
Bevel1: TBevel;
Label1: TLabel;
BYes: TBitBtn;
BNo: TBitBtn;
Image1: TImage;
private
{ Private declarations }
public
{ Public declarations }
end;
var
DeleteForm: TDeleteForm;
implementation
{$R *.dfm}
end.
Приложение Ж
Листинг модуля Filter.pas
unit Filter;
interface
uses
Windows, Messages, SysUtils,
Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons,
ExtCtrls;
type
TFilterForm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
GBFilterValue: TGroupBox;
EditAut: TEdit;
EditTit: TEdit;
EditLan: TEdit;
LabelAut: TLabel;
LabelTit: TLabel;
LabelLan: TLabel;
BBOK: TBitBtn;
BBCancel: TBitBtn;
LabelSec: TLabel;
EditSec: TEdit;
CBCase: TCheckBox;
procedure
FormDeactivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FilterForm: TFilterForm;
implementation
uses DB, DBUnit;
{$R *.dfm}
procedure
TFilterForm.FormDeactivate(Sender: TObject);
begin
if ModalResult=mrOK then
DataModule1.SetFilter(CBCase.Checked,
EditAut.Text,
EditTit.Text,
EditLan.Text,
EditSec.Text);
end;
end.
Приложение З
Листинг модуля Find.pas
unit Find;
interface
uses
Windows, Messages, SysUtils,
Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls,
Buttons, DB;
type
TFindForm = class(TForm)
Panel1: TPanel;
BOK: TBitBtn;
Panel2: TPanel;
gbValue: TGroupBox;
LabelAut: TLabel;
LabelTit: TLabel;
LabelLan: TLabel;
LabelSec: TLabel;
EditAut: TEdit;
EditTit: TEdit;
EditLan: TEdit;
EditSec: TEdit;
BCancel: TBitBtn;
EditNum: TEdit;
LabelNum: TLabel;
gbParam: TGroupBox;
CheckBoxCase: TCheckBox;
CheckBoxSubStr: TCheckBox;
procedure
FormDeactivate(Sender: TObject);
procedure
SetFieldParams(FldNum: Byte;
var Fields: ShortString; var
Values: Variant);
procedure GetLocateParams(var
KeyFields: ShortString;
var KeyValues: Variant; var
Options: TLocateOptions);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FindForm: TFindForm;
implementation
uses DBUnit, Data;
{$R *.dfm}
procedure
TFindForm.FormDeactivate(Sender: TObject);
const
Txt='Источник не найден';
WinName='Поиск источника';
var
KeyFlds : ShortString;
KeyVals : Variant;
Loc : TLocateOptions;
Res : Boolean;
BM : TBookmark;
begin
if ModalResult=mrOK then
begin
BM:=DataModule1.IBDataSet1.GetBookmark;
GetLocateParams(KeyFlds,KeyVals,Loc);
Res:=DataModule1.IBDataSet1.Locate(KeyFlds,KeyVals,Loc);
with DataModule1 do
fSearchRec:=IBDataSet1.RecNo;
if not Res then
begin
DataModule1.IBDataSet1.GotoBookmark(BM);
DataModule1.fSearchRec:=-1;
Application.MessageBox(Txt,WinName,mb_OK);
end;
DataModule1.IBDataSet1.FreeBookmark(BM);
end;
end;
procedure
TFindForm.GetLocateParams(var KeyFields: ShortString;
var KeyValues: Variant; var
Options: TLocateOptions);
begin
KeyFields:='';
KeyValues:=VarArrayOf([]);
SetFieldParams(0,KeyFields,KeyValues);
SetFieldParams(1,KeyFields,KeyValues);
SetFieldParams(2,KeyFields,KeyValues);
SetFieldParams(3,KeyFields,KeyValues);
SetFieldParams(4,KeyFields,KeyValues);
Options:=[];
if CheckBoxCase.Checked then
Options:=Options+[loCaseInsensitive];
if CheckBoxSubStr.Checked then
Options:=Options+[loPartialKey];
end;
procedure
TFindForm.SetFieldParams(FldNum: Byte;
var Fields: ShortString; var
Values: Variant);
var
S: ShortString;
N: Integer;
begin
case FldNum of
0: S:=EditNum.Text;
1: S:=EditAut.Text;
2: S:=EditTit.Text;
3: S:=EditLan.Text;
4: S:=EditSec.Text;
end;
S:=Trim(S);
if S<>'' then
begin
Fields:=Concat(Fields,FieldNames[FldNum],';');
N:=VarArrayHighBound(Values,1)+1;
VarArrayRedim(Values,N);
if (FldNum = 0) then
Values[N]:=StrToInt(S)
else
Values[N]:=S;
end;
end;
end.
Приложение И
Листинг модуля DirSource.pas
unit DirSource;
interface
uses Windows, SysUtils,
Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, ComCtrls,
ShellCtrls;
type
TDirSourceForm = class(TForm)
Bevel1: TBevel;
BCancel: TBitBtn;
BOK: TBitBtn;
ShellComboBox1: TShellComboBox;
ShellTreeView1: TShellTreeView;
private
{ Private declarations }
public
{ Public declarations }
end;
var
DirSourceForm: TDirSourceForm;
implementation
{$R *.dfm}
end.
Приложение К
Листинг модуля Path.pas
unit Path;
interface
uses
Windows, Messages, SysUtils,
Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,
Buttons;
type
TPathForm = class(TForm)
Panel1: TPanel;
BBOK: TBitBtn;
BBCancel: TBitBtn;
Panel2: TPanel;
leServer: TLabeledEdit;
leFile: TLabeledEdit;
procedure FormActivate(Sender:
TObject);
procedure
FormDeactivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
PathForm: TPathForm;
implementation
uses Data, DBUnit;
{$R *.dfm}
procedure
TPathForm.FormActivate(Sender: TObject);
begin
leServer.Text:=DataModule1.fServer;
leFile.Text:=DataModule1.fFile;
end;
procedure
TPathForm.FormDeactivate(Sender: TObject);
var
Path : AnsiString;
User : ShortString;
Pass : ShortString;
begin
if ModalResult=mrOK then
begin
Path:=Concat(leServer.Text,':',lefile.Text);
User:=DataModule1.fUser;
Pass:=DataModule1.fPass;
if not
DataModule1.Connect(Path,User,Pass) then Close;
end;
end;
end.
Приложение Л
Листинг модуля User.pas
unit User;
interface
uses
Windows, Messages, SysUtils,
Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,
Buttons;
type
TUserForm = class(TForm)
Panel1: TPanel;
BBOK: TBitBtn;
BBCancel: TBitBtn;
Panel2: TPanel;
leUser: TLabeledEdit;
lePass: TLabeledEdit;
private
{ Private declarations }
public
{ Public declarations }
end;
var
UserForm: TUserForm;
implementation
{$R *.dfm}
end.
Приложение М
Листинг модуля About.pas
unit About;
interface
uses Windows, SysUtils,
Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, jpeg;
type
TAboutBox = class(TForm)
Panel1: TPanel;
ProgramIcon: TImage;
ProductName: TLabel;
Version: TLabel;
Copyright: TLabel;
Comments: TLabel;
BitBtnOK: TBitBtn;
Date: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
AboutBox: TAboutBox;
implementation
{$R *.dfm}
end.
Приложение Н
Листинг модуля Data.pas
unit Data;
{$WRITEABLECONST ON}
interface
uses Graphics;
const
DBDefaultServer: ShortString
='Server-1';
DBDefaultFile: ANSIString
='G:\LibDB\Lib.gdb';
LibDir='\\Server-1\_Literature\__\';
InitDir='\\Server-1\_Literature\';
DBDefaultUser: ShortString
='GUEST';
DBDefaultPass: ShortString
='please';
IniFile='Lib.ini';
TmpDir='Tmp\';
BrowseDir=TmpDir+'Browse\';
TmpFile='Tmp';
ArcExt='.rar';
PathLen =1000;
InsertWinName=Добавление нового источника';
EditWinName='Редактирование источника ';
DeleteWinName='Удаление источника ';
FieldNames: array [0..4] of
ShortString=(
'Number', 'Author', 'Title',
'Language', 'Sections');
SQLSortBy : array [0..4] of
ShortString=(
'ORDER BY "Number" ',
'ORDER BY "Author" ',
'ORDER BY "Title" ',
'ORDER BY "Language"
',
'');
SQLSortDir: array [0..1] of
ShortString=(
'',
'DESC');
DefaultWinState = 2;
DefaultWinTop = 0;
DefaultWinBottom = 0;
DefaultWinLeft = 400;
DefaultWinRight = 600;
DefaultMemoTop = 0;
DefaultMemoBottom = 0;
DefaultMemoLeft = 400;
DefaultMemoRight = 600;
DefaultGrid0= 36;
DefaultGrid1= 117;
DefaultGrid2= 279;
DefaultGrid3= 52;
DefaultGrid4= 150;
DefaultGrid5= 122;
DefaultColor= clWindow;
DefaultFontCharset= 1 ;
DefaultFontColor=clWindowText;
DefaultFontHeight=-11;
DefaultFontName='MS Sans
Serif';
DefaultFontPitch=Ord(fpDefault);
DefaultFontSize=8;
DefaultFontBold=False;
DefaultFontItalic=False;
DefaultFontUnderLine=False;
DefaultFontStrikeOut=False;
ConfirmDelete: Boolean = True;
var
Root : ANSIString;
implementation
end.
Приложение О
Листинг модуля Files.pas
unit Files;
interface
uses Windows, SysUtils,
Dialogs, IniFiles;
function CopyFiles(Handle:HWND;
Source, Dest: ANSIString): Longint;
procedure DeleteFileExt(var
Name:ANSIString);
function
DeleteFiles(Handle:HWND; Source: ANSIString): Longint;
function
ExtractFileLastDir(Name: ANSIString): ANSIString;
function GetNewArcName(Path:
ShortString): ShortString;
procedure OpenFile(FileName:
TFileName; Dir:ANSIString);
function PackFiles(ArcName,
Path: ANSIString): Boolean;
function RunApp(Title, Name,
CmdLn: ANSIString): DWORD;
function UnPackFiles(ArcName,
Dir: ANSIString): Boolean;
implementation
uses ShellAPI, Forms, Classes,
Data;
const
NError=3;
ErrorMsg: array[1..NError] of
ShortString=(
'Упаковка файлов прервана',
'Распаковка временных файлов прервана',
'Файл неоткрывается');
RARName ='Rar.exe';
WinRARName='WinRar';
PackKey='a -ep1';
UnPackKey='x';
RARTitle='Óïàêîâêà
ôàéëîâ';
Bl =' ';
function CopyFiles(Handle:HWND;
Source, Dest: ANSIString): Longint;
var
F : TSHFileOpStruct;
Buffer1: array[0..4096] of
Char;
Buffer2: array[0..4096] of
Char;
S : PChar;
D : PChar;
begin
FillChar(Buffer1,
SizeOf(Buffer1), #0);
FillChar(Buffer2,
SizeOf(Buffer2), #0);
S := @Buffer1;
D := @Buffer2;
StrPCopy(S, Source);
StrPCopy(D, Dest);
FillChar(F, SizeOf(F), #0);
F.Wnd := Handle;
F.wFunc := FO_COPY;
F.pFrom := @Buffer1;
F.pTo := @Buffer2;
F.fFlags := 0;
Result:=SHFileOperation(F);
end;
procedure DeleteFileExt(var
Name:ANSIString);
var
Ext : ShortString;
LenExt : Integer;
LenName: Integer;
begin
Ext:=ExtractFileExt(Name);
LenExt:=Length(Ext);
LenName:=Length(Name);
Delete(Name,LenName-LenExt+1,LenName);
end;
function
DeleteFiles(Handle:HWND; Source: ANSIString): Longint;
var
F : TSHFileOpStruct;
Buffer: array[0..4096] of Char;
S : PChar;
begin
FillChar(Buffer,
SizeOf(Buffer), #0);
S := @Buffer;
StrPCopy(S, Source);
FillChar(F, SizeOf(F), #0);
F.Wnd := Handle;
F.wFunc := FO_DELETE;
F.pFrom := @Buffer;
F.fFlags := FOF_NOCONFIRMATION;
Result:=SHFileOperation(F);
end;
function
ExtractFileLastDir(Name: ANSIString): ANSIString;
var
I: Integer;
L: Integer;
begin
L:=Length(Name);
I:=L+1;
repeat
Dec(I);
until Name[I]='\';
Result:=Copy(Name,I,L-I);
end;
function GetNewArcName(Path:
ShortString): ShortString;
var
ExtLen : Integer;
NameLen: Integer;
I : Integer;
Ext : ShortString;
Dir : ShortString;
Name : ShortString;
begin
Dir:=ExtractFilePath(Path);
Name:=ExtractFileName(Path);
if Trim(Name)='' then
Name:='Arc';
if FileExists(Dir+Name) then
begin
Ext:=ExtractFileExt(Name);
ExtLen:=Length(Ext);
NameLen:=Length(Name);
Insert('1',Name,NameLen-ExtLen+1);
I:=2;
while FileExists(Dir+Name) do
begin
Delete(Name,NameLen-ExtLen+1,Length(Name));
Name:=Concat(Name,IntToStr(I),Ext);
Inc(I);
end;
end;
Ext:=ExtractFileExt(Name);
if Ext='' then
Name:=Concat(Name,ArcExt);
Result:=Concat(Dir,Name);
end;
procedure OpenFile(FileName:
TFileName; Dir:ANSIString);
var
PPath : PChar;
POpenDir: PChar;
Res : DWORD;
begin
FileName:=Concat(FileName);
GetMem(PPath,PathLen);
GetMem(POpenDir,Length(Dir)+1);
StrPCopy(POpenDir,Dir);
FindExecutable(PChar(FileName),PChar(Dir),PPath);
Res:=ShellExecute(Application.Handle,'open',PPath,PChar(FileName),
POpenDir,SW_SHOWNORMAL);
if Res<32 then
ShowMessage(ErrorMsg[3]);
FreeMem(POpenDir);
FreeMem(PPath);
end;
function PackFiles(ArcName,
Path: ANSIString): Boolean;
var
Param : ShortString;
Res : DWORD;
PPath : PChar;
F : TFileStream;
FName : TFileName;
begin
FName:=Concat(Root,TmpDir,TmpFile,'1',ArcExt);
F:=TFileStream.Create(FName,fmCreate);
GetMem(PPath, PathLen);
if
FindExecutable(PChar(FName),PChar(0),PPath)>32 then
begin
Param:=Concat(WinRARName,Bl,PackKey,Bl,ArcName,Bl,Path);
Res:=RunApp('',PPath,Param);
end
else
begin
Res:=0;
end;
if (Res<>0) then
begin
DeleteFiles(Application.Handle,ArcName);
ShowMessage(ErrorMsg[1]);
Result:=False;
end
else
Result:=True;
FreeMem(PPath);
F.Free;
DeleteFiles(Application.Handle,FName);
end;
function RunApp(Title, Name,
CmdLn: ANSIString):DWORD;
var
Startup: TStartupInfo;
Process: TProcessInformation;
Status : DWORD;
Env : Pointer;
begin
ChDir(Root);
New(Env);
Startup.lpReserved := PChar(0);
Startup.lpDesktop := PChar(0);
Startup.lpTitle :=
PChar(Title);
Startup.dwFlags :=
STARTF_USESHOWWINDOW;
Startup.wShowWindow :=
SW_SHOWNORMAL;
Startup.cbReserved2 := 0;
Startup.lpReserved2 :=
PByte(0);
if CreateProcess(
PChar(Name), //
lpApplicationName
PChar(CmdLn), // lpCommandLine
PSecurityAttributes(0), //
lpProcessAttributes
PSecurityAttributes(0), //
lpThreadAttributes
False, // bInheritHandles
NORMAL_PRIORITY_CLASS, //
dwCreationFlags
Env, // lpEnvironment
PChar(0), // lpCurrentDirectory
Startup, // lpStartupInfo
Process // lpProcessInformation
)then
begin
GetExitCodeProcess(Process.hProcess,
Status);
while Status = STILL_ACTIVE do
begin
Sleep(10);
GetExitCodeProcess(Process.hProcess,
Status);
end;
end;
Dispose(Env);
Result:=Status;
end;
function UnPackFiles(ArcName,
Dir: ANSIString): Boolean;
var
PPath : PChar;
Param : ShortString;
Res : DWORD;
begin
ArcName:=Concat('"',ArcName,'"');
GetMem(PPath, PathLen);
if
FindExecutable(PChar(ArcName),PChar(0),PPath)>32 then
begin
Param:=Concat(WinRARName,Bl,UnPackKey,Bl,ArcName,Bl,Dir);
Res:=RunApp('',PPath,Param);
end
else
begin
Res:=0;
end;
FreeMem(PPath);
if Res<>0 then
begin
DeleteFiles(Application.Handle,Dir+'*.*');
ShowMessage(ErrorMsg[2]);
Result:=False;
end
else
Result:=True;
end;
end.
|