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

3









   

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



Филиал ______________________________________________________________











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



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



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









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



№ контракта       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 часа, так и серьезных корпоративных проектов, предназначенных для работы десятков и сотен пользователей. Причем для этого можно использовать самые последние веяния в мире компьютерных технологий с минимальными затратами времени и сил. 



                        









       































      Назначение и область применения

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





                        









































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

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

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



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

Чтобы базу данных можно было переносить с компьютера на другой компьютер программа должна сама создавать алиасы. Так как dBase сохраняет базу данных в виде файла с названием базы dBase.DBF. Удобно не просто указывать путь доступа к таблицам базы данных, а использовать для этого некий заменитель - псевдоним, называемый алиасом.                         Некоторые СУБД сохраняют базу данных в виде нескольких отдельных файлов, представляющих собой таблицы (в основном, все локальные СУБД), в то время как другие состоят из одного файла, который содержит в себе все таблицы и индексы (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:\users\data



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



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



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

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 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  Поиск в базе данных по номеру телефона.

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





Заключение

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



















































































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

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

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

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

5.Бобровский С.И. Delphi 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, Point(0,0), bool);

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].FieldName + '='+ QuotedStr(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('Software\RonyaSoft\'+ 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('Software\MicroSoft\Windows\CurrentVersion\Explorer', 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.