Базы данных на Delphi

Параметр Size определяет размер поля. Если для полей некоторых типов, например, поля даты (ftDate), размер не задается, то параметр Size принимает нулевое значение. Логический параметр Required определяет, должно ли поле содержать значение (True) или может быть пустым (False).

В таблице можно определить индексы, описание которых заносится в свойство IndexDefs типа TIndexDefs. После предварительной очистки значения этого свойства методом Clear данные об индексах заносятся методом Add. После создания таблицы для нее можно создать индекс или удалить его с помощью методов AddIndex и DeleteIndex.

Для удаления таблицы используется метод DeleteTable, в результате выполнения которого происходит физическое удаление всех файлов указанной таблицы БД. Путь и имя удаляемой таблицы определяют свойства DatabaseName и TableName набора данных. Перед удалением таблицы набор данных должен быть закрыт.

Для переименования таблиц dBase и Paradox можно использовать метод RenameTable (const NewTableName: String), при выполнении которого переименовываются все файлы, относящиеся к таблице. Параметр NewTableName задает новое название таблицы. Напомним, что имя таблицы совпадает с названиями файлов, за исключением расширения имени файла, которое отражает содержимое файла (например, файл содержит данные или индексы).

Установка уровня доступа. В случае многопользовательского доступа к БД для таблицы можно установить уровни доступа, которые будут действовать для других приложений. Уровень доступа определяет возможность записи данных в таблицу и их чтения.

Метод LockTable (LockTepy: TLockТуре) устанавливает блокировку для таблицы, параметр LоскТуре задает тип блокировки:

· ltReadLock -- запрещены запись в таблицу и чтение ее; этот режим является своего рода режимом монопольного доступа

· ltWriteLock -- запрещена запись в таблицу; другие приложения не могут выполнять модификацию таблицы, но чтение данных разрешено

Метод UpLockTable (LockType: TLockТуре) снимает установленную ранее блокировку.

2.2 Сортировка набора данных

база данных delphi фильтрация

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

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

Сортировка наборов данных Table и Query выполняется различными способами. Рассмотрим сортировку набора данных Table. Для компонента Query вопросы сортировки рассмотрены в пункте «Реляционный способ доступа к базе данных».

Сортировка наборов данных Table выполняется автоматически по текущему индексу. При смене индекса происходит автоматическое переупорядочение записей. Таким образом, сортировка возможна по полям, для которых создан индекс. Для сортировки по нескольким полям нужно создать индекс, включающий эти поля.

Направление сортировки определяет признак ixDescending текущего индекса. По умолчанию он выключен, поэтому упорядочение происходит в порядке возрастания значений. Если для индекса установлен признак ixDescending, то сортировка выполняется в порядке убывания значений.

Задать индекс, по которому будут сортироваться записи, можно с помощью установки значений свойств IndexName или IndexFieldNames. В качестве значения свойства IndexName указывается имя индекса, которое определяется при создании таблицы. При использовании свойства IndexFieldNames указывается имена полей, образующих соответствующий индекс.

2.3 Перемещение по набору данных

Перемещение по набору данных заключается в управлении указателем текущей записи (курсором). Этот указатель определяет запись, с которой будут выполняться такие операции, как редактирование или удаление.

Перемещение по записям. Перед перемещением указателя текущей записи набор данных автоматически переводится в режим просмотра. Если текущая запись находилась в режиме редактирования или вставки, то перед перемещением указателя сделанные в записи изменения вступают в силу. Для этого автоматически вызывается метод CheckBrowseMode набора данных.

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

· Процедура First -- первая запись

· Процедура Next -- следующая запись (при вызове метода Next для последней записи указатель не перемещается)

· Процедура Last -- последняя запись

· Процедура Prior -- предыдущая запись (при вызове метода Prior для первой записи указатель не перемещается)

· Функция MoveBy (Distance: Integer): Integer -- перемещает указатель на число записей, определяемое параметром Distance. Если его значение больше нуля, то происходит перемещение вперед, если меньше нуля -- назад. При нулевом значении параметра указатель не перемещается. В качестве результата возвращается число записей, на которое переместился указатель.

При перемещении указателя текущей записи учитываются ограничения и фильтр, определенные для набора данных. Таким образом, перемещение выполняется по записям набора данных, которые он содержит в текущий момент времени. Число записей определяется свойством RecordCount.

Значения указателя текущей записи изменяют также методы, связанные с поиском записей, например, метод FindFirst.

Для контроля за положением указателя текущей записи можно использовать свойство RecNo, которое содержит номер записи, начиная от начала набора данных (для локальных таблиц dBase и Paradox).

Для таблиц Paradox свойство RecNo также можно использовать с целью перехода к записи с известным номером, такой переход выполняется установкой свойству RecNo значения, равного номеру нужной записи.

Для определения начала и конца набора данных при перемещении указателя текущей записи можно использовать свойства BOF и EOF типа Воо1eаn. Эти свойства доступны для чтения при выполнении приложения. Свойство BOF показывает, находится ли указатель на первой записи набора данных. Этому свойству устанавливается значение True при размещении указателя на первой записи, например, сразу после вызова метода First. Свойство EOF показывает, находится ли указатель на последней записи набора данных. Этому свойству устанавливается значение Ture, когда указатель находится на последней записи.

2.4 Фильтрация записей

Фильтрация -- это ввод ограничений для записей, которые должны войти в набор данных. Напомним, что набор данных представляет собой записи, выбранные из одной или нескольких таблиц. Состав записей в наборе данных в определенный момент времени зависит от устанавливаемых ограничений, в том числе с помощью фильтрации. Delphi предоставляет возможность выполнения двух следующих вариантов фильтрации записей набора данных:

· По выражению

· По диапазону

По умолчанию фильтрация записей не ведется и набор данных Table содержит все записи связанной с ним таблицы БД, а набор данных Query составляют все записи, удовлетворяющие SQL-запросу, содержащемуся в свойстве SQL.

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

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

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

Для определения выражения фильтра используется свойство Filter типа String. Выражение фильтра представляет собой конструкцию, в состав которой могут входить следующие элементы:

· Имена полей таблиц

· Литералы

· Операции сравнения

· Арифметические операции

· Логические операции

· Круглые и квадратные скобки

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

Литерал представляет собой значение, заданное явно ( например, число, строка или символ).

В качестве логических операций можно использовать and, or и not .

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

Фильтрация по диапазону. При фильтрации по диапазону в набор данных будут включены те записи, значения полей которых соответствуют заданному диапазону. Таким образом, условием фильтрации является выражение вида значение > нижней границы AND значение < верхней границы, в котором вместо операций сравнения < и > могут указываться операции <= и >=. Такая фильтрация применяется к наборам данных Table.

Достоинством указанного способа фильтрации является скорость обработки записей. В отличие от способа фильтрации по выражению, когда последовательно просматриваются все записи таблицы, фильтрация происходит с использованием индексов индексно-последовательным методом. Однако этот способ фильтрации можно применять только для индексированных полей. Индекс поля, диапазон которого действует для отбора записей, должен быть установлен как текущий индекс с помощью свойства IndexName или IndexFieldNames. Если текущий индекс не установлен, то по умолчанию используется главный индекс.

Для включения и выключения фильтрации по диапазону применяются методы ApplyRange и CancelRange. Первый активизирует фильтр, а второй -деактивизирует. Предварительно для индексного поля (полей), по которому выполняется фильтрация, следует задать диапазон допустимых значении.

Методы SetRangeStart и SetRangeEnd устанавливают границы диапазона. Эти процедуры не имеют параметров, поэтому нужно использовать оператор присваивания.

Таким образом, методы SetRangeStart и SetRangeEnd переводят набор данных в режим dsSetKey, а с помощью оператора присваивания задается диапазон.

Для изменения границ диапазона предназначены методы EditRangeStart и EditRangeEnd, действие которых аналогично действию методов SetRangeStart и SetRangeEnd.

Совместно с этими методами используется свойство KeyExclusive типа Boolean, которое определяет, как учитывать заданное граничное значение при анализе записей. Если свойство KeyExclusive имеет значение False (по умолчанию), то записи c значением поля, по которому выполняется фильтрация, равным границе диапазона, включаются в состав набора данных. Если свойство имеет значение True, то записи с названным значением поля в набор данных не включаются.

Для отмены фильтрации, выполненной с помощью методов ApplyRange или SetRange, используется метод CancelRange. Другой вариант отмены предыдущей фильтрации -- задание новых границ диапазона, например, методами SetRangeStart и SetRangeEnd.

2.5 Поиск записей

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

При организации поиска записей важное значение имеет наличие индекса для полей, по которым ведется поиск. При использовании индексов значительно повышается скорость обработки данных. Кроме того, ряд методов может работать только с индексированными полями.

Рассмотрим средства, с помощью которых выполняется поиск записей в наборах данных Table и Query. Отметим, что к средствам поиска можно отнести также методы FindFirst, FindLast, FindNext и FindPrior -- Переход на записи, удовлетворяющие условиям фильтра.

Поиск в наборах данных. Для поиска записей по полям в Delphi служат методы Locate и LookUp. Поля могут быть не индексированными.

Функция Locate (Const KeyFields: String; const KeyValues: Variant; Options: TLocateOption): Boolean ищет записи, содержащие заданные поля. Если записи, удовлетворяющие условиям поиска, существуют, то указатель текущей записи устанавливается на первую из них. Когда запись найдена, функция возвращает значение True, в противном случае -- значение False.

KeyFields - список полей, по которым ведется поиск.

KeyValues - указывает значения полей для поиска.

Options - позволяет задать значения, которые обычно используются при поиске строк.

Метод LookUp, работает так же, как метод Locate. Функция LookUp (Const KeyFields: String; const KeyValues: Variant; const ResultField: String): Variant осуществляет поиск записи, удовлетворяющей определенным условиям, но, в отличие от метода Locate, не перемещает указатель текущей записи на найденную запись, а считывает информацию из полей записи. Еще одно отличие между этими двумя методами заключается в том, что метод LookUp осуществляет поиск, причем значения в полях записей (с учетом регистра) должны точно соответствовать значениям, заданным для поиска.

Параметры KeyFields и KeyValues имеют такое же назначение, как и в методе Locate, и используются аналогичным образом при поиске по одному или нескольким полям.

Для параметра ResultField через точку с запятой перечисляются названия полей, значения которых будут получены в случае успешного поиска.

Поиск по индексным полям. Для набора данных Table существуют методы, позволяющие вести поиск записей только по индексным полям. Перед вызовом любого из этих методов следует установить в качестве текущего индекс, построенный по полям, используемым для поиска. Методы поиска можно разделить на две группы, в первую из которых входят методы FindKey, SetKey, EditKey и GotoKey, предназначенные для поиска на точное соответствие, а другую группу -- методы FindNearest, SetNearest, EditNearest И GotoNearest, допускающие частичное совпадение заданных для поиска значений и значений полей записей.

Метод FindKey (const KeyValues: array of const): Boolean выполняет поиск в наборе данных Table той записи, значения полей которой совпадают со значениями, указанными параметром KeyValues. Список полей для поиска не задается, а используются индексные поля в соответствии с текущим индексом. Если поиск завершился успешно, то найденная запись становится текущей, а метод возвращает значение True. При неудачном поиске указатель текущей записи не перемещается, а результатом метода будет значение False.

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

Вместо метода FindKey можно использовать методы SetKey, EditKey и GotoKey, которые применяются совместно. Их использование похоже на использование уже рассмотренных методов SetRangeStart, EditRangeStart и ApplyRange для фильтрации набора данных по диапазону значений.

Метод SetKey переводит набор данных в режим dsSetKey поиска записи. Этот метод вызывается один раз для текущего индекса. Впоследствии для перехода в режим поиска можно вызывать метод EditKey. Если набор данных находится в режиме поиска, значения полей устанавливаются с помощью операторов присваивания. Метод GotoKey: Boolean выполняет собственно поиск записи, удовлетворяющей заданному условию.

Метод FindNearest, в отличие от метода FindKey, производит поиск значений полей записей набора данных Table, которые частично совпадают со значениями, заданными для поиска. Частичное совпадение допускается для начала значения поля записи. Такой поиск можно применять к строкам и к данным другого типа, например, целочисленного. Поиск с помощью процедуры FindNearest (const KeyValues: array of const) Всегда является успешным и перемешает указатель текущей записи на запись, в наибольшей степени отвечающую условиям поиска.

Вместо метода FindNearest можно использовать комбинацию методов SetNearest, EditNearest И GotoNearest, работа с которыми аналогична работе с соответствующими методами поиска, требующими точного соответствия значений полей и значений, заданных для поиска.

2.6 Модификация набора данных

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

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

Управлять изменением набора данных Table можно с помощью свойства ReadOnly типа Boolean, при установке которому значения True изменения записей запрещены. По умолчанию свойство ReadOnly имеет значение False, т. е. набор данных можно модифицировать.

Значение свойства ReadOnly можно изменять только для закрытого набора данных. В отличие от многих управляющих элементов, например, редакторов Edit и Memo, запрет редактирования относится к визуальному (пользователем) и программному изменению записей набора данных.

Возможность модификации набора данных Query определяет свойство RequestLive типа Boolean. По умолчанию это свойство имеет значение False, т. е. набор данных Query доступен только для чтения. Для получения возможности редактирования записей свойству RequestLive нужно установить значение True. Кроме этого свойства, возможность изменения набора данных Query зависит также от содержания SQL-запроса. Например, если в результате запроса отбираются записи из нескольких таблиц, то набор данных нельзя модифицировать, и значение True свойства RequestLive не учитывается.

Для проверки возможности изменения набора данных предназначено свойство CanModify типа Boolean, действующее при выполнении приложения и доступное только для чтения. Если свойство CanModify имеет значениеTrue, то набор данных можно изменять, редактируя, вставляя записи, а также удаляя их. Если свойство CanModify имеет значение False, то набор данных изменять нельзя и попытка сделать это визуально или программно вызывает исключительную ситуацию.

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

· Перевести набор данных в режим редактирования

· Изменить значения полей записи

· Подтвердить сделанные изменения или отказаться от них, в результате чего набор данных снова переходит в режим просмотра

Если набор данных является модифицируемым, и исключительная ситуация не возбуждается.

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

Для проверки, вносились ли изменения в запись, можно проанализировать свойство Modifid типа Boolean. Если свойство имеет значение True, то было изменено значение, как минимум, одного поля текущей записи.

После ввода информации сделанные изменения должны быть или подтверждены, или отменены.

Метод Post записывает модифицированную запись в таблицу БД, снимает блокировку записи и переводит набор данных в режим просмотра. Если набор данных не находился в режиме редактирования, то вызов метода Post приведет к генерации исключительной ситуации.

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

Для добавления записи нужно выполнить следующие действия:

· Перевод набора данных в режим вставки

· Задание значений полей новой записи

· Подтверждение сделанных изменений или отказ от них, в результате на бор данных переходит в режим просмотра

Для добавления записей используются методы Insert, InsertRecord, Append и AppendRecord.

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

Метод InsertRecord выполняет те же действия, что и методы Insert и SetFields. Процедура InsertRecord (const Values: array of const) вставляет в позицию указателя текущей записи новую запись, задавая значения всех или некоторых ее полей.

Методы Append и AppendRecord отличаются от методов Insert и InsertRecord тем, что вставляют запись в конец набора данных, а не в текущую позицию указателя.

Удаление записей. Удаление текущей записи выполняет метод Delete, который работает только с модифицируемым набором данных. В случае успешного удаления, текущей становится следующая запись, если же удалялась последняя запись, то курсор перемещается на предыдущую запись, которая после удаления становится последней. В отличие от некоторых СУБД, в Delphi удаляемая запись действительно удаляется из набора данных.

Обычно метод Delete вызывается для удаления просматриваемой записи, однако он удаляет и редактируемую запись. Таким образом, метод Delete удаляет текущую запись набора данных, который находится в режимах просмотра или редактирования. Если набор данных находится в режиме вставки или поиска, то вызов метода Delete аналогичен вызову метода Cancel, отменяя вставку или поиск записи.

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

3. ОПИСАНИЕ ПРИЛОЖЕНИЯ

В данном разделе будет приведено описание форм и модулей приложения.

3.1 Файл проекта

При входе в программу первым запускается файл проекта, который был изменен для добавления дополнительных функций. Пароль для входа - " zybr".

В данный файл сначала подключены дополнительные модули dialogs, controls, sysUtils для работы с типизированными файлами, диалогами… До создания какой либо формы проверяется пароль методом функции inputQuery (рис. 3.1.), которая присваивает параметру Pas значение введённое в окне диалога.

Рис. 3.1. Диалог inputQuery

Если пароль подтвердился, то дальше создаются формы. В противном случае приложение закрывается. Первой создается форма fZastavka (Рис. 3.2) которая тут же выводится на экран и обновляется. После чего таймеру присваивается значение FALSE и форма уничтожается.

3.2 Форма заставки

На форму помещен элемент Timer1 с установленным значением Interval = 1000 (1 сек). После срабатывания таймера его свойству ENABLED:=False, что и приводит к закрытию формы и после удалению.

Рис. 3.2. Форма заставки

3.3 Основная форма

Данная форма является главной в программе, т.к. программа предназначена для сортировки, просмотра и создания базы данных абсолютно любых файлов компьютера.

Для просмотра (открытия) какого-нибудь файла необходимо указать путь и щелкнуть дважды по его имени в окне проводника.

Для копирования (перемещения) файла необходима указать папку куда будет скопирован (перемещен) данный файл и зажав кнопку мыши перетащить в соседнее окно (так же можно воспользоваться кнопками на форме). Предварительно указав действие (Копировать или перемещать), нажав кнопку в панели управления соответствующие команде.



Рис. 3.3. Основная форма программы

Также можно форме установить свойство «Всегда наверху», установив галочку на панели инструментов.

В пункте «ФАЙЛ» можно выбрать пункт открыть базу, что приведёт к открытию формы базы (Более детально она будет рассмотрена ниже).

Кнопка «Удалить»- удаляет файл с компьютера.

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

При выборе файла и нажатии кнопки «Добавить файл» будет открыта форма добавления записи в базу данных (Будет рассмотрена ниже).

Также на форме предусмотрено отображение подсказок в панели состояния и там же отображается некоторая системная информация.

Т.к. проект предназначен только для ознакомления с основными возможностями среды DELPHI, то код нижнего окна не писался с целью экономии времени и бумаги).

3.4 Форма вставки новых записей

Данная форма (Рис. 3.5) предназначена для добавления выдранного файла, с указанием необходимой информации, в базу данных. Возможно так же редактирование дополнительной базы «Раздел», хранящую информацию о типе файла (пр. Матан, художественная…). Для добавления книги необходимо ввести обязательную информацию, иначе будет показано предупреждение(рис. 3.4). Поле «Адрес», о выбранном файле, заполняется автоматически. После добавления форма закрывается.

Рис. 3.4. Предупреждение

Рис. 3.5. Форма вставки записи

3.5 Форма добавления разделов

Данная форма предназначена для редактирования разделов, т.е. дополнительной информации о книге. Информация о разделах сохраняется в отдельной базе - Raz.DB, Находящейся в папке с программой.

Рис. 3.6. Форма редактирования разделов

3.6 Форма просмотра базы данных

Форма предназначена для просмотра и редактирования базы данных (Рис. 3.8). На форме также использована система отображения подсказок и функция отображения Фомы «поверх всех окон», возможна сортировка информации и последовательный поиск записи. Также возможен запуск файла при двойном клике по записи файла или нажатии соответствующей кнопки. Для удобства в использовании максимальная высота и минимальная ширина формы ограничены (Рис. 3.7).

Рис. 3.7. Форма с измененными размерами



Рис. 3.8. Фома просмотра базы

3.7 Дополнительный модуль

Дабы не изобретать велосипед и не тратить всем драгоценное время, модуль был взят из примеров, поставляемых вмести с DELPHI. Данный модуль используется главной форой для копирования и перемещения файлов.

ЗАКЛЮЧЕНИЕ

В ходе данной работы были изучены основные цели и требования, предъявляемые к разработчикам баз данных:

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

2.Безопасность и секретность. Изучены некоторые методы ограничения доступа к базам данных.

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

Были проведены соответствующие исследования в интерфейсах других приложений для организации наиболее эргономичного управления программой.

Т.к. приложение рассчитано на локального пользователя, то был выбран навигационный способ доступа к базам данных. Достоинство навигационного способа доступа к базе данных -- простота кодирования операций с набором данных.

Особую роль для хранения информации на компьютере играет объектно-ориентированное программирование. Общую ее цель можно сформулировать так: доступ и обработка информации осуществляется без определенных знаний и опыта работы с компьютером.

СПИСОК ИСПОЛЬЗОВАННЫХ ИСТОЧНИКОВ

1 Тейксейра. Delphi 5. Руководство разработчика, том 1. Основные методы и техники программирования / Тейксейра, Стив, Пачеко, Ксавье - Издательский дом «Вильямс», 2001.- 780с.

2 Тейксейра. Delphi 5. Руководство разработчика, том 2. Разработка компонентов и программирование баз данных / Тейксейра, Стив, Пачеко, Ксавье - Издательский дом «Вильямс», 2001.- 821с.

3 Гофман, В.Э. Delphi / В.Э. Гофман.- СПб.: БХВ - Петербург, 2001.-800с.

4 Фаронов, В. Delphi 6: учебный курс / В. Фаронов - СПб.: Питер, 2002.-512с.

ПРИЛОЖЕНИЯ

ПРОГРАММА ДЛЯ СОРТИРОВКИ ЭЛЕКТРОННЫХ ФАЙЛОВ

//Текст файла проекта

program Project1;

uses

Forms,

dialogs,

controls,

sysUtils,

Unit1 in 'Unit1.pas' {Form1},

Modulepas in 'Modulepas.pas',

InsRec in 'InsRec.pas' {InsertRec},

UZastavka in 'UZastavka.pas' {FZastavka},

URazdel in 'URazdel.pas' {Razdel},

UBase in 'UBase.pas' {FBase};

{$R *.RES}

var

pas:string;

listBase:TextFile;

begin

if inputQuery('Вход','Введите пароль',pas) then

if pas='zybr' then begin

Application.Initialize;

Application.CreateForm(TFZastavka, FZastavka);

fZastavka.Show;

fzastavka.Update;

while fzastavka.Timer1.enabled do

application.processMessages;

Fzastavka.free;

Application.CreateForm(TForm1, Form1);

Application.CreateForm(TInsertRec, InsertRec);

Application.CreateForm(TRazdel, Razdel);

Application.CreateForm(TFBase, FBase);

if not FileExists(extractFilePath(application.exeName)+'Base\ListBase.txt') then begin

assignFile(ListBase, extractFilePath(application.exeName)+'Base\ListBase.txt');

rewrite(ListBase);

end;

end else MessageDlg('Не тот пароль !'+#13+'Проверь пароль!!', mtError,[mbOk],0);

Application.Run;

end.

//Текст файла заставки

unit UZastavka;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls;

type

TFZastavka = class(TForm)

Timer1: TTimer;

Image1: TImage;

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FZastavka: TFZastavka;

implementation

{$R *.DFM}

procedure TFZastavka.Timer1Timer(Sender: TObject);

begin

timer1.Enabled:=false;

end;

end.

//Текст файла основной формы

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Buttons, StdCtrls, Menus, FileCtrl, ComCtrls, ToolWin, AppEvnts, Grids,

Outline, DirOutln, shellApi, ExtCtrls, jpeg, ImgList;

type

TForm1 = class(TForm)

StatusBar1: TStatusBar;

ToolBar1: TToolBar;

ScrollBox1: TScrollBox;

TBSBCopy: TSpeedButton;

TBSBMove: TSpeedButton;

SpeedButton3: TSpeedButton;

DriveComboBox1: TDriveComboBox;

DirectoryListBox1: TDirectoryListBox;

Dir1: TFileListBox;

FilterComboBox1: TFilterComboBox;

SBDir12: TSpeedButton;

SBDir21: TSpeedButton;

SBDir13: TSpeedButton;

SBDir31: TSpeedButton;

Dir2: TFileListBox;

Dir3: TFileListBox;

LabDir2: TLabel;

LabDir3: TLabel;

ApplicationEvents1: TApplicationEvents;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

PopupMenu1: TPopupMenu;

MnCopy: TMenuItem;

MNMove: TMenuItem;

N5: TMenuItem;

PmRef: TMenuItem;

ToolButton5: TToolButton;

TBSBDelete: TSpeedButton;

MnOpenBase: TMenuItem;

MnExit: TMenuItem;

HeaderControl1: THeaderControl;

BbIns2: TBitBtn;

BbIns3: TBitBtn;

N3: TMenuItem;

BbDir2: TBitBtn;

BitBtn1: TBitBtn;

MnShutDown: TMenuItem;

MnReBoot: TMenuItem;

N8: TMenuItem;

Label1: TLabel;

CBOnTop: TCheckBox;

ToolButton1: TToolButton;

procedure PmRefClick(Sender: TObject);

procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);

procedure FormCreate(Sender: TObject);

procedure ButDir2Click(Sender: TObject);

procedure ButDir3Click(Sender: TObject);

procedure Dir3Change(Sender: TObject);

procedure AllDirDbl(Sender: TObject);

procedure MnCopyClick(Sender: TObject);

procedure MNMoveClick(Sender: TObject);

procedure ConfChange(const ACaption, FromFile, ToFile: string);

procedure SBDir12Click(Sender: TObject);

procedure SBDir21Click(Sender: TObject);

procedure SBDir13Click(Sender: TObject);

procedure SBDir31Click(Sender: TObject);

procedure Dir1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure Dir2DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure Dir3DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure Dir2DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure Dir3DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure Dir1DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure TBSBDeleteClick(Sender: TObject);

procedure MnExitClick(Sender: TObject);

procedure MnOpenBaseClick(Sender: TObject);

procedure BbIns2Click(Sender: TObject);

procedure BbIns3Click(Sender: TObject);

procedure BbDir2Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure Dir2Change(Sender: TObject);

procedure MnShutDownClick(Sender: TObject);

procedure MnReBootClick(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure FormKeyPress(Sender: TObject; var Key: Char);

procedure Dir1Enter(Sender: TObject);

procedure Dir2Enter(Sender: TObject);

procedure CBOnTopClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

aders:string;

implementation

uses modulepas, Insrec, UBase, URazdel;

{$R *.DFM}

procedure TForm1.PmRefClick(Sender: TObject);

begin

statusbar1.Panels[2].Text:=IntToStr(diskSize(3) div 1024000)+' Mb';

statusbar1.Panels[4].Text:=IntToStr(diskSize(4) div 1024000)+' Mb';

dir1.Update;

dir2.Update;

dir3.Update;

end;

procedure TForm1.ApplicationEvents1Idle(Sender: TObject;

var Done: Boolean);

begin

form1.Caption:=TimeTostr(time);

application.Title:=TimeToStr(Time);

statusBar1.Panels[5].Text:=application.Hint;

fbase.statusBar1.Panels[0].Text:=statusBar1.Panels[5].Text;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

statusbar1.Panels[2].Text:=IntToStr(diskSize(3) div 1024000)+' Mb';

statusbar1.Panels[4].Text:=IntToStr(diskSize(4) div 1024000)+' Mb';

MnCopy.Checked:=true;

TBsbCopy.Down:=true;

Form1.KeyPreview := True;

end;

procedure TForm1.Dir3Change(Sender: TObject);

begin

LabDir3.Caption:=dir3.Directory;

end;

procedure TForm1.Dir2Change(Sender: TObject);

begin

LabDir2.Caption:=dir2.Directory;

end;

procedure TForm1.AllDirDbl(Sender: TObject);

begin

ShellExecute(form1.Handle, nil, PChar((sender as tFileListBox).FileName), nil, nil, sw_ShowNormal);

end;

{////////////////////////////////////////////////////////////////////////////////////////}

procedure TForm1.MnCopyClick(Sender: TObject);

begin

if MnCopy.Checked then begin

MnCopy.Checked:=false;

TBSBCopy.Down:=false;

MnMove.Checked:=True;

TBsbMove.Down:=True;

end else begin

MnCopy.Checked:=true;

TBSBCopy.Down:=true;

MnMove.Checked:=False;

TBsbMove.Down:=False;

end;

end;

procedure TForm1.MNMoveClick(Sender: TObject);

begin

if MnMove.Checked then begin

MnMove.Checked:=false;

TBsbMove.Down:=false;

MnCopy.Checked:=True;

TBsbCopy.Down:=True;

end else begin

MnMove.Checked:=true;

TBsbMove.Down:=True;

MnCopy.Checked:=False;

TBsbCopy.Down:=false;

end;

end;

{////////////////////////////////////////////////////////////////////////////////////////}

procedure TForm1.ConfChange(const ACaption, FromFile, ToFile: string);

begin

if MessageDlg(Format('%s %s '+#13+'В %s?', ['Копировать', FromFile,ToFile]),

mtConfirmation,[mbYes, mbNo],0) = mrYes then begin

if ACaption = 'Copy' then CopyFile(FromFile, ToFile) else

if ACaption = 'Move' then MoveFile(FromFile, ToFile);

Dir1.Update;

Dir2.Update;

Dir3.Update;

end;

end;

{//////////////////////////////////////////////////////}

procedure TForm1.SBDir12Click(Sender: TObject);

var

CurrentDir,FromFileName,ToFileName,s:string;

begin

if TBsbCopy.Down then s:='Copy' else

if TBsbMove.Down then s:='Move' else Exit;

FromFileName:=dir1.FileName;

ToFileName:=dir2.Directory;

ConfChange(s, FromFileName, ToFileName);

end;

procedure TForm1.SBDir21Click(Sender: TObject);

var

CurrentDir,FromFileName,ToFileName,s:string;

begin

if TBsbCopy.Down then s:='Copy' else

if TBsbMove.Down then s:='Move' else Exit;

FromFileName:=dir2.FileName;

ToFileName:=Dir1.Directory;

ConfChange(s, FromFileName, ToFileName);

end;

{///////////////////////////////////////////////////}

procedure TForm1.SBDir13Click(Sender: TObject);

var

CurrentDir,FromFileName,ToFileName,s:string;

begin

if TBsbCopy.Down then s:='Copy' else

if TBsbMove.Down then s:='Move' else Exit;

FromFileName:=dir1.FileName;

ToFileName:=dir3.Directory;

ConfChange(s, FromFileName, ToFileName);

end;

procedure TForm1.SBDir31Click(Sender: TObject);

var

CurrentDir,FromFileName,ToFileName,s:string;

begin

if TBsbCopy.Down then s:='Copy' else

if TBsbMove.Down then s:='Move' else Exit;

FromFileName:=dir3.FileName;

ToFileName:=Dir1.Directory;

ConfChange(s, FromFileName, ToFileName);

end;

{////////////////////////////////////////////////////}

procedure TForm1.Dir1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

if (source=Dir2) or(source=dir3) then accept:=true else accept:=false;

end;

procedure TForm1.Dir2DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

if source=Dir1 then accept:=true else accept:=false;

end;

procedure TForm1.Dir3DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

if source=Dir1 then accept:=true else accept:=false;

end;

procedure TForm1.Dir2DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

SBDir12.Click;

end;

procedure TForm1.Dir3DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

SBDir13.Click;

end;

procedure TForm1.Dir1DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

if source=dir2 then SBDir21.Click else SBDir31.Click;

end;

{////////////////////////////////////////////////////////////////////////////////////////}

procedure TForm1.TBSBDeleteClick(Sender: TObject);

begin

if dir1.Focused then

with dir1 do

if MessageDlg('Delete ' + FileName + '?', mtConfirmation,

[mbYes, mbNo], 0) = mrYes then

if DeleteFile(FileName) then begin

Update;

dir2.Update;

dir3.Update;

end;

if dir2.Focused then

with dir2 do

if MessageDlg('Delete ' + FileName + '?', mtConfirmation,

[mbYes, mbNo], 0) = mrYes then

if DeleteFile(FileName) then begin

Update;

dir1.Update;

dir3.Update;

end;

if dir3.Focused then

with dir3 do

if MessageDlg('Delete ' + FileName + '?', mtConfirmation,

[mbYes, mbNo], 0) = mrYes then

if DeleteFile(FileName) then begin

update;

dir1.Update;

dir2.Update;

end;

end;

procedure TForm1.MnExitClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.MnOpenBaseClick(Sender: TObject);

begin

FBase.showmodal;

end;

procedure TForm1.BbIns2Click(Sender: TObject);

begin

insertRec.Table1.Active:=true;

insertRec.Table2.Active:=true;

if insertrec.Table1.RecordCount<>0 then insertrec.table1.Last

else insertrec.Table1.First;

insertrec.Table1.Insert;

insertRec.Table1.FieldByName('Адрес').asString:=Dir2.FileName;

try

insertRec.ShowModal;

except

messagebeep(0);

showmessage('Обязательный ввод "Название" и "Раздел"');

end;

end;

procedure TForm1.BbIns3Click(Sender: TObject);

begin

insertRec.Table1.Active:=true;

insertRec.Table2.Active:=true;

if insertrec.Table1.RecordCount<>0 then insertrec.table1.Last

else insertrec.Table1.First;

insertrec.Table1.Insert;

insertRec.Table1.FieldByName('Адрес').asString:=Dir3.FileName;

insertRec.ShowModal;

end;

procedure TForm1.BbDir2Click(Sender: TObject);

var dir:string;

begin

if selectDirectory(dir,[sdAllowCreate, sdPerformCreate,sdPrompt],0) then Dir2.directory:=dir;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var dir:string;

begin

If selectDirectory(dir,[sdAllowCreate, sdPerformCreate,sdPrompt],0) then Dir3.directory:=dir;

end;

procedure TForm1.MnShutDownClick(Sender: TObject);

begin

win32Check(exitWindowsEx(ewx_ShutDown,0));

end;

procedure TForm1.MnReBootClick(Sender: TObject);

begin

win32Check(exitWindowsEx(ewx_ReBoot,0));

end;

procedure TForm1.N8Click(Sender: TObject);

begin

win32Check(exitWindows(0,0));

end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

if key = #27 then Close;

end;

procedure TForm1.Dir1Enter(Sender: TObject);

begin

{if (dir2.ItemIndex<>-1) then begin

dir2.Selected[dir2.ItemIndex]:=false;

dir1.Selected[dir1.ItemIndex]:=True;

end;}

end;

procedure TForm1.Dir2Enter(Sender: TObject);

begin

{if dir1.ItemIndex<>-1 then begin

dir1.Selected[dir1.ItemIndex]:=false;

dir2.Selected[dir2.ItemIndex]:=True;

end;}

end;

procedure TForm1.CBOnTopClick(Sender: TObject);

begin

if CBOnTop.Checked then form1.FormStyle:=fsStayOnTop

else form1.FormStyle:=fsNormal;

end;

end.

//Текст файла вставки записей

unit InsRec;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Db, DBTables, Mask, DBCtrls;

type

TInsertRec = class(TForm)

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Label6: TLabel;

DataSource1: TDataSource;

Table1: TTable;

DBEdit1: TDBEdit;

DBEdit2: TDBEdit;

DBEdit3: TDBEdit;

DBMemo1: TDBMemo;

DataSource2: TDataSource;

Table2: TTable;

DBLookupComboBox1: TDBLookupComboBox;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

InsertRec: TInsertRec;

implementation

uses Unit1,URazdel;

{$R *.DFM}

procedure TInsertRec.Button1Click(Sender: TObject);

Var Adres:String;

begin

if ((DBEdit1.Text<>'')and(DBLookupComboBox1.Text<>'')) then begin

try

table1.Active:=true;

table2.Active:=true;

table1.FieldByName('Название').asString:=DBedit1.Text;

table1.FieldByName('Автор').asString:=DBedit2.Text;

table1.FieldByName('Раздел').asString:=DBLookupComboBox1.Text;

table1.FieldByName('Описание').asString:=DBMemo1.Text;

table1.Post;

table1.Active:=false;

table2.Active:=false;

close;

except

beep;

ShowMessage('Возмлжно уже существует запись с такими полями.');

DBEdit1.Text:='';

DBEdit2.Text:='';

DBMemo1.Text:='';

end; end else begin

showmessage('Обязательный ввод "Название" и "Раздел"');

table1.cancel;

end;

end;

procedure TInsertRec.Button2Click(Sender: TObject);

begin

table1.cancel;

close;

end;

procedure TInsertRec.Button3Click(Sender: TObject);

begin

razdel.ShowModal;

end;

procedure TInsertRec.FormCreate(Sender: TObject);

begin

InsertRec.table1.dataBaseName:=extractFilePath(application.exeName)+'Base';

InsertRec.table2.dataBaseName:=extractFilePath(application.exeName)+'Base';

end;

end.

//Текст файла редактирования разделов

unit URazdel;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Grids, DBGrids, StdCtrls, Mask, DBCtrls, Db, DBTables;

type

TRazdel = class(TForm)

Table1: TTable;

DataSource1: TDataSource;

Button1: TButton;

Button2: TButton;

DBGrid1: TDBGrid;

Button3: TButton;

Edit1: TEdit;

procedure Button3Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Razdel: TRazdel;

implementation

{$R *.DFM}

procedure TRazdel.Button3Click(Sender: TObject);

begin

Close;

end;

procedure TRazdel.Button1Click(Sender: TObject);

begin

Razdel.table1.Active:=true;

Razdel.table1.Append;

Razdel.table1.FieldByName('Раздел').asString:=edit1.Text;

Razdel.table1.Refresh;

end;

procedure TRazdel.Button2Click(Sender: TObject);

begin

Razdel.table1.Delete;

end;

procedure TRazdel.FormActivate(Sender: TObject);

begin

if edit1.CanFocus then edit1.SetFocus;

end;

procedure TRazdel.FormCreate(Sender: TObject);

begin

Razdel.table1.dataBaseName:=extractFilePath(application.exeName)+'Base';

end;

end.

//Текст файла просмотра базы данных

unit UBase;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Menus, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, ComCtrls, Db,

DBTables, Buttons, shellApi, AppEvnts;

type

TFBase = class(TForm)

ScrollBox1: TScrollBox;

MainMenu1: TMainMenu;

MnFBTop: TMenuItem;

DBGrid1: TDBGrid;

DataSource1: TDataSource;

Table1: TTable;

DBMemo1: TDBMemo;

StatusBar1: TStatusBar;

ApplicationEvents1: TApplicationEvents;

ScrollBox2: TScrollBox;

RadioGroup1: TRadioGroup;

RadioGroup2: TRadioGroup;

GroupBox2: TGroupBox;

CheckBox1: TCheckBox;

Edit1: TEdit;

RadioGroup3: TRadioGroup;

DBNavigator5: TDBNavigator;

DBNavigator6: TDBNavigator;

BitBtn2: TBitBtn;

DBNavigator7: TDBNavigator;

DBNavigator8: TDBNavigator;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Label10: TLabel;

Label11: TLabel;

OnTop1: TMenuItem;

procedure FormActivate(Sender: TObject);

procedure RadioGroup2Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure Edit1Change(Sender: TObject);

procedure CheckBox1Click(Sender: TObject);

procedure RadioGroup3Click(Sender: TObject);

procedure RadioGroup1Click(Sender: TObject);

procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);

procedure FormCreate(Sender: TObject);

procedure FormKeyPress(Sender: TObject; var Key: Char);

procedure MnFBTopClick(Sender: TObject);

procedure OnTop1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FBase: TFBase;

implementation

{$R *.DFM}

procedure TFBase.FormActivate(Sender: TObject);

begin

table1.Active:=true;

table1.Refresh;

DBGrid1.Columns[4].Visible:=false;

RadioGroup3.ItemIndex:=0;

end;

procedure TFBase.RadioGroup2Click(Sender: TObject);

begin

case radioGroup2.ItemIndex of

0: Table1.IndexDefs[table1.IndexDefs.IndexOf(table1.indexName)].Options:=

Table1.IndexDefs[table1.IndexDefs.IndexOf(table1.indexName)].Options+[ixDescending];

1: Table1.IndexDefs[table1.IndexDefs.IndexOf(table1.indexName)].Options:=

Table1.IndexDefs[table1.IndexDefs.IndexOf(table1.indexName)].Options-[ixDescending];

end;

end;

procedure TFBase.BitBtn1Click(Sender: TObject);

begin

ShellExecute(fBase.Handle, nil, PChar(table1.fieldbyname('Адрес').asString), nil, nil, sw_ShowNormal);

end;

procedure TFBase.Edit1Change(Sender: TObject);

var strField:string;

begin

if not checkbox1.Checked then exit;

case radiogroup3.ItemIndex of

0: strField:='Название';

1: strField:='Раздел';

2: strField:='Автор';

end;

table1.Locate(strField, edit1.text, [loCaseInsensitive, loPartialKey]);

end;

procedure TFBase.CheckBox1Click(Sender: TObject);

begin

Edit1Change(sender);

end;

procedure TFBase.RadioGroup3Click(Sender: TObject);

begin

Edit1Change(sender);

end;

procedure TFBase.RadioGroup1Click(Sender: TObject);

begin

case radioGroup1.ItemIndex of

0: table1.IndexName:='indNazv';

1: table1.IndexName:='indRaz';

else table1.IndexName:='';

end;

radiogroup2.OnClick(sender);

end;

procedure TFBase.ApplicationEvents1Idle(Sender: TObject;

var Done: Boolean);

begin

if radioGroup1.ItemIndex=-1 then radioGroup2.Enabled:=false else radioGroup2.Enabled:=True;

end;

procedure TFBase.FormCreate(Sender: TObject);

begin

FBase.KeyPreview := True;

Fbase.table1.dataBaseName:=extractFilePath(application.exeName)+'Base';

end;

procedure TFBase.FormKeyPress(Sender: TObject; var Key: Char);

begin

if key = #27 then Close;

end;

procedure TFBase.MnFBTopClick(Sender: TObject);

begin

MnFBTop.Checked:= not MnFBTop.Checked;

if MnFBTop.Checked then begin

fBase.FormStyle:=fsStayOnTop;

fBase.Caption:='Всегда наверху'end

else begin

fBase.FormStyle:=fsnormal;

fBase.Caption:='Base';

end;

end;

procedure TFBase.OnTop1Click(Sender: TObject);

begin

close;

end;

end.

//Текст файла дополнительного модуля

unit Modulepas;

interface

uses SysUtils, Windows, Classes, Consts;

type

EInvalidDest = class(EStreamError);

EFCantMove = class(EStreamError);

procedure CopyFile(const FileName, DestName: string);

procedure MoveFile(const FileName, DestName: string);

function GetFileSize(const FileName: string): LongInt;

function FileDateTime(const FileName: string): TDateTime;

function HasAttr(const FileName: string; Attr: Word): Boolean;

function ExecuteFile(const FileName, Params, DefaultDir: string;

ShowCmd: Integer): THandle;

implementation

uses Forms, ShellAPI;

const

SInvalidDest = 'Destination %s does not exist';

SFCantMove = 'Cannot move file %s';

procedure CopyFile(const FileName, DestName: string);

var

CopyBuffer: Pointer; { buffer for copying }

BytesCopied: Longint;

Source, Dest: Integer; { handles }

Len: Integer;

Destination: TFileName; { holder for expanded destination name }

const

ChunkSize: Longint = 8192; { copy in 8K chunks }

begin

Destination := ExpandFileName(DestName); { expand the destination path }

if HasAttr(Destination, faDirectory) then { if destination is a directory... }

begin

Len := Length(Destination);

if Destination[Len] = '\' then

Destination := Destination + ExtractFileName(FileName) { ...clone file name }

else

Destination := Destination + '\' + ExtractFileName(FileName); { ...clone file name }

end;

GetMem(CopyBuffer, ChunkSize); { allocate the buffer }

try

Source := FileOpen(FileName, fmShareDenyWrite); { open source file }

if Source < 0 then raise EFOpenError.CreateFmt(SFOpenError, [FileName]);

try

Dest := FileCreate(Destination); { create output file; overwrite existing }

if Dest < 0 then raise EFCreateError.CreateFmt(SFCreateError, [Destination]);

try

repeat

BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }

if BytesCopied > 0 then { if we read anything... }

FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }

until BytesCopied < ChunkSize; { until we run out of chunks }

finally

FileClose(Dest); { close the destination file }

end;

finally

FileClose(Source); { close the source file }

end;

finally

FreeMem(CopyBuffer, ChunkSize); { free the buffer }

end;

end;

{ MoveFile procedure }

{ Moves the file passed in FileName to the directory specified in DestDir.

Tries to just rename the file. If that fails, try to copy the file and

delete the original.