Загрузка...
Учебная работа. Курсовая работа: Базы данных. Создание программы Телефонный справочник
Филиал ______________________________________________________________
Курсовая работа
По дисциплине Программирование
на языке высочайшего уровня________________
Тема__Базы данных. Создание программки телефонный справочник
Выполнил студент Трифонов Александр Владимирович
№ договора 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.
]]>