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
0:
begin
if EditDir.Text<>'' then
begin
ArcName:=Concat(Root+TmpDir+TmpFile);
Res:=PackFiles(ArcName,EditDir.Text+'\*.*');
ArcName:=ArcName+'.rar';
end;
end;
1:
begin
if EditArc.Text<>'' then
begin
ArcName:=EditArc.Text;
Res:=True;
end;
end;
2:
begin
Str:=DataModule1.IBDataSet1.FieldByName('File').AsString;
if EditFile.Text<>Str then
begin
ArcName:=Root+TmpDir+TmpFile+'.rar';
Res:=PackFiles(ArcName,EditFile.Text);
end;
end;
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;
end;
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;
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;
end;
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;
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;
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;
end;
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;
end;
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;
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;
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;
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;
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;
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;