Учебная работа. Курсовая работа: Базы данных. Создание программы Телефонный справочник

1 Звезда2 Звезды3 Звезды4 Звезды5 Звезд (Пока оценок нет)
Загрузка...
Контрольные рефераты

Учебная работа. Курсовая работа: Базы данных. Создание программы Телефонный справочник

СОВРЕМЕННЫЙ ГУМАНИТАРНЫЙ ИНСТИТУТ

Филиал ______________________________________________________________

Курсовая работа

По дисциплине Программирование
на языке высочайшего уровня________________

Тема__Базы данных. Создание программки телефонный справочник

Выполнил студент Трифонов Александр Владимирович

№ договора 09208060601010

№ группы ______________

Подпись студента ________ Дата сдачи работы «____»________200_г

Курсовая работа к аттестации допущена

Управляющий ____________________________________ ______

«__»______200_г

Работа принята ______________________________________ _______

«___»______200_г

Оглавление

Введение……………………………………………………….3

Предназначение и область внедрения…………….5

Постановка задачки и разработка

Метода решения задачки…………………….6

Заключение……………………………………………………15

Перечень использованной литературы………………………..16

Введение

В данной курсовой речь пойдет о языке программирования Delphi и о базах данных.

процесс разработки в Delphi максимально упрощен. Сначала это относится к созданию интерфейса, на который уходит 80% времени разработки программки. Вы просто помещаете нужные составляющие на поверхность Windows-окна (в Delphi оно именуется формой) и настраиваете их характеристики при помощи специального инструмента (Object Inspector). С его помощью можно связать действия этих компонент (нажатие на клавишу, выбор мышью элемента в перечне и т.д.) с кодом его обработки — и вот обычное приложение готово. Вы сможете создавать составляющие activeX без использования Microsoft IDL, расширять способности web-сервера (скрипты на стороне сервера), фактически ничего не зная о HTML, XML либо ASP. Можно создавать распределенные приложения на базе СОМ и CORBA, веб— и intranet-приложения, используя для доступа к данным Borland DataBase Engine, ODBC-драйверы либо Microsoft ADO. Показавшаяся, начиная с Delphi 3, поддержка многозвенной технологии (multi-tiered) доступа к данным дозволяет создавать масштабируемые приложения (относительно слабо зависящие от сервера БД) за счет перенесения способов обработки инфы (бизнес-правил) на среднее звено.

Как уже говорилось ранее, в Delphi употребляется язык Object Pascal, который повсевременно расширяется и дополняется Borland. язык полностью поддерживает все требования, предъявляемые к объектно-ориентированному языку программирования. Как и положено строго типизированному языку, классы поддерживают лишь обычное наследование, но зато интерфейсы могут иметь сходу несколько протцов. К числу особенностей языка следует отнести поддержку обработки исключительных ситуаций (exceptions), также перегрузку способов и подпрограмм (overload) в стиле C++. К числу успешных, на взор создателя, относится также поддержка длинноватых строк в формате WideChar и AnsiChar. Крайний тип (AnsiStrmg) дозволяет применять все красоты динамического размещения инфы в памяти без всяких хлопот о ее выделении и сборке мусора Delphi делает это автоматом. Для поклонников вольного стиля программирования имеются открытые массивы, варианты и вариантные массивы, дозволяющие располагать в памяти все, что душе угодно и соединять типы данных.

Вы сможете создавать свои собственные составляющие, импортировать ОСХ-компоненты, создавать <шаблоны> проектов и <мастеров>, создающих <заготовки> проектов. Не много того, Delphi предоставляет разрабу интерфейс для связи ваших приложений (либо наружных программ) с встроенной оболочкой Delphi (IDE).

Таковым образом, вы сможете применять Delphi для сотворения как самых обычных приложений, на разработку которых требуется 2-3 часа, так и суровых корпоративных проектов, созданных для работы 10-ов и сотен юзеров. При этом для этого можно применять самые крайние веяния в мире компьютерных технологий с минимальными затратами времени и сил.

Предназначение и область внедрения

Программка телефонный справочник создана для хранения телефонных номеров на компе. В ней находятся такие элементы как поиск по номеру, имени, улице, а так же сортировка.

Постановка задачки и разработка метода

решения задачки

нужно сделать приложение дозволяющие сделать базу данных, созодать сортировку базы данных, создавать новейшие записи либо удаление полей базы данных.

приложение телефонный справочник

Чтоб базу данных можно было переносить с компа на иной комп программка обязана сама создавать алиасы. Потому что dBase сохраняет базу данных в виде файла с заглавием базы dBase.DBF. Комфортно не попросту указывать путь доступа к таблицам базы данных, а применять для этого некоторый заменитель — псевдоним, именуемый алиасом. Некие СУБД сохраняют базу данных в виде нескольких отдельных файлов, представляющих из себя таблицы (в главном, все локальные СУБД), в то время как остальные состоят из 1-го файла, который содержит внутри себя все таблицы и индексы (InterBase). к примеру, таблицы dBase и Paradox постоянно сохраняются в отдельных файлах на диске. каталог, содержащий dBase .DBF файлы либо Paradox .DB файлы, рассматривается как база данных. Иными словами, хоть какой каталог, содержащий файлы в формате Paradox либо dBase, рассматривается Delphi как единая база данных. Для переключения на другую базу данных необходимо просто переключиться на иной каталог. Как уже было обозначено выше, InterBase сохраняет все таблицы в одном файле, имеющем расширение .GDB, потому этот файл и есть база данных InterBase.

Алиас сохраняется в отдельном конфигурационном файле в случайном месте на диске и дозволяет исключить из программки прямое указание пути доступа к базе данных. Таковой подход дает возможность располагать данные в любом месте, не перекомпилируя при всем этом программку. Не считая пути доступа, в алиасе указываются тип базы данных, языковый драйвер и много иной управляющей инфы. Потому внедрение алиасов дозволяет просто перебегать от локальных баз данных к SQL-серверным базам (естественно, при выполнении требований разделения приложения на клиентскую и серверную части).

Для сотворения алиаса запустите утилиту конфигурации BDE находящуюся в каталоге, в каком размещаются динамические библиотеки BDE.

Рис.
1: основное окно утилиты конфигурации BDE





Основное окно утилиты опции BDE имеет вид, изображенный на рис.1.

Рис. 2: В диалоговом окне прибавления новейшего алиаса можно указать тип базы данных

Изберите в меню “Object” пункт “New”. В показавшемся диалоговом окне изберите имя драйвера базы данных. Тип алиаса быть может обычным (STANDARD) для работы с локальными базами в формате dBase либо Paradox либо соответствовать наименованию SQL-сервера (InterBase, Sybase, Informix, Oracle и т.д.).

Опосля сотворения новейшего алиаса следует отдать ему имя. Это можно создать при помощи подпункта “Rename” меню “Object”. Но просто сделать алиас не довольно. Для вас необходимо указать доп информацию, содержание которой зависит от типа избранной базы данных. к примеру, для баз данных Paradox и dBase (STANDARD) требуется указать только путь доступа к данным, имя драйвера и флаг ENABLE BCD, который описывает, передает ли BDE числа в двоично-десятичном формате (значения двоично-десятичного кода избавляют ошибки округления):


TYPE
STANDARD

DEFAULT DRIVER
PARADOX

ENABLE BCD
FALSE

Path
c:usersdata

SQL-сервер InterBase и остальные типы баз данных требуют задания огромного количества характеристик, почти все из которых можно бросить установленными по дефлоту.

Ниже приведен листинг программки которая производит индексацию и проверку базы данных, также изображение работы программки (PROGRESS.PAS):

Рис.1 Индексация базы данных.

unitProgress;

interface

uses

Windows, SysUtils, Classes, Forms, Dialogs, StdCtrls,

DB, DBTables, Controls, ComCtrls, Registry,ShellApi, Messages, Graphics,

ExtCtrls ;

const

MM_BASE = WM_User;

MM_OKSTART = MM_BASE + $1;

MM_DATAERROR = MM_BASE + $2;

MM_KeyDown = MM_BASE + $3;

MM_ENDTHREAD = MM_BASE + $4;

type

TMainForm = class(TForm)

ProgressBar1: TProgressBar;

lbPersent: TLabel;

Table2: TTable;

Image1: TImage;

Table1: TTable;

Timer1: TTimer;

lbMessage: TLabel;

procedure FormCreate(Sender: TObject);

procedure ProgressAOM (var MSG: tagMSG; var Handled: boolean);

procedure DataError(var Message: TMessage); message MM_DATAERROR;

procedure Timer1Timer(Sender: TObject);

procedure EndThread(var Message:TMessage); message MM_ENDTHREAD;

private

IsCanStart: boolean;

FStartTime: cardinal;

function SearchFile(FileName: string): boolean;

public

{ Public declarations }

end;

type EPhoneException = class (Exception);

var

MainForm: TMainForm;

tick: cardinal;

IsFirst : boolean = true;

const

sDataFile = ‘Data.dbf’;

sIndexFile = ‘Data.mdx’;

sBuffFile = ‘DataBuff.dbf’;

sBuffFile2 = ‘DataBuff2.dbf’;

sShortappname = ‘LutskPhone’;

sIniFile = ‘options.ini’;

sDataFileError = ‘Ошибкаприработесбазойданных ‘+#10#13+’Проверьтеналичиифайлабазы!’;

sBDEError = ‘Ошибка работы с BDE!’;

implementation

uses Teldov, Thread, ActiveX, ComObj, ShlObj;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);

var

mess: tagmsg;

handled :boolean;

begin

try

IsCanStart := false;

Top := (Screen.Height — Height) div 2-200;

Left := (Screen.Width — Width) div 2;

Application.OnMessage := ProgressAOM ;

// созданиеярлыка, записьвреестр

try

Table1.TableName := sBuffFile;// Check BDE

Table1.CreateTable;

Table1.Close;

// ShowMessage(DBIgetErrorString);

DeleteFile(ExtractFilePath(ParamStr(0))+’/’+sBuffFile);

except

raise EPhoneException.Create(sBDEError); // error BDE

end;

if not SearchFile(sDataFile)

then raise EPhoneException.Create(sDataFileError);

if not SearchFile(sIndexFile)

then DataThread.create(false)

else IsCanStart := true;

except

on E: Exception do

begin

MessageDlg(e.Message, mtError, [mbOk],0);

PostMessage(MainFOrm.Handle, MM_DATAERROR, 0, 0);

end;

end;

Invalidate;

end;

procedure TMainForm.ProgressAOM (var MSG: tagMSG; var Handled: boolean);

begin

if MSG.Message = MM_OKSTART then

begin

Timer1.Enabled := false;

Application.CreateForm(TPhoneForm, PhoneForm);

MainFOrm.Hide;

PhoneForm.Show;

Application.OnMessage := PhoneForm.AOM;

end;

end;

function TMainForm.SearchFile(FileName: string): boolean;

var

CurrFile : TSearchRec;

begin

if FindFirst(GetCurrentDir +»+FileName, faAnyFile, CurrFIle)=0

then Result := true

else Result := false;

end;

procedure TMainForm.DataError(var Message: TMessage);

begin

Close;

end;

procedure TMainForm.Timer1Timer(Sender: TObject);

begin

if IsFirst then

begin

IsFirst := false;

FStartTime := 0; // GetTickCount;

end;

if IsCanStart then

begin

Tick := GetTickCount;

if Tick > (FStartTime + 0) // 1000

then PostMessage(MainFOrm.Handle, MM_OKSTART, 1, 0);

end

end;

procedure TMainForm.EndThread(var Message: TMessage);

begin

Image1.Visible := true;

Caption := »;

lbPersent.Visible := false;

lbMessage.Visible := false;

ProgressBar1.Visible := false;

IsCanStart := true;

end;

end.

Опосля индексации базы данных и проверки её на существование запускается программка для работы с базой данных.

Рис.2 основное окно программки.

На рисунке 3 показан итог поиска в базе данных по номеру телефона.

Рис. 3 Поиск в базе данных по номеру телефона.

база данных состоит из 6 полей : номер телефона, ФИО, улица, номер дома, номер квартиры, категория.Что соответствует полям в базе данных: номер телефона – NUMTEL, ФИО — FAMIL, улица — STREET, номер дома — HOUSE, номер квартиры — KVART, категория – PR09.

Заключение

В итоге выполнения курсовой работы мною было сотворено приложение для работы с базой данных (dBase) создание алиасов к базе данных.

Перечень использованной литературы

1. А. Я. Архангельский Программирование в Delphi 7.2003г.

2. Никита Культин. Базы программирования в Delphi 7. Самоучитель.2002г.

3. Delphi 7. Учебный курс. Бобровский С.

5.Бобровский С.И.
5 – М.: Питер, 2002

6. Delphi 5.0, учебный курс, Фараонов В.В., ISBN 5-8952-020-4, 400 с

7.
Фаронов В. В. DELPHI 6: Учебный курс (+ дискета) – СПб: Питер, 2002.

8. Фаронов В.В. Программирование баз данных в Deiphi 7. Учебный курс.

приложение

листинг программки (TElDov.pas)

unit TElDov;

interface

uses

Windows, SysUtils, Thread, Progress, ExtCtrls, ComCtrls, Menus,

ToolWin, DBCtrls, ImgList, Classes, Controls, StdCtrls, Grids,

DB, DBTables, DBGrids, Forms, Messages, Dialogs,Clipbrd;

type

TPhoneForm = class(TForm)

DataSource1: TDataSource;

Table1: TTable;

StatusBar1: TStatusBar;

GroupBox1: TGroupBox;

Search: TButton;

Toolbar1: TToolBar;

ExitButton: TToolButton;

SearchButton: TToolButton;

HelpButton: TToolButton;

DBGrid1: TDBGrid;

ImageList1: TImageList;

SortButton: TToolButton;

PopupMenu1: TPopupMenu;

ImageList2: TImageList;

ToolButton2: TToolButton;

ToolButton3: TToolButton;

ToolButton4: TToolButton;

ToolButton5: TToolButton;

ToolButton6: TToolButton;

ToolButton7: TToolButton;

ToolButton8: TToolButton;

PopupMenu2: TPopupMenu;

DBNavigator1: TDBNavigator;

procedure FormCreate(Sender: TObject);

procedure SearchClick(Sender: TObject);

procedure AOM(var Msg: tagMSG; var Handled: Boolean);

procedure MyPopupHandler(Sender: TObject);

procedure MyPopupHandler2(Sender: TObject);

procedure MyEditPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure MInMaxSize(var Message: TMessage); message WM_GETMINMAXINFO;

procedure N20Click(Sender: TObject);

procedure N13Click(Sender: TObject);

procedure N14Click(Sender: TObject);

procedure N15Click(Sender: TObject);

procedure N16Click(Sender: TObject);

procedure ExitButtonClick(Sender: TObject);

procedure SearchButtonClick(Sender: TObject);

procedure HelpButtonClick(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

procedure CreatePopupFields;

procedure UpdateStatusBar;

procedure CalculateEditSize;

procedure SortMode (Sender: tObject);

procedure ReadIni;

procedure WriteIni; // Ini-file

public

end;

var

PhoneForm: TPhoneForm;

Inputs : array [0..4] of TEdit;

MyThread: DataThread;

bool: boolean;

ColumnIndex: integer;

const

SortName : array[0..2] of string =(‘поТелефону’,’поИмени’,’поУлице’);

IndexName : array [0..2] of string =(‘ByNumTel’,’ByFamil’,’ByStreet’);

COPY_TO_CLIPBOARD = ‘Копировать’;

PASTE_FROM_CLIPBOARD = ‘Вставить’;

function IndexOfItem(Item: string): integer;

implementation

uses IniFiles, DBITypes, DBIProcs, Graphics,ShellApi;

{$R *.dfm}

procedure TPhoneForm.FormCreate(Sender: TObject);

begin

Table1.TableName := sDataFile;

Table1.Open;

CreatePopupFields;

CalculateEditSize;

UpDateStatusBar;

ReadIni;

Application.onMessage := Aom;

Application.HelpFile := sHelpFile;

end;

procedure TPhoneForm.MyPopupHandler(Sender: TObject);

begin

if Sender is TMenuItem then with (Sender as TMenuItem) do

begin

case tag of

0..2: begin Table1.IndexName := IndexName[(Sender as TMenuItem).tag ];

SortMode(Sender);

end;

4: Clipboard.AsText := DBGrid1.SelectedField.DisplayText;

end;

UpdateStatusBar;

end;

end;

procedure TPhoneForm.CreatePopupFields;

var

i: integer;

MyPopupMenuItem : array [0..4] of TMenuItem;

MenuItem: TMenuItem;

begin

for i := 0 to 4 do

begin

Inputs[i] := TEdit.Create(self);

Inputs[i].Parent := GroupBox1;

Inputs[i].PopupMenu := PopupMenu2;

Inputs[i].OnContextPopup := MyEditPopup;

Inputs[i].Tag := i;

end;

for i := 0 to 4 do with PopupMenu1 do

begin

MyPopupMenuItem[i] := TMenuItem.Create(self);

if i<3 then MyPopupMenuItem[i].Caption := SortName[i];

MyPopupMenuItem[i].Tag := i;

MyPopupMenuItem[i].OnClick := MyPopupHandler;

PopupMenu1.Items.add(MyPopupMenuItem[i]);

end;

MyPopupMenuItem[3].Caption := ‘-‘;

MyPopupMenuItem[4].Caption := COPY_TO_CLIPBOARD;

MyPopupMenuItem[4].ShortCut := ShortCut(Word(‘C’), [ssCtrl]);

PopupMenu1.Items[0].Checked := true;

MenuItem := TMenuItem.Create(self);

MenuItem.Caption := PASTE_FROM_CLIPBOARD;

MenuItem.OnClick := MyPopupHandler2;

PopupMenu2.Items.add(MenuItem);

MyEditPopup(nil,

end;

procedure TPhoneForm.CalculateEditSize;

var

i: integer;

OffSet: integer;

begin

offset :=13;

for i := 0 to 4 do

begin

Inputs[i].Left := Offset;

Offset := Offset + DbGrid1.Columns[i].width + 8;

Inputs[i].Width := DBGrid1.Columns[i].width;

Inputs[i].Top := 24;

Inputs[i].MaxLength :=Table1.Fields[i].Size;

end;

end;

procedure TPhoneForm.UpdateStatusBar;

var SortMode: string;

begin

statusBar1.Panels[0].Text := ‘ Найденоабонентов: ‘+ InttoStr(Table1.RecordCount);

Sortmode := SortName[0];

if PopupMenu1.Items[1].Checked then sortMode := SortName[1];

if PopupMenu1.Items[2].Checked then sortMode := SortName[2];

statusbar1.Panels[1].Text := ‘ Отсортировано: ‘+SortMode;

end;

procedure tPhoneForm.AOM(var Msg: tagMSG; var Handled: Boolean);

var key : Word;

begin

handled := false;

if msg.message = Wm_keydown then

begin

key := msg.wParam;

handled := true;

case key of

vk_up: SendMessage(DBGrid1.Handle,wm_keydown, vk_up, 0);

vk_Down: SendMessage(DBGrid1.Handle,wm_keydown, vk_down, 0);

vk_Prior: SendMessage(DBGrid1.Handle,wm_keydown, vk_Prior, 0);

vk_Next: SendMessage(DBGrid1.Handle,wm_keydown, vk_Next, 0);

vk_return: Search.OnClick(Search);

vk_f1: Application.HelpCommand(HELP_CONTENTS, 0);

else handled := false;

end;

end;

end;

procedure TPhoneForm.SearchClick(Sender: TObject);

var

filters: string;

i: integer;

begin

filters := »;

for i:= 0 to 4 do

begin

if Inputs[i].Text <> »

then filters := filters + ‘(‘+Table1.Fields[i].FieldNameactiveXQuotedStr(Inputs[i].Text + ‘*’)+ ‘) and’;

end;

if filters <> » then

Filters := copy(Filters, 0, Length(filters)-4);

table1.Filter := filters;

UpdateStatusBar;

end;

procedure TPhoneForm.SortMode (Sender: tObject);

var

i: integer;

begin

for i := 0 to 2 do

PopupMenu1.Items[i].Checked := false;

(sender as TMenuItem).Checked := true;

end;

procedure TPhoneForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

application.OnMessage := MainForm.progressAom;

WriteIni;

postMessage(MainForm.Handle, WM_CLOSE, 0, 0);

end;

procedure TPhoneForm.ReadIni;

begin

with TIniFile.Create(ExtractFilePath(Application.exename)+sIniFile) do

begin

table1.IndexName := IndexName[ReadInteger(‘Defaults’,’SortIndex’, 0)];

Left := ReadInteger(‘Position’,’left’, 100);

top := ReadInteger(‘Position’,’top’, 100);

Height := ReadInteger(‘Position’,’height’, 50);

end;

end;

function IndexOfItem(Item: string): integer;

begin

if Item = SortName[1] then result := 1

else if Item = SortName[2] then result := 2

else result := 0;

end;

procedure TPhoneForm.WriteIni;

begin

with TIniFile.Create(ExtractFilePath(Application.exename)+sIniFile) do

begin

WriteInteger(‘Defaults’,’SortIndex’, IndexOfItem(Table1.indexName));

WriteInteger(‘Position’,’left’, PhoneForm.left);

WriteInteger(‘Position’,’top’, PhoneForm.top);

WriteInteger(‘Position’,’height’, PhoneForm.height);

end;

end;

procedure TPhoneForm.MInMaxSize(var Message: TMessage);

begin

with TwmGetMinMaxInfo(Message) do

begin

MinMaxInfo.ptMaxTrackSize.X := PhoneForm.Width;

MinMaxInfo.ptMaxTrackSize.y := Screen.Height- 100;

MinMaxInfo.ptMinTrackSize.X := PhoneForm.Width;

MinMaxInfo.ptMinTrackSize.y := 200;

end;

end;

procedure TPhoneForm.MyPopupHandler2(Sender: TObject);

begin

if Sender is TMenuItem then

if Clipboard.HasFormat(CF_TEXT) then

Inputs[PopupMenu2.Tag].Text := Clipboard.AsText;

end;

procedure TPhoneForm.MyEditPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);

begin

PopupMenu2.Items[0].Enabled := Clipboard.HasFormat(CF_TEXT);

if Sender is TEdit then PopupMenu2.Tag := (Sender as TEdit).Tag

end;

procedure TPhoneForm.N20Click(Sender: TObject);

begin

Application.HelpCommand(HELP_WM_HELP ,0);

end;

procedure TPhoneForm.N13Click(Sender: TObject);

begin

Table1.First;

end;

procedure TPhoneForm.N14Click(Sender: TObject);

begin

Table1.Prior;

end;

procedure TPhoneForm.N15Click(Sender: TObject);

begin

Table1.Next;

end;

procedure TPhoneForm.N16Click(Sender: TObject);

begin

Table1.Last;

end;

procedure TPhoneForm.ExitButtonClick(Sender: TObject);

begin

Table1.Close;

PhoneForm.Close;

end;

procedure TPhoneForm.SearchButtonClick(Sender: TObject);

begin

Search.OnClick(Sender);

end;

procedure TPhoneForm.HelpButtonClick(Sender: TObject);

begin

PostMessage(PhoneForm.handle, WM_KEYDOWN, vk_f1, 0);

end;

procedure TPhoneForm.FormDestroy(Sender: TObject);

begin

Application.HelpCommand(HELP_QUIT,0);

end;

end.

приложение 2

unit Progress;

interface

uses

Windows, SysUtils, Classes, Forms, Dialogs, StdCtrls,

DB, DBTables, Controls, ComCtrls, Registry,ShellApi, Messages, Graphics,

ExtCtrls ;

const

MM_BASE = WM_User;

MM_OKSTART = MM_BASE + $1;

MM_DATAERROR = MM_BASE + $2;

MM_KeyDown = MM_BASE + $3;

MM_ENDTHREAD = MM_BASE + $4;

type

TMainForm = class(TForm)

ProgressBar1: TProgressBar;

lbPersent: TLabel;

Table2: TTable;

Image1: TImage;

Table1: TTable;

Timer1: TTimer;

lbMessage: TLabel;

procedure FormCreate(Sender: TObject);

procedure ProgressAOM (var MSG: tagMSG; var Handled: boolean);

procedure RegApplication;

procedure DataError(var Message: TMessage); message MM_DATAERROR;

procedure Timer1Timer(Sender: TObject);

procedure EndThread(var Message:TMessage); message MM_ENDTHREAD;

private

IsCanStart: boolean;

FStartTime: cardinal;

function SearchFile(FileName: string): boolean;

public

{ Public declarations }

end;

type EPhoneException = class (Exception);

var

MainForm: TMainForm;

tick: cardinal;

IsFirst : boolean = true;

const

sDataFile = ‘Data.dbf’;

sIndexFile = ‘Data.mdx’;

sBuffFile = ‘DataBuff.dbf’;

sBuffFile2 = ‘DataBuff2.dbf’;

sShortappname = ‘LutskPhone’;

sIniFile = ‘options.ini’;

sHelpFile = ‘help.hlp’;

sDataFileError = ‘Ошибка при работе с базой данных ‘

+#10#13+’Проверьте наличии файла базы!’;

sBDEError = ‘Ошибка работы с BDE’;

implementation

uses TelDov, Thread, ActiveX, ComObj, ShlObj;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);

begin

try

IsCanStart := false;

// FStartTime := $FFFFFFFF;

// Application.HelpFile := sHelpFile;

Top := (Screen.Height — Height) div 2-200;

Left := (Screen.Width — Width) div 2;

Application.OnMessage := ProgressAOM ;

// RegApplication;

try

Table1.TableName := sBuffFile;// Check BDE

Table1.CreateTable;

Table1.Close;

// ShowMessage(DBIgetErrorString);

DeleteFile(ExtractFilePath(ParamStr(0))+’/’+sBuffFile);

except

raise EPhoneException.Create(sBDEError); // error BDE

end;

if not SearchFile(sDataFile)

then raise EPhoneException.Create(sDataFileError);

if not SearchFile(sIndexFile)

then DataThread.create(false)

else IsCanStart := true;

except

on E: Exception do

begin

MessageDlg(e.Message, mtError, [mbOk],0);

PostMessage(MainFOrm.Handle, MM_DATAERROR, 0, 0);

end;

end;

// FStartTime := GetTickCount;

Invalidate;

end;

procedure TMainForm.ProgressAOM (var MSG: tagMSG; var Handled: boolean);

begin

if MSG.Message = MM_OKSTART then

begin

Timer1.Enabled := false;

Application.CreateForm(TPhoneForm, PhoneForm);

MainFOrm.Hide;

PhoneForm.Show;

Application.OnMessage := PhoneForm.AOM;

end;

end;

function TMainForm.SearchFile(FileName: string): boolean;

var

CurrFile : TSearchRec;

begin

if FindFirst(GetCurrentDir +»+FileName, faAnyFile, CurrFIle)=0

then Result := true

else Result := false;

end;

procedure TMainForm.RegApplication;

var

R: TRegIniFile;

IsRegister: boolean;

Directory: string;

MyObject: IUnknown;

MySLink: IShellLink;

MyPFile: IPersistFile;

WFileNAme: WideString;

begin

IsRegister := false;

R := TRegIniFile.Create(»);

with R do

begin

RootKey := HKey_Current_User;

if Openkey(‘SoftwareRonyaSoft’+ sShortappname, true)

then IsRegister := ReadBool(»,’Register’,false);

if not(IsRegister)

then

begin

DeleteKey(»,'(Поумолчанию)’);

WriteBool(»,’Register’,true);

CloseKey;

MyObject := CreateComObject(CLSID_ShellLink);

MySLink := MyObject as IShellLink;

MyPFile := MyObject as IPersistFile;

with MySLink do

begin

SetPath(PChar(Application.exename));

SetWorkingDirectory(PChar(ExtractFilePath(Application.exename)));

end;

OpenKey(‘SoftwareMicroSoftWindowsCurrentVersionExplorer’, false);

Directory := ReadString(‘Shell Folders’,’Desktop’,»);

WFileNAme := Directory + » + sShortAppName +’.lnk’;

MyPFile.Save(PWChar(WFIleName), false);

end;

end;

r.Free;

end;

procedure TMainForm.DataError(var Message: TMessage);

begin

Close;

end;

procedure TMainForm.Timer1Timer(Sender: TObject);

begin

if IsFirst then

begin

IsFirst := false;

FStartTime := 0; // GetTickCount;

end;

if IsCanStart then

begin

Tick := GetTickCount;

if Tick > (FStartTime + 0) // 1000

then PostMessage(MainFOrm.Handle, MM_OKSTART, 1, 0);

end

end;

procedure TMainForm.EndThread(var Message: TMessage);

begin

Image1.Visible := true;

Caption := »;

lbPersent.Visible := false;

lbMessage.Visible := false;

ProgressBar1.Visible := false;

IsCanStart := true;

end;

end.

приложение

unit Thread;

interface

uses

Classes, Windows, sysUtils, Progress, forms, dialogs;

type

DataThread = class(TThread)

private

procedure RemaskMDX;

protected

TempDir: PChar;

procedure Execute; override;

procedure UpdateProgress;

procedure UpdateForm;

end;

implementation

procedure DataThread.Execute;

var

i, j: integer;

prom: string;

begin

freeOnTerminate := true;

with MainForm do begin

try

Synchronize(UpdateForm);

GetMem(TempDir, MAX_Path);

GetTempPath(MAx_Path,TempDir);

CopyFile(PChar(ExtractFilePath(Application.ExeName)+sDataFile),

PCHar(TempDir + sBuffFile2), true );

RemaskMDX;

Table2.TableName := TempDir + sDataFile;

Table1.TableName := TempDir + sBuffFile;

Table1.Open;

Table2.CreateTable;

Table2.Open;

Table2.Edit;

j := 0;

while not Table1.eof do

begin

for i:= 0 to Table1.FieldCount — 1 do

begin

prom := Table1.Fields[i].asString;

Table2.Fields[i].AsString := Table1.Fields[i].asString;

end;

Table1.next;

Table2.Append;

Inc(j);

If j > 1000 then

begin

SynchroNize(UpdateProgress);

j := 0;

end;

end;

Table1.Close;

Table2.Close;

CopyFile(PChar(TempDir + sDataFile),

PChar(ExtractFilePath(Application.ExeName)+ sDataFile), false );

CopyFile(PChar(TempDir + sIndexFile),

PChar(ExtractFilePath(Application.ExeName)+ sIndexFile), false );

DeleteFile(TempDir + sBuffFile);

DeleteFile(TempDir + sBuffFile2);

DeleteFile(TempDir + sDataFile);

DeleteFile(TempDir + sIndexFile);

FreeMem(TempDir, MAX_Path);

PostMessage(MainFOrm.Handle, MM_ENDTHREAD, 0, 0);

except

on e: exception do PostMessage(MainFOrm.Handle, MM_DATAERROR, StrToInt(e.Message), 0)

end;

end;

end;

procedure DataThread.UpdateProgress;

var Persent: integer;

begin

with MainFOrm do

begin

Persent := trunc(100*(Table1.RecNo/Table1.RecordCount));

progressBar1.Position := Persent;

lbPersent.Caption := InttoStr (Persent)+ ‘ %’;

end;

end;

procedure DataThread.RemaskMDX;

var

OldFile, NewFile: tFileStream;

Buffer : byte;

const index = 28;

begin

OldFile := TFileStream.Create(TempDir + sBuffFIle2, fmOpenRead or fmShareDenyWrite);

try

NewFile := TFileStream.Create( TempDir + sBuffFile,fmCreate or fmOpenWrite);

try

NewFile.CopyFrom(OldFile ,OldFile.Size);

NewFile.Position := index;

Buffer := 0;

NewFile.Write(Buffer, 1);

finally

FreeAndNil(NewFile);

end;

finally

FreeAndNil(OldFile);

end;

end;

procedure DataThread.UpdateForm;

begin

with MainFOrm do

begin

Image1.Visible := false;

ProgressBar1.Visible := true;

LbPersent.Visible := true;

lbMessage.Visible := true;

end;

end;

end.

]]>