Программно создаем Alias 2


procedure CreateAlias();  
const  
DlPs = 5;  
var  
wrstr, wrstr1 :string;  
AParams: TStringList;  
Psevdonm: array [1..DlPs] of string;  
i: integer;  
begin  
//Заполним массив  
Psevdonm[1] := ′TERMNNSI,NSI′; // имя,каталог  
Psevdonm[2] := ′TERMNBASE,BASE′;  
Psevdonm[3] := ′TERMNTNL,BASETNL′;  
Psevdonm[4] := ′TERMNARH,ARH′;  
Psevdonm[5] := ′TERMNTELE,TELE′;  
// if not DirectoryExists(datapath) then begin  
// createdir(datapath) ;  
// end;  
for i := 1 to DlPs do  
begin  
// Для начала проверим каталоги  
wrstr1 := Copy(Psevdonm,Pos(′,′,Psevdonm)+1, Length(Psevdonm)-Pos(′,′,Psevdonm)+1);  
if not DirectoryExists(wrstr1) then  
begin  
CreateDirectory(PChar(CurrntDir+′′+wrstr1),nil);  
end;  
  
// Если нет псевдонима, то создадим или подправим  
wrstr := Copy(Psevdonm,1,Pos(′,′,Psevdonm)-1);  
if not Session.IsAlias(wrstr) then  
begin  
try  
Session.AddStandardAlias(wrstr,wrstr1,′PARADOX′);  
Session.SaveConfigFile;  
except  
SaveTekJrn(′ERR:Ошибка создания алиаса - ′+wrstr);  
Exit;  
end;  
end;  
//Настроим алиас  
AParams := TStringList.Create;  
AParams.Add(′PATH=′ + CurrntDir+′′+wrstr1);  
Session.ModifyAlias(wrstr,AParams);  
Session.SaveConfigFile;  
// Освобождение списка  
AParams.Free;  
end;  
end;   

Добавлено: 30 Июля 2018 20:20:33 Добавил: Андрей Ковальчук

Получаем информацию о псевдонимах BDE


var  
MyAliasPath: string;  
const  
AliasName = ′MyAlias′;  
  
{**** Получаем из BDE путь MyAlias}  
  
ParamsList := TStringList.Create;  
  
try  
with Session do  
begin  
Session.GetAliasNames(ParamsList);  
Session.GetAliasParams(AliasName, ParamsList);  
MyAliasPath := Copy(ParamsList[0], 6, 50) + ′′;  
end;  
finally  
ParamsList.Free;  
end;   

Добавлено: 30 Июля 2018 20:19:53 Добавил: Андрей Ковальчук

Обоснование необходимости хранилища данных

Рассмотрим основные причины, вынуждающие предприятия реализовывать технологию Хранилищ данных. В литературе эти причины очень часто путают с "вторичными преимуществами", которые дает эта технология. В рекламных проспектах, посвященных Хранилищам обязательно найдется фраза о том, что они используются для "преобразования данных для бизнес-анализа", "помогают в принятии решений на основе фактов, а не интуиции", "дают возможность поближе узнать клиента" и, конечно, везде вставляется фраза о достижении "конкурентных преимуществ". Но в 99% случаев Хранилища данных - только первый шаг в осуществлении всех этих далеко идущих целей.

А теперь перечислим, для чего компании может понадобиться Хранилище:

Для выполнения серверных/дисковых задач, связанных с созданием запросов и отчетов на серверах/дисках, не используемых в системах обработки транзакций (oltp - online transaction processing)

Большинство фирм стремятся настроить системы обработки транзакций так, чтобы все операции выполнялись за приемлемое время. Например, отчеты и запросы, требующие гораздо большего объема ограниченных ресурсов, чем обработка транзакций, тем не менее выполняются на серверах/дисках, а поэтому мешают своевременному выполнению транзакций. Или же для выполнения запросов и отчетов используются серверы/диски, отводимые под системы обработки транзакций - в этом случае может осложниться управление ресурсами, а желаемое время ответа на запрос вряд ли будет получено. В связи с этим рекомендуется реализовывать архитектуру Хранилища данных, использующую отдельные серверы/диски для создания запросов/отчетов, что позволит добиться приемлемого времени обработки транзакций и будет разумно и с финансовой и с организационной точки зрения.

Для использования моделей данных и/или серверных технологий, ускоряющих создание запросов и отчетов, но не предназначенных для обработки транзакций
Существуют методы моделирования данных, существенно сокращающие время выполнения запросов и отчетов (например схема "звезда"), но не предназначенные для обработки транзакций, так как лежащие в их основе технологии замедляют и усложняют oltp-процессы. Кроме того, некоторые серверные технологии хотя и повышают эффективность обработки запросов и отчетов, но замедляют обработку транзакций (например битовое индексирование - bit-mapped indexing), и наоборот (например восстановление транзакций). Причем влияние того или иного метода моделирования или серверной технологии меняется от поставщика к поставщику, а также в зависимости от того, в какой ситуации они применяются.

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

Для создания репозитория "очищенных" данных системы обработки транзакций и последующего получения отчетов из этих данных без изменения самой oltp-cистемы.

Типы ошибок, которые нужно устранить для "очистки" данных описаны в небольшой статье "Неформальная систематика ошибок в хранилище данных" (an informal taxonomy of data warehouse data errors). Хранилище дает возможность очистки данных без изменения систем обработки транзакций. Тем не менее, стоит обратить внимание на то, что в некоторых реализациях этой технологии предусмотрена возможность фиксировать исправления и затем переносить их обратно в oltp-системы. Иногда такой способ исправления ошибок удобнее, чем непосредственные изменения в системе обработки транзакций.

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

Долгое время для составления отчетов по данным из нескольких систем организации были вынуждены писать специальные процедуры извлечения данных и выполнять операции сортировки и объединения, а затем уже составлять отчеты по отсортированным (и/или объединенным) выборкам данных. Во многих случаях эта стратегия вполне адекватна. Но если организация хранит большой объем данных, требующих частой сортировки (объединения), а также "очистки", то лучше всего реализовать Хранилище.

Для создания репозитория данных oltp-системы, содержащего долговременную информацию, хранение которой в системе обработки транзакций не эффективно. Либо для генерации отчетов, отражающих ситуацию в предыдущие периоды
Чтобы не замедлять выполнение операций, старые данные часто удаляются из систем обработки транзакций. Однако для отчетности и составления запросов есть смысл держать эту информацию в Хранилище, где время отклика не так критично. Что касается отчетов по прошлым периодам, то их создание часто затруднено, а то и вовсе невозможно. Пусть, например, нужно получить информацию о зарплате сотрудников третьего разряда согласно сетке оплаты труда на начало каждого месяца 1997 года. Это оказывается невыполнимым, поскольку в базе данных хранятся записи только о текущем разряде сотрудников. Для решения подобного рода проблем удобно воспользоваться Хранилищем данных, поддерживается так называемое "медленно изменяющееся измерение".

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

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

В заключении повторим сказанное выше. Для того чтобы реализовать возможности business intelligence, а также получить более подробную информацию о клиентах и иметь хорошие "конкурентные преимущества", организации не достаточно просто разработать Хранилище данных. Необходимо решить (как правило методом проб и ошибок) не менее сложную задачу об оптимальном использовании Хранилища и последующем изменении практики деловых отношений.

Добавлено: 30 Июля 2018 20:19:07 Добавил: Андрей Ковальчук

Новый псевдоним на лету


type  
TDataMod = class(TDataModule)  
Database: TDatabase;  
public  
procedure TempAlias(NewAlias, NewDir: string);  
end;  
  
procedure TDataMod.TempAlias(NewAlias, NewDir: string);  
begin  
with Session do  
if not IsAlias(NewAlias) then  
begin  
ConfigMode := cmSession; (* NewAlias будет ВРЕМЕННЫМ *)  
try  
AddStandardAlias(NewAlias, NewDir, ′PARADOX′);  
Database.Close;  
Database.AliasName := NewAlias;  
Database.Open;  
finally  
ConfigMode := cmAll;  
end;  
end;  
end;   

Добавлено: 30 Июля 2018 20:18:29 Добавил: Андрей Ковальчук

Моя собственная база данных

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

Постановка задачи: Допустим, мне нужно в приложении Delphi сохранять некоторую информацию на диск. Мне не охото работать с текстовыми файлами, так как просмотр и обновление информации в них довольно муторное занятие. Преобладать будут операции записи и чтения, в то время как операции изменения и апдейта будут присутствовать в меньшей степени. Вся информация будет хранится в переопределённом типе данных Pascal Record. Итак, какой подход мне лучше всего использовать?

BDE плюс Paradox или Access, ... спасибо, не надо...Не хотелось бы испытывать мороку с BDE. Использовать текстовые файлы ASCII ? Не пойдёт. Нужна хоть какая-то минимальная защита, а текстовые файлы "полностью видимы". Оказывается, ответ на данный вопрос кроется в Delphi, а именно в непечатных файлах (или файлы некоторых типов/бинарные файлы).

Файлы
В Delphi существует три класса файлов: typed, text, и untyped. Файлы typed - это файлы, которые содержат данные определённого типа, такие как Double, Integer или предварительно определённый тип Record. Текстовые файлы содержат читаемые символы ASCII. Файлы Untyped используются в том случае, если мы хотим работать с файлом через определённую структуру.

Файлы Typed
В отличие от тектовых файлов, которые содержат строки, завершающиеся комбинацией CR/LF, файлы typed содержат данные, взятые из определённой структуры данных.

Например, следующее объявление создаёт запись с именем TMember и массив переменных типа TMember, который мы будем использовать для хранения нашей информации.


type  
  TMember = record  
    Name : string[50];  
    eMail : string[30];  
    Posts : LongInt;  
  end;  
    
 var Members : array[1..50] of TMember;

Перед тем, как мы сможем записать информацию на диск, нам необходимо объявить переменную типа file. Следующая строка объявляет переменную файла F:


var F : file of TMember;   

Обратите внимание: Чтобы создать файл typed в Delphi, мы используем следующий синтакс:
var SomeTypedFile : file of SomeType
Базовый тип (SomeType) для файла может быть скалярным (наподобие Double), массивом или записью. Он не может быть длинной строкой, динамическим массивом, классом, объектом или указателем.

Чтобы начать работать с файлом из Delphi нам надо связать файл на диске с переменной файла в нашей программе. Для этого используем процедуру AssignFile.


AssignFile(F, 'Members.dat')  

Как только связь с внешним файлом установлена, переменную F необходимо 'открыть' для подготовки её к чтению или записи. Для открытия существующего файла мы используем процедуру Reset либо Rewrite для создания нового файла. После того, как программа закончит обработку файла, его необходимо закрыть при помощи процедуры CloseFile. Сразу после закрытия файла, связанный с ним внешний файл будет обновлён. Затем переменную файла можно связать с другим внешним файлом. Вообще, мы должны всегда производить обработку исключительных ситуаций, так как при работе с файлами может происходить довольно много ошибок. Например, если мы вызовем CloseFile для файла, который уже закрыт, то Delphi выдаст ошибку I/O. С другой стороны, если мы попробуем закрыть файл, до вызова AssignFile, то результаты могут быть непредсказуемыми.

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


 var F : file of TMember;  
begin  
 AssignFile(F,'members.dat');  
 Rewrite(F);  
 try  
  for i:= 1 to 50 do  
   Write (F, Members[i]);  
 finally  
  CloseFile(F);  
 end;  
end;  

Чтение
Для получения всей информации из файла 'members.dat' используется следующий код:


 var Member: TMember  
     F : file of TMember;  
begin  
 AssignFile(F,'members.dat');  
 Reset(F);  
 try  
  while not Eof(F) do begin  
   Read (F, Member);  
 {  Что-нибудь делаем с данными; }  
  end;  
 finally  
  CloseFile(F);  
 end;  
end;   

Обратите внимание: Eof это функция проверки конца файла (EndOfFile). Мы используем эту функцию, чтобы не выйти за пределы файла (за пределы последней, сохранённой записи).

Поиск и позиционирование
Обычно, доступ к файлам осуществляется последовательно. При чтении из файла (используя стандартную процедуру Read) или при записи (используя стандартную процедуру Write), текущая позиция в файле перемещается на следующий по порядку компонент (следующая запись). К файлам typed так же можно обращаться через стандартную процедуру Seek, которая перемещает текущую позицию в файле на указанный компонент. Для определения текущей позиции в файле и размера файла можно использовать функции FilePos и FileSize.


{устанавливаем на начало -  на первую запись}  
Seek(F, 0);  
  
{устанавливаем на 5-ю запись}  
Seek(F, 5);  
  
{Переходим в конец - "после" последней записи}  
Seek(F, FileSize(F));   

Изменение и обновление
Мы разобрались как записывать и считывать из файла массив Members. А что, если нам нужно найти десятую запись и изменить в ней e-mail? Давайте посмотрим на процедуру, которая делает это:


procedure ChangeEMail  
  (const RecN : integer; const NewEMail : string);  
var DummyMember : TMember;  
begin  
 {связывание, открытие, блок обработки исключений}  
 Seek(F, RecN);  
 Read(F, DummyMember);  
 DummyMember.Email := NewEMail;  
 {чтение перемещается на следующую запись, для этого необходимо 
 вернуться на первоначальную запись, а затем записать}  
 Seek(F, RecN);  
 Write(F, DummyMember);  
 {закрываем файл}  
end;   

Всё готово
Итак, теперь мы имеем всё, что нам нужно для реализации нашей задачи. Мы можем записать информацию на диск, считать её, и даже изменить некоторые данные (например, e-mail) в "середине" файла.

Добавлено: 30 Июля 2018 20:16:47 Добавил: Андрей Ковальчук

Моментальный поиск

Поиск одного поля с помощью SQL запроса или фильтра, просто ужасно глупая затея. Этот поиск будет проходить очень долго. Есть способ лучше - Рондо. Точнее сказать поиск по ключевым полям. Этот поиск происходит практически моментально, даже на больших базах данных. Недостатки - отсутствие шаблонов, не возможно использовать привязанную таблицу.

За счёт чего достигается такая скорость поиска? Всё очень просто, за счёт индексации. Так можно искать только по индексированным полям. Ну, хватит лишних слов, давай переходить к делу.

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

В качестве основы я взял только одну таблицу - User1.db. Как я уже говорил, для быстрого поиска нужно, чтобы поле было проиндексировано, поэтому добавь ещё один вторичный индекс для поля LastName. Теперь у TTable, к которой привязан у тебя User1.db (у меня это Table2), свойство IndexFieldName измени на LastName . Всё таблица готова к употреблению. Если ты корректируешь пример из предыдущей статьи, то на форме у тебя должно быть несколько сеток таблиц (TDBGrid), и в них ты можешь сразу заметить, что у тебя нарушилась связь. Это из-за того, что ты сменил индекс (я уже говорил об этом недостатке в начале статьи). Но у тебя совсем пропали из виду данные таблицы User1.db. Чтобы они снова стали видны, дважды щёлкни по полю MasterFields и в появившемся окне нажми Clear .

На рисунке 1 показана форма, которую я буду использовать. Как ты можешь увидеть, нам нужны только кнопка, поле ввода и сетка для таблицы User1.db. Всё остальное я убрал, чтобы не мешалось на глазах. Теперь заканчиваем с болтовнёй и пишем код на событие OnClick для кнопки.


procedure TForm1.Button1Click(Sender: TObject);  
begin  
 DataModule2.Table2.SetKey;  
 DataModule2.Table2LastName.AsString:=Edit1.Text;  
 DataModule2.Table2.GotoKey;  
end;  

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

Всё время мы создавали одиночные вторичные ключи (состоящие из одного поля), но ты можешь с помощью DatabaseDesktop создавать ключи состоящие из любого количества полей. Для этого в DatabaseDesktop , в выпадающем списке Table properties нужно выбрать Secondary Indexes и нажать кнопку Define . Теперь выбери любое поле, и перемести его в список Indexed fields , затем другое поле и снова перемести его в список Indexed fields . И так хоть все поля.

Если у тебя установлен ключ из нескольких полей, то ты должен между вызовами SetKey; и GotoKey установить все ключи. Иначе результат может быть ошибкой.

Есть ещё одна процедура, с которой я хочу тебя познакомить - GotoNearest . Если GotoKey не находит нужного ключа, то генерируется ошибка. GotoNearest тоже производит поиск ключевого поля, но если поле не найдено, то ошибка не генерируется, а ищется ближайший похожий ключ.

Вот мы и покончили с ключевыми полями, но у нас ещё впереди много интересного, так что увидимся в следующем номере.

Добавлено: 30 Июля 2018 20:15:47 Добавил: Андрей Ковальчук

Многопоточный доступ к базам данных

По этой теме очень мало информации, особенно в части, касающейся доступа к SQL-серверам (например IB). Мне пришлось несколько дней активно заниматься всем этим – не нашел достойной замены для VirtualTree и решил заполнять дерево с помощью потока. Отмечу, что мои ранние попытки использовать потоки для обращения к Interbase не увенчались успехом, да и дискуссии по теме на форуме epsylon.public.interbase не особо вдохновляли. Жизнь заставила пересмотреть подходы к проблеме и вот что получилось.

Как известно, запрос в потоке должен выполняться в отдельном контексте, т.е. поток должен иметь как минимум IBDataset, IBTransaction и IBSQL. Можно использовать IBDataBase.InternalTransaction, но лучше таки создать в потоке отдельный IBTransaction.

Рассмотрим процесс создания потока, способного обеспечить требуемые условия – создадим базовый класс и затем породим от него поток, способный, например, подсчитать количество записей в запросе.


    unit basedbtr;  
    interface  
      uses Windows,Classes, Messages,IBDatabase,IBSQL;  
    const  
    {Идентификаторы сообщений, используемых для передачи информации форме, создавшей поток}  
      WM_THREAD_TEXT=WM_USER+1000;  
      WM_THREAD_INTEGER=WM_THREAD_TEXT+1;  
    type  
      TBaseDB_Thread = class(TThread)  
        private  
          {Локальные поля, хранящие информацию об окне владельца потока}  
          fCurForm:HWND;  
          {SQL текст}  
          fNewSqlText:string;  
          {Флаг нового запроса}  
          fSetNewQuery:boolean;  
          {Далее три компоненты, обеспечивающие наличие собственного контекста потока}  
          Base:TIBdatabase;  
          trWrite:TIbTransaction;  
          ThreadSql:TIBSQL;  
          {Процедуры для передачи информации владельцу потока}  
          procedure Post_Text(MsgData:string);  
          procedure Post_Integer(MsgData:integer);  
        protected  
          {Метод Execute пока ничего, кроме как перехода в состояние Suspend, не умеет}  
          procedure Execute; override;  
        public  
          property CurForm:HWND read fCurForm write fCurForm;  
          property NewSqlText:string read fNewSqlText write fNewSqlText;  
          property SetNewQuery:boolean read fSetNewQuery write fSetNewQuery;  
        constructor Create(OwnerHWND:HWND; //Дескриптор окна-родителя потока         aBaseName:String; //DatabaseName  
            aBaseParams:TStrings; //Информация для IBDatabase.Params  
            TransParams:TStrings); //Информация для IBTransactin.Params  
        destructor Destroy; override;  
      end;   
  
    {Породим от базового потока новый поток с требуемой функциональностью, которая реализуется в методе Execute}  
    TGetRecordCount_Thread = class(TBaseDB_Thread)  
      protected  
        procedure Execute; override;  
    end;   
  
    {Глобальная переменная, хранящая текст для передачи окну-владельцу}  
      var MsgText:string;  
    implementation   
  
    constructor TBaseDB_Thread.Create;  
    begin  
      fCurForm:=OwnerHWND;  
      NewSqlText:='';  
      FreeOnTerminate :=False;  
      base:=TIBdatabase.Create(nil);  
      Base.DatabaseName:=aBaseName;  
      Base.LoginPrompt:=false;  
      Base.Params.Assign(aBaseParams);  
      trWrite:=TIBTransaction.Create(nil);  
      trWrite.DefaultDatabase:=Base;  
      trWrite.Params.Assign(TransParams);  
      ThreadSql:=TIBSQL.Create(nil);  
      ThreadSql.SQL.Text:='';  
      ThreadSql.Transaction:=trWrite;  
      Base.Connected:=true;  
      inherited Create(true); {true - переведем поток в состояние Suspended}  
    end;  
  
    destructor TBaseDB_Thread.Destroy;  
    begin  
      {Остановим поток}  
      if not Suspended then Suspend;  
      fNewSqlText:='';  
      fSetNewQuery:=false;  
      Terminate;  
      Resume;  
      WaitFor;  
      ThreadSql.Free;  
      trWrite.Free;  
      Base.Free;  
      inherited Destroy;  
    end;   
  
    {Ниже процедуры для передачи информации владельцу}  
    procedure TBaseDB_Thread.Post_Text(MsgData:string);  
    begin  
      MsgText:=msgData;  
      PostMessage(CurForm,WM_THREAD_TEXT,0,Integer(PChar(MsgText)));  
    end;  
  
    procedure TBaseDB_Thread.Post_Integer(MsgData:integer);  
    begin  
      PostMessage(CurForm,WM_THREAD_INTEGER,0,MsgData);  
    end;   
  
    {"Пустой" метод базового класса}  
    procedure TBaseDB_Thread.Execute;  
    begin  
      while not Terminated do  
        suspend;  
    end;   
  
    {Здесь Execute наследника}  
    procedure TGetRecordCount_Thread.Execute;  
      begin  
        while not Terminated do begin  
          {Если установлен флаг нового запроса}  
          if fSetNewQuery then  
            begin  
              {Сбросим флаг}  
              fSetNewQuery:=false;  
              {Сообщим владельцу о начале работы потока }  
              Post_text('Resume');  
              try  
                if not trWrite.InTransaction then trWrite.StartTransaction;  
                ThreadSql.Sql.Text:=NewSqlText;  
                ThreadSql.ExecQuery;  
                {Сообщим владельцу результат}  
                Post_Integer(ThreadSql.Fields[0].AsInteger);  
                trWrite.Commit;  
                ThreadSql.Close;  
              except  
                raise;  
                Post_Text('Error');  
              end;  
            end;  
          {Если в процессе выполнения не установлен флаг нового запроса, то остановимся в этой точке}  
          if not Terminated and not SetNewQuery then begin  
            {Вначале сообщим владельцу}  
            Post_Text('Suspend');  
            suspend;  
          end;  
        end;  
      end;  
    end.   
      
procedure TForm1.IBQuery1AfterOpen(DataSet: TDataSet);  
begin  
  if Trs.Suspended  
    then SetTrsData  
    else Timer1.Enabled:=true;  
end;   

Событие должно вызвать метод потока Resume для выполнения запроса о количестве записей. Но мы не знаем, стоит ли это делать, может прежний запрос касается миллионов записей и выражение WHERE столь сложен, чтоб его выполнить за секунды. Проверим состояние потока – если он Suspended, то можно сходу инициализировать поток новыми параметрами и запустить его, иначе – воспользуемся таймером Timer1.


procedure TForm1.Timer1Timer(Sender: TObject);  
begin  
  if Trs.Suspended then begin  
    Timer1.Enabled:=false;  
    SetTrsData;  
  end;  
end;   
Здесь процедура рестарта потока


procedure TForm1.SetTrsData;  
begin  
  Trs.NewSqlText:=Memo2.Lines.Text;  
  Trs.SetNewQuery:=true;  
  Trs.Resume;  
end;   

Перед тем, как переоткрыть запрос для Grid, остановим таймер – вдруг он сработает и нарушит порядок


procedure TForm1.IBQuery1BeforeOpen(DataSet: TDataSet);  
begin  
  Timer1.Enabled:=false;  
end; 

Вот и все. Данный пример показывает, как создавать поток для использования его в качестве дополнительного инструмента как для мелких «поручений» типа рассмотренного выше, так и для исполнения тяжелых процедур, связанных с изменениями (INSERT or UPDATE), способных ввести основной поток приложения в ступор.

Предположим, что необходимо заполнять TREE данными из запроса.


TMySql_Thread = class(TBaseDB_Thread)  
  Private  
    {Это флаг актуальности данных}  
    FActual:boolean;  
    {Набор параметров для IBSQL}  
    FParam1:integer;  
    FParam2:integer;  
  protected  
    procedure Execute; override;  
  public  
    property Actual:boolean read fActual write fActual;  
    property Param1:integer read fParam1 write fParam1;  
    property Param2:integer read fParam2 write fParam2;  
  end;  
  
procedure TMySql_Thread.Execute;  
begin  
  while not Terminated do begin  
    {Если установлен флаг нового запроса}  
    if fSetNewQuery then  
      begin  
      {Сбросим флаг}  
      fSetNewQuery:=false;  
      fActual:=true;  
      {Сообщим владельцу о начале работы потока }  
      Post_text('Resume');  
      try  
        if not trWrite.InTransaction then trWrite.StartTransaction;  
        ThreadSql.Sql.Text:=NewSqlText;  
        ThreadSql.Params[0].asInteger:=fParam1;  
        ThreadSql.Params[1].asInteger:=fParam2;  
        ThreadSql.ExecQuery;  
        {Здесь цикл вставки данных в Tree, причем анализируются Terminated и флаг актуальности потока}  
        While not Terminated and fActual and not ThreadSql.Eof do  
          Begin  
            {Вызываем процедуру вставки}  
            Synchronize(AddToList);  
            ThreadSql.Next;  
          End;  
        trWrite.Commit;  
        ThreadSql.Close;  
      except  
        raise;  
        Post_Text('Error');  
      end;  
      end;  
    {Если в процессе выполнения не установлен флаг нового запроса, то остановимся в этой точке}  
    if not Terminated and not SetNewQuery then begin  
      {Вначале сообщим владельцу}  
      Post_Text('Suspend');  
      suspend;  
    end;  
  end;  
end;   

Добавлено: 30 Июля 2018 20:15:10 Добавил: Андрей Ковальчук

Как узнать расположение локальной БД по ее Alias


uses  
DbiProcs;  
  
function GetDirByDatabase(Database: TDatabase): string;  
var  
pszDir: PChar;  
begin  
pszDir := StrAlloc(255);  
try  
DbiGetDirectory(Database.Handle, True, pszDir);  
Result := StrPas(pszDir);  
finally  
StrDispose(pszDir);  
end;  
end;   

Добавлено: 30 Июля 2018 20:13:26 Добавил: Андрей Ковальчук

Как создать SystemDSN


const  
ODBC_ADD_DSN = 1; // Добавляем источник данных  
ODBC_CONFIG_DSN = 2; // Конфигурируем (редактируем) источник данных  
ODBC_REMOVE_DSN = 3; // Удаляем источник данных  
ODBC_ADD_SYS_DSN = 4; // Добавляем системный DSN  
ODBC_CONFIG_SYS_DSN = 5; // Конфигурируем системный DSN  
ODBC_REMOVE_SYS_DSN = 6; // удаляем системный DSN  
  
type  
TSQLConfigDataSource = function( hwndParent: HWND; fRequest: WORD;  
lpszDriver: LPCSTR; lpszAttributes: LPCSTR ) : BOOL; stdcall;  
  
procedure Form1.FormCreate(Sender: TObject);  
var  
pFn: TSQLConfigDataSource;  
hLib: LongWord;  
strDriver: string;  
strHome: string;  
strAttr: string;  
strFile: string;  
fResult: BOOL;  
ModName: array[0..MAX_PATH] of Char;  
srInfo : TSearchRec;  
begin  
Windows.GetModuleFileName( HInstance, ModName, SizeOf(ModName) );  
strHome := ModName;  
while ( strHome[length(strHome)] <> ′′ ) do  
Delete( strHome, length(strHome), 1 );  
// Тестовая база данных (Axes = Access)  
strFile := strHome + ′TestData.MDB′;  
// загружаем библиотеку (путь по умолчанию)  
hLib := LoadLibrary( ′ODBCCP32′ );  
if( hLib <> NULL ) then  
begin  
@pFn := GetProcAddress( hLib, ′SQLConfigDataSource′ );  
if( @pFn <> nil ) then  
begin  
// начинаем создание DSN  
strDriver := ′Microsoft Access Driver (*.mdb)′;  
strAttr := Format( ′DSN=TestDSN′ + #0 + ′DBQ=%s′ + #0 +  
′Exclusive=1′ + #0 + ′Description=Test Data′ + #0 + #0, [strFile] );  
fResult := pFn( 0, ODBC_ADD_SYS_DSN, @strDriver[1], @strAttr[1] );  
if( fResult = false ) then  
ShowMessage( ′Ошибка создания DSN (Datasource) !′ );  
  
// test/create MDB file associated with DSN  
if( FindFirst( strFile, 0, srInfo ) <> 0 ) then  
begin  
strDriver := ′Microsoft Access Driver (*.mdb)′;  
strAttr := Format( ′DSN=TestDSN′+#0+ ′DBQ=%s′+#0+ ′Exclusive=1′+#0+  
′Description=Test Data′+#0+ ′CREATE_DB="%s"′#0+#0, [strFile,strFile] );  
fResult := pFn( 0, ODBC_ADD_SYS_DSN, @strDriver[1], @strAttr[1] );  
if( fResult = false ) then  
ShowMessage( ′Ошибка создания MDB (файла базы данных) !′ );  
end;  
FindClose( srInfo );  
end;  
FreeLibrary( hLib );  
end  
else  
ShowMessage( ′Невозможно загрузить ODBCCP32.DLL′ );  
end;   

Добавлено: 30 Июля 2018 20:12:54 Добавил: Андрей Ковальчук

Как получить путь псевдонима и таблицы


function GetDBPath1(AliasName: string): TFileName;  
var  
ParamList: TStringList;  
begin  
ParamList := TStringList.Create;  
with Session do  
try  
GetAliasParams(AliasName, ParamList);  
Result := UpperCase(ParamList.Values[′PATH′]) + ′′;  
finally  
Paramlist.Free;  
end;  
end;  
  
function GetDBPath2(AliasName: string): TFileName;  
var  
ParamList: TStringList;  
i: integer;  
begin  
ParamList := TStringList.Create;  
with Session do  
try  
try  
GetAliasParams(AliasName, ParamList);  
except  
for i := 0 to pred(DatabaseCount) do  
if (Databases.DatabaseName = AliasName) then  
ParamList.Assign(Databases.Params);  
end;  
Result := UpperCase(ParamList.Values[′PATH′]) + ′′;  
finally  
Paramlist.Free;  
end;  
end;  
  
function GetDBPath3(ATable: TTable): TFileName;  
var  
TblProps: CURProps;  
pTblName, pFullName: DBITblName;  
begin  
with ATable do  
begin  
AnsiToNative(Locale, TableName, pTblName, 255);  
Check(DBIGetCursorProps(Handle, TblProps));  
Check(DBIFormFullName(DBHandle,  
pTblName,  
TblProps.szTableType,  
pFullName));  
Result := ExtractFilePath(StrPas(pFullName));  
end;  
end;   

Добавлено: 30 Июля 2018 20:11:17 Добавил: Андрей Ковальчук

Как получить путь псевдонима и таблицы 4


uses DbiProcs;  
  
function GetDirByDatabase( Database: TDatabase ): string;  
var  
pszDir: PChar;  
begin  
pszDir := StrAlloc( 255 );  
try  
DbiGetDirectory( Database.Handle, True, pszDir );  
Result := StrPas( pszDir );  
finally  
StrDispose( pszDir );  
end;  
end;   

Добавлено: 30 Июля 2018 20:10:46 Добавил: Андрей Ковальчук

Как получить путь псевдонима и таблицы 3


uses db;  
  
var  
aliaspath: string[128];  
begin  
aliaspath := Session.GetAliasParams[′MyAlias′].values[′PATH′];  
end;  
  
uses SysUtils,DbiProcs, DBiTypes;  
...  
  
function GetDataBaseDir(const Alias : string): String;  
(* Возвращает каталог базы данных, на которую 
ссылается псевдним (без конечного обратного слеша) *)  
var  
sp: PChar;  
Res: pDBDesc;  
begin  
try  
New(Res);  
sp := StrAlloc(length(Alias)+1);  
StrPCopy(sp,Alias);  
if DbiGetDatabaseDesc(sp,Res) = 0 then  
Result := StrPas(Res^.szPhyName)  
else  
Result := ′′;  
finally  
StrDispose(sp);  
Dispose(Res);  
end;  
end;   

Добавлено: 30 Июля 2018 20:10:19 Добавил: Андрей Ковальчук