Смекни!
smekni.com
Информатика и программирование

Разработка базы данных (стр. 19 из 20)

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:&bsol;LibDB&bsol;Lib.gdb';

LibDir='&bsol;Server-1&bsol;_Literature&bsol;__&bsol;';

InitDir='&bsol;Server-1&bsol;_Literature&bsol;';

DBDefaultUser: ShortString ='GUEST';

DBDefaultPass: ShortString ='please';

IniFile='Lib.ini';

TmpDir='Tmp&bsol;';

BrowseDir=TmpDir+'Browse&bsol;';

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]='&bsol;';

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);

 
назад
читать дальше
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
НАПИШИТЕ НАМ
Copyright © Smekni.com. All rigths reserved.