Чудеса TStringList. Почему надо использовать объекты TStringList везде

Object Pascal в сочетании с ассемблером в современной его форме Delphi 5/6/7 предоставляет неограниченные возможности для полета мысли программиста, и этой статьей мы откроем серию, в которой последовательно будем это демонстрировать.

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

Для начала в двух словах, какие такие замечательные свойства есть у объектов данного класса. TStringList - это класс, предназначенный для хранения списка строк и списка объектов с текстовым представлением (прямо как в 1С - это СписокЗначений). Кроме того, этот список может быть отсортирован по алфавиту или при помощи сравнительной функции, написанной программистом. Кроме того, этот список может быть интерпретирован как список значений (Name=string). Кроме того, этот список может быть сохранен в файл или поток, преобразован в непрерывную строку или строку, разделенную запятыми. Физически получаемая строка или поток представляет собой обычный текст, в котором строки разделены символами CR/LF (стандартный Windows Text File), или запятыми (CommaText, Excel). Ну и само собой, есть возможность загружать список строк из файла, потока, строки и строки, разделенной запятыми. Следует особо отметить замечательное свойство упаковки в строку, разделенную запятыми: при обратной распаковке строки всегда восстанавливаются в их исходном виде. Это означает, что допустима многократная вложенность строк, разделенных запятыми, дающая огромный выигрыш при упаковке/распаковке многомерных структурных данных в текстовый формат, что мы и продемонстрируем во второй задаче.

Итак, для начала рассмотрим список строк как список объектов с текстовым представлением, т. к. именно в данном ключе следует использовать список строк в реальных приложениях. Что из себя представляет объект с текстовым представлением? Это может быть, например, список товаров, имеющих помимо наименования еще и дополнительные параметры типа единицы измерения, количества в упаковке и цены. Итак, имеем предопределение типов:


type   
  TEdIzm=class  
    public  
      Name:string;  
      Weight:double;  
    end;  
  TTovar=class  
    public  
      Name:string; //наименование  
      EdIzm:TEdIzm; //ед. изм.  
      CountUp:integer; //кол-во в упаковке  
      PriceOut:currency; //цена продажная  
    end;  
var  
  TovarList:TStringList;  

Набор объектов TTovar - это классический справочник однородных товаров, например, хлебобулочных изделий. Поле Weight в классе TEdIzm требуется для перевода одних единиц в другие. Вернемся к нашим булкам. Допустим, поставщик "Карякинский Хлебозавод" предоставил нам текстовый файл, в котором находится информация о его новой продукции и отпускных ценах в формате текстового файла:


*Начало файла*  
Товар1=[наименование товара]  
ЕдИзм1=[наименование ед.изм.]  
Вес1=[вес единицы измерения]  
КолУп1=[количество в упаковке]  
Цена1=[цена поставщика]  
--  
Товар2=[наименование товара]  
ЕдИзм2=[наименование ед.изм.]  
Вес2=[вес единицы измерения]  
КолУп2=[количество в упаковке]  
Цена2=[цена поставщика]  
--  
*Конец файла*  

Всего в файле содержится, например, 2000 наименований. Наша задача - загрузить данные этого файла в список строк ListBox1:TListBox (лежащий на форме) в отсортированном виде так, чтобы была возможность по двойному щелчку просмотреть параметры каждого товара (для этого к каждой строке будет прикреплен объект типа TTovar).

Если решать эту задачу в лоб (как чтение построчно и разбор текстового файла), а так же напрямую добавлять в ListBox, то это обернется неэффективной работой компьютера, его подтормаживанием (на слабых машинах), и вообще, для дальнейших внесений изменений в программный код это решение не является лучшим. Гораздо эффективнее сделать "финт ушами", а именно, создать TStringList, загрузить в него исходный файл, создать второй TStringList, загрузить в него товары, отсортировать их, и в конце концов, присвоить свойству ListBox.Items:


function LoadTovary(filename:string):TStrings;   
var str:TStringList;  
    tovar:TTovar;  
    edizm:TEdIzm;  
    I:integer;  
begin  
  //загружаем файл с данными  
  str:=TStringList.Create;  
  str.LoadFromFile(filename);  
  //посчитаем, сколько будет товаров  
  result:=TStringList.Create; // TStrings являедся предком TStringList, поэтому данное присвоение корректно  
  result.Capacity:=str.count div 6;  
  for I:=0 to result.capacity do  
  begin  
    tovar:=TTovar.Create;  
    edizm:=TEdIzm.Create;  
    tovar.Name:=str.Values['Товар'+inttostr(i)];  
    edizm.Name:=str.Values['ЕдИзм'+inttostr(i)];  
    edizm.Weight:=strtofloat(str.Values['Вес'+inttostr(i)]);  
    tovar.CountUp:=strtoint(str.Values['КолУп'+inttostr(i)]);  
    tovar.PriceOut:=strtoint(str.Values['Цена'+inttostr(i)]);  
    tovar.EdIzm:=edizm;  
    result.AddObject(tovar.Name,tovar);  
  end;  
  result.Sort;  
end;  
  
...  
ListBox1.Items:=LoadTovary('fromhlzd.txt');  
...  

Заметим, что если написать функцию типа TStringListSortCompare, то можно будет сортировать не только по текстовому представлению, но и по любым другим признакам, например, цене:


function StringListComparePrice(List: TStringList; Index1, Index2: Integer): Integer;  
begin  
  Result := TTovar(List.Objects[Index1]).PriceOut-TTovar(List.Objects[Index2]).PriceOut;  
end;  
  
...  
result.CustomSort(StringListComparePrice);  
...  

Ну и в конце концов, продемонстрируем реакцию на двойное нажатие на получившемся списке товаров. По двойному щелчку мы покажем отпускную цену товара:


procedure TForm1.ListBox1DblClick(Sender: TObject);  
begin  
  showmessage('Цена поставщика '+  
floattostr(TTovar(TListBox(sender).Items.Objects[TListBox(sender).ItemIndex]).PriceOut)  
  );  
end;  

Кстати, не забываем освобождать системные ресурсы объектов перед удалением строк методами ListBox1.Items.Delete()/Clear() или str.Delete()/Clear() (str:TStringList), если это требуется, а так же при закрытии приложения:


procedure TForm1.FormDestroy(Sender: TObject);  
var i:integer;  
begin  
  for i:=0 to ListBox1.Items.Count-1 do  
  with TTovar(ListBox1.Items.Objects[i]) do  
  begin  
    EdIzm.Free;  
    Free;  
  end;  
end;  

Теперь немного усложним задачу. Пусть у нас есть не один файл, а десять - от десяти разных поставщиков. Нам надо в общей сложности загрузить 20000 наименований и затем отсортировать их. Если мы будем именно так и делать, то сортировка такого большого списка объектов займет значительное время, это и составляет задачу. Однако такая задача решается очень просто - достаточно после создания объекта TStringList сразу присвоить его свойству Sorted значение true. После этого вставка новых строк будет осуществляться с помощью быстрого алгоритма, однако потеряется возможность сортировать по параметрам прикрепленных объектов, т.к. в случае Sorted=true сортировка производится автоматически только по текстовому представлению (см. исходники TStringList). При Sorted=true, обработка дубликатов определяется свойством Duplicates. Можно пропускать, разрешать и запрещать дубликаты объектов с одинаковым текстовым представлением. При этом, если дубликаты пропускаются или запрещены, необходимо следить за освобождением ресурсов объектов, не добавленных в список. По умолчанию, свойство Duplicates равно dupIgnore, что означает, что дубликаты пропускаются, поэтому по умолчанию надо следить за освобождением ресурсов.

Стоит отметить, что при сохранении или загрузке списка строк, прикрепленные к строкам объекты не сохраняются и не восстанавливаются в стандартном TStringList, однако можно очень красиво решить эту проблему - написать потомка TStringList с переопределенными процедурами GetTextStr и SetTextStr, в которых придумать и реализовать собственный формат хранения объектов и их текстового представления в виде непрерывного текста.

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

Предположим, что нам надо запустить некую программу obrab.exe с параметром командной строки, в которой необходимо передать выбранный товар из сформированного выше списка. Напишем упаковщик и распаковщик данных. С TStringList эта задача программируется за две секунды:

Упаковщик


procedure runobrab;  
var strtov,stred:TStringList;  
begin  
  strtov:=TStringList.Create;  
  with TTovar(ListBox1.Items.Objects[ListBox1.ItemIndex]) do  
  begin  
    stred:=TStringList.Create;  
    stred.Values['ЕдИзм']:=EdIzm.Name;  
    stred.Values['Вес']:=floattostr(EdIzm.Weight);  
    strtov.Values['Товар']:=Name;  
    strtov.Values['ЕдИзм']:=stred.CommaText;  
    strtov.values['КолУп']:=inttostr(CountUp);  
    strtov.values['Цена']:=floattostr(PriceOut);  
  end;  
  winexec('obrab.exe '+strtov.CommaText,SW_SHOWNORMAL);  
  strtov.Free;  
  stred.Free;  
end;  

Распаковщик


function getparam:TTovar;  
var strtov,stred:TStringList;  
begin  
  strtov:=TStringList.Create;  
  stred:=TStringList.Create;  
  strtov.CommaText:=paramstr(1);  
  stred.CommaText:=strtov.Values['ЕдИзм'];  
  result:=TTovar.Create;  
  with result do  
  begin  
    EdIzm:=TEdIzm.Create;  
    EdIzm.Name:=stred.Values['ЕдИзм'];  
    EdIzm.Weight:=strtofloat(stred.Values['Вес']);  
    Name:=strtov.Values['Товар'];  
    CountUp:=strtoint(strtov.values['КолУп']);  
    PriceOut:=strtofloat(strtov.values['Цена']);  
  end;  
  stred.Free;  
  strtov.Free;  
end;  

Продолжение следует…

Автор: Цованян Роман

Добавлено: 07 Августа 2018 08:24:30 Добавил: Андрей Ковальчук

Работа с TDBGrid

Что можно поместить в DBGrid

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

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

Рассмотрим простейшее приложение с TDBGrid, содержащее один компонент TTable, один компонент TDataSource и один компонент TDBGrid: Установим значения их свойств в соответствии с приведенной ниже таблицей:

Компонент Свойство Значение
Table1 DatabaseName BCDEMOS (или DBDEMOS)
TableName events.db
Active true
DataSource1 DataSet Table1
DBGrid1 DataSource DataSource1
Обычно для перерисовки изображения в ячейках используется метод OnDrawColumnCell.

Его параметр Rect - структура, описывающая занимаемый ячейкой прямоугольник, параметр Column - колонка DBGrid, в которой следует изменить способ рисования изображения. Для вывода текста используется метод TextOut свойства Canvas компонента TDBGrid.

Предположим, нам нужно изменить цвет текста и фона строки в зависимости от значения какого-либо поля (например, VenueNo). Создадим обработчик события OnDrawColumnCell компонента DBGrid1. В случае C++Builder он имеет вид:


void __fastcall TForm1::DBGrid1DrawColumnCell(TObject *Sender,  
      const TRect &Rect, int DataCol, TColumn *Column,  
      TGridDrawState State)  
{  
if (Table1->FieldByName("VenueNo")->Value==1)  
{  
DBGrid1->Canvas->Brush->Color=clGreen;  
DBGrid1->Canvas->Font->Color=clWhite;  
DBGrid1->Canvas->FillRect(Rect);  
DBGrid1->Canvas->TextOut(Rect.Left+2,Rect.Top+2,Column->Field->Text);  
}  
}  

В случае Delphi соответствующий код имеет вид:


procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;  
  DataCol: Integer; Column: TColumn; State: TGridDrawState);  
begin  
if (Table1.FieldByName('VenueNo').Value=1) then begin  
with  DBGrid1.Canvas do begin  
Brush.Color:=clGreen;  
Font.Color:=clWhite;  
FillRect(Rect);  
TextOut(Rect.Left+2,Rect.Top+2,Column.Field.Text);  
end;  
end;  
end;  

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

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


void __fastcall TForm1::DBGrid1DrawColumnCell(TObject *Sender,  
      const TRect &Rect, int DataCol, TColumn *Column,  
      TGridDrawState State)  
{  
if (Table1->FieldByName("VenueNo")->Value==1)  
{  
DBGrid1->Canvas->Brush->Color=clGreen;  
DBGrid1->Canvas->Font->Color=clWhite;  
DBGrid1->Canvas->FillRect(Rect);  
if (Column->Alignment==taRightJustify)  
{  
DBGrid1->Canvas->TextOut(Rect.Right-2-  
  DBGrid1->Canvas->TextWidth(Column->Field->Text),  
  Rect.Top+2,Column->Field->Text);  
}  
else  
{  
DBGrid1->Canvas->TextOut(Rect.Left+2,Rect.Top+2,Column->Field->Text);  
}  
}  
}  

Соответствующий код для Delphi имеет вид:


procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;  
  DataCol: Integer; Column: TColumn; State: TGridDrawState);  
begin  
if (Table1.FieldByName('VenueNo').Value=1) then begin  
with  DBGrid1.Canvas do begin  
Brush.Color:=clGreen;  
Font.Color:=clWhite;  
FillRect(Rect);  
if (Column.Alignment=taRightJustify) then  
 TextOut(Rect.Right-2-  TextWidth(Column.Field.Text),  
  Rect.Top+2,Column.Field.Text)  
else  
 TextOut(Rect.Left+2,Rect.Top+2,Column.Field.Text);  
end;  
end;  
end;  

В этом случае выравнивание текста в колонках совпадает с выравниванием столбцов.

Отметим, что величина смещения (в данном случае 2 пиксела), вообще говоря, зависит от гарнитуры и размера шрифта, используемого в данной колонке, и должна подбираться индивидуально.

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


void __fastcall TForm1::DBGrid1DrawColumnCell(TObject *Sender,  
      const TRect &Rect, int DataCol, TColumn *Column,  
      TGridDrawState State)  
{  
if ((Table1->FieldByName("VenueNo")->Value==1) &  
(Column->FieldName=="VenueNo") )  
{  
DBGrid1->Canvas->Brush->Color=clGreen;  
DBGrid1->Canvas->Font->Color=clWhite;  
DBGrid1->Canvas->FillRect(Rect);  
DBGrid1->Canvas->TextOut(Rect.Right-2-  
  DBGrid1->Canvas->TextWidth(Column->Field->Text),  
  Rect.Top+2,Column->Field->Text);  
}  
}  

Соответствующий код для Delphi имеет вид:


procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;  
  DataCol: Integer; Column: TColumn; State: TGridDrawState);  
begin  
if (Table1.FieldByName('VenueNo').Value=1) and  
(Column.FieldName='VenueNo')  then begin  
with  DBGrid1.Canvas do begin  
Brush.Color:=clGreen;  
Font.Color:=clWhite;  
FillRect(Rect);  
TextOut(Rect.Right-2-  TextWidth(Column.Field.Text),  
  Rect.Top+2,Column.Field.Text)  
end;  
end;  
end;  

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

Как заменить данные в столбце компонента TDBGrid
Нередко в колонке DBGrid нужно вывести не реальное значение, хранящееся в поле соответствующей таблицы, а другие данные, соответствующие имеющимся (например, символьную строку вместо ее числового кода). В этом случае также используется метод TextOut свойства Canvas компонента TDBGrid:


void __fastcall TForm1::DBGrid1DrawColumnCell(TObject *Sender,  
      const TRect &Rect, int DataCol, TColumn *Column,  
      TGridDrawState State)  
{  
if  
(Column->FieldName=="VenueNo")  
{  
DBGrid1->Canvas->Brush->Color=clWhite;  
DBGrid1->Canvas->FillRect(Rect);  
if (Table1->FieldByName("VenueNo")->Value==1)  
{  
DBGrid1->Canvas->Font->Color=clRed;  
DBGrid1->Canvas->TextOut(Rect.Right-2-  
  DBGrid1->Canvas->TextWidth("our venue"),  
  Rect.Top+2,"our venue");  
}  
else  
{  
DBGrid1->Canvas->TextOut(Rect.Right-2-  
  DBGrid1->Canvas->TextWidth("other venue"),  
  Rect.Top+2,"other venue");  
}  
}  
}  

Соответствующий код для Delphi имеет вид:


procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;  
  DataCol: Integer; Column: TColumn; State: TGridDrawState);  
begin  
if  (Column.FieldName='VenueNo')  then begin  
with  DBGrid1.Canvas do begin  
Brush.Color:=clWhite;  
FillRect(Rect);  
if (Table1.FieldByName('VenueNo').Value=1) then begin  
Font.Color:=clRed;  
TextOut(Rect.Right-2-  
  DBGrid1.Canvas.TextWidth('our venue'),  
  Rect.Top+2,'our venue');  
end else begin  
 TextOut(Rect.Right-2-  
  DBGrid1.Canvas.TextWidth('other venue'),  
  Rect.Top+2,'other venue');  
end;  
end;  
end;  
end;  

Еще один пример - использование значков из шрифтов Windings или Webdings в качестве подставляемой строки.


void __fastcall TForm1::DBGrid1DrawColumnCell(TObject *Sender,  
      const TRect &Rect, int DataCol, TColumn *Column,  
      TGridDrawState State)  
{  
if  
(Column->FieldName=="VenueNo")  
{  
DBGrid1->Canvas->Brush->Color=clWhite;  
DBGrid1->Canvas->FillRect(Rect);  
DBGrid1->Canvas->Font->Name="Wingdings";  
DBGrid1->Canvas->Font->Size=-14;  
if (Table1->FieldByName("VenueNo")->Value==1)  
{  
DBGrid1->Canvas->Font->Color=clRed;  
DBGrid1->Canvas->TextOut(Rect.Right-2-  
  DBGrid1->Canvas->TextWidth("J"),  
  Rect.Top+1,"J");  
}  
else  
{  
DBGrid1->Canvas->Font->Color=clBlack;  
DBGrid1->Canvas->TextOut(Rect.Right-2-  
  DBGrid1->Canvas->TextWidth("F"),  
  Rect.Top+1,"F")    ;  
}  
}  
}  

Соответствующий код для Delphi имеет вид:


procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;  
  DataCol: Integer; Column: TColumn; State: TGridDrawState);  
begin  
if  (Column.FieldName='VenueNo')  then begin  
with  DBGrid1.Canvas do begin  
Brush.Color:=clWhite;  
FillRect(Rect);  
Font.Name:='Wingdings';  
Font.Size:=-14;  
if (Table1.FieldByName('VenueNo').Value=1) then begin  
Font.Color:=clRed;  
TextOut(Rect.Right-2-  
  DBGrid1.Canvas.TextWidth('J'),  
  Rect.Top+1,'J');  
end else begin  
 Font.Color:=clBlack;  
 TextOut(Rect.Right-2- DBGrid1.Canvas.TextWidth('F'),  
  Rect.Top+1,'F');  
end;  
end;  
end;  
end;  

Как поместить графическое изображение в TDBGrid
Использование свойства Canvas компонента TDBGrid в методе OnDrawColumnCell позволяет не только выводить в ячейке текст методом TextOut, но и размещать в ячейках графические изображения. В этом случае используется метод Draw свойства Canvas.

Модифицируем наш пример, добавив на форму компонент TImageList и поместив в него несколько изображений.

Модифицируем код нашего приложения:


void __fastcall TForm1::DBGrid1DrawColumnCell(TObject *Sender,  
      const TRect &Rect, int DataCol, TColumn *Column,  
      TGridDrawState State)  
{  
 Graphics::TBitmap *Im1;  
 Im1= new   Graphics::TBitmap;  
if  
(Column->FieldName=="VenueNo")  
{  
DBGrid1->Canvas->Brush->Color=clWhite;  
DBGrid1->Canvas->FillRect(Rect);  
if (Table1->FieldByName("VenueNo")->Value==1)  
{  
ImageList1->GetBitmap(0,Im1);  
}  
else  
{  
ImageList1->GetBitmap(2,Im1);  
}  
DBGrid1->Canvas->Draw((Rect.Left+Rect.Right-Im1->Width)/2,Rect.Top,Im1);  
}  
}  

Соответствующий код для Delphi имеет вид:


procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;  
  DataCol: Integer; Column: TColumn; State: TGridDrawState);  
var Im1: TBitmap;  
begin  
Im1:=TBitmap.Create;  
if  (Column.FieldName='VenueNo' ) then begin  
with  DBGrid1.Canvas do begin  
Brush.Color:=clWhite;  
FillRect(Rect);  
if (Table1.FieldByName('VenueNo').Value=1)  
then begin  
ImageList1.GetBitmap(0,Im1);  
end else begin  
ImageList1.GetBitmap(2,Im1);  
end;  
Draw(round((Rect.Left+Rect.Right-Im1.Width)/2),Rect.Top,Im1);  
end;  
end;  
end;  

Теперь в TDBGrid в колонке VenueNo находятся графические изображения.

Добавлено: 07 Августа 2018 08:18:46 Добавил: Андрей Ковальчук

Мониторинг SQL запросов при работе с ADO компонентами

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

Одним из альтернативных способов доступа к источникам данных стали компоненты ADO.


Диалоговое окно мониторинга SQL запросов

Хотя в новых версиях Delphi добавлены более современные компоненты dbExpress, а так же огромное количество компонент сторонних производителей, компоненты ADO все еще заслуживают внимания. Из-за простоты использования, интеграции со средой разработки (в поставке Delphi Enterpise), а так же довольно высокой скорости работы имеет смысл их использовать, если не планируется переходить на мультиплатформенную разработку.

Первой из рассматриваемых компонент будет TADOConnection. Не будем останавливаться на подробном процессе настройки соединения, информацию об этом можно прочитать и в help'е. Хочется отметить на отсутствие мониторинга sql запросов при работе с ADO компонентами. А при отладке программ данная функция будет далеко не последней. Особенно при работе с параметрическими запросами. Мониторинг позволяет визуально отследить, что же в действительности посылается серверу базы данных. Особую актуальность этот режим приобретает на компьютере заказчика. Delphi IDE с собой таскать ох как не хочется. Да и не на всяком компьютере развернешь эту среду разработки. Для реализации функции мониторинга напишем пару методов на события WillExecute и ExecuteComplete компоненты TADOConnection.


fExecuteTime: dword;  
  
...  
  
procedure TDM.dbConnectionWillExecute(  
  
  Connection: TADOConnection;  
  var CommandText: WideString;  
  var CursorType: TCursorType;  
  var LockType: TADOLockType;  
  var CommandType: TCommandType;  
  var ExecuteOptions: TExecuteOptions;  
  var EventStatus: TEventStatus;  
  const Command: _Command; const Recordset: _Recordset  
  );  
var  
  i,j: integer;  
  infoStr: String;  
  tmpParameters: Parameters;  
begin  
  if gDebugMode  
  
  then MonitorEvent('WillExecute.. ',[]);  
  fExecuteTime:=GetTickCount;  
  if gSqlMonitor and gDebugMode then  
  begin  
  MonitorEvent(CommandText,['']);  
  if Assigned(Recordset) then  
  begin  
  for i := 0 to (dbConnection.DataSetCount-1) do  
    if Assigned(dbConnection.DataSets[i].Recordset)  
  and (Recordset = dbConnection.DataSets[i].Recordset) then  
  if (dbConnection.DataSets[i] is TADODataSet)  
  and (TADODataSet(dbConnection.DataSets[i]).  
  
                                   Parameters.Count > 0)  
  
  then  
  for j:=0 to TADODataSet(dbConnection.DataSets[i]).  
  
                                   Parameters.Count-1 do  
  begin  
  infoStr:='P['+IntToStr(j)+'] '  
  +TADODataSet(dbConnection.DataSets[i]).  
  
                                   Parameters.Items[j].Name+' = ';  
  if Not VarisNull(TADODataSet(dbConnection.DataSets[i]).  
  Parameters.Items[j].Value) then  
  infoStr:=infoStr+String(TADODataSet(dbConnection.DataSets[i]).  
  
                                   Parameters.Items[j].Value)  
  else  
  infoStr:=infoStr + 'Null';  
  MonitorEvent(infoStr,['']);  
  end;  
  end;  
  if Assigned(Command) then  
  begin  
  tmpParameters:=Command.Get_Parameters;  
  if (tmpParameters.Count > 0) then  
  for j:=0 to tmpParameters.Count - 1 do  
  begin  
  infoStr:=tmpParameters.Item[j].Name+' = ';  
  if Not VarisNull(tmpParameters.Item[j].Value) then  
  infoStr:=infoStr + String(tmpParameters.Item[j].Value)  
  else  
  infoStr:=infoStr + 'Null';  
  MonitorEvent(infoStr,['']);  
  end  
  end;  
  MonitorEvent('',['']);  
  end;  
end;  
  
procedure TDM.dbConnectionExecuteComplete(  
  
  Connection: TADOConnection;  
  RecordsAffected: Integer;  
  const Error: Error;  
  var EventStatus: TEventStatus;  
  const Command: _Command;  
  const Recordset: _Recordset  
  );  
begin  
  Self.fExecuteTime:=GetTickCount-Self.fExecuteTime;  
  if gDebugMode  
  
  then MonitorEvent('Execute time: '  
  
                 +FloatToStr(Self.fExecuteTime / 1000)+' s.',[]);  
end;  

Для управления режимом мониторинга и отладки введены глобальные переменные gSqlMonitor и gDebugMode. Функция вывода окна мониторинга MonitorEvent не приводится, так как написать ее очень просто. Пример реализации окна SQL мониторинга показан на рисунке.

Добавлено: 04 Августа 2018 07:50:34 Добавил: Андрей Ковальчук

Как экспортировать таблицу базы данных в ASCII-файл?

procedure TMyTable.ExportToASCII;  
var  
  I: Integer;  
  Dlg: TSaveDialog;  
  ASCIIFile: TextFile;  
  Res: Boolean;  
begin  
  if Active then  
    if (FieldCount > 0) and (RecordCount > 0) then  
      begin  
        Dlg := TSaveDialog.Create(Application);  
        Dlg.FileName := FASCIIFileName;  
        Dlg.Filter := 'ASCII-Fiels (*.asc)|*.asc';  
        Dlg.Options := Dlg.Options+[ofPathMustExist,   
          ofOverwritePrompt, ofHideReadOnly];  
        Dlg.Title := 'Экспоритровать данные в ASCII-файл';  
        try  
          Res := Dlg.Execute;  
          if Res then  
            FASCIIFileName := Dlg.FileName;  
        finally  
          Dlg.Free;  
        end;  
        if Res then  
          begin  
            AssignFile(ASCIIFile, FASCIIFileName);  
            Rewrite(ASCIIFile);  
            First;  
            if FASCIIFieldNames then  
              begin  
                for I := 0 to FieldCount-1 do  
                  begin  
                    Write(ASCIIFile, Fields[I].FieldName);  
                    if I <> FieldCount-1 then  
                     Write(ASCIIFile, FASCIISeparator);  
                  end;  
                Write(ASCIIFile, #13#10);  
              end;  
            while not EOF do  
              begin  
                for I := 0 to FieldCount-1 do  
                  begin  
                    Write(ASCIIFile, Fields[I].Text);  
                    if I <> FieldCount-1 then  
                      Write(ASCIIFile, FASCIISeparator);  
                  end;  
                Next;  
                if not EOF then  
                 Write(ASCIIFile, #13#10);  
              end;  
            CloseFile(ASCIIFile);  
            if IOResult <> 0 then  
              MessageDlg('Ошибка при создании или переписывании '+  
                'в ASCII-файл', mtError, [mbOK], 0);  
          end;  
      end  
    else  
      MessageDlg('Нет данных для экспортирования.',  
        mtInformation, [mbOK], 0)  
  else  
    MessageDlg('Таблица должна быть открытой, чтобы данные '+  
      'можно было экспортировать в ASCII-формат.', mtError,  
      [mbOK], 0);  
end;  

Добавлено: 01 Августа 2018 08:39:13 Добавил: Андрей Ковальчук

Как проверять корректность доступа к базе данных?

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


function TBDEDirect.CheckDatabase: Boolean;  
var  
  DS: TDataSource;  
begin  
  Result := False;  
  DS := GetDataSource;  
  if DS = nil then  
    begin  
      MessageDlg('Не установлена связь с элементом-источником данных.'+  
        'Проверьте установку свойства DataSource.',  
        mtError, [mbOK], 0);  
      Exit;  
    end;  
  if DS.DataSet = nil then  
    begin  
      MessageDlg('Доступ к базе данных невозможен.', mtError,[mbOK], 0);  
      Exit;  
    end;  
  if TDBDataSet(DS.DataSet).Database = nil then  
    begin  
      MessageDlg('Доступ к базе данных невозможен.', mtError,[mbOK], 0);  
      Exit;  
    end;  
  if TDBDataSet(DS.DataSet).Database.Handle = nil then  
    begin  
      MessageDlg('Дескриптор (Handle) БД недоступен.', mtError,[mbOK], 0);  
      Exit;  
    end;  
  if DS.DataSet.Handle = nil then  
    begin  
      MessageDlg('Дескриптор курсора (Cursor-Handle) недоступен.', mtError,[mbOK], 0);  
      Exit;  
    end;  
  Result := True;  
end;  

Добавлено: 01 Августа 2018 06:55:30 Добавил: Андрей Ковальчук

Как перейти к указанной записи в БД?


function TBDEDirect.GoToRecord(RecNo: LongInt): Boolean;  
var  
  RecCount: LongInt;  
  Bookmark: TBookmark;  
  Res: DBIResult;  
begin  
  Result := False;  
  if CheckDatabase then  
    begin  
      if RecNo < 1 then  
        RecNo := 1;  
      RecCount := GetRecordCount;  
      if RecNo > RecCount then  
        RecNo := RecCount;  
      Res := DbiSetToRecordNo(FDataLink.DataSource.DataSet.Handle,  
        RecNo);  
      if Res = 0 then  
        begin  
          Bookmark := StrAlloc(GetBookmarkSize);  
          DbiGetBookmark(FDataLink.DataSource.DataSet.Handle,  
            Bookmark);  
          FDataLink.DataSource.DataSet.GoToBookmark(Bookmark);  
          FDataLink.DataSource.DataSet.FreeBookmark(Bookmark);  
          Result := True;  
        end  
      else  
        Check(Res);  
    end;  
end;  

Добавлено: 31 Июля 2018 21:59:05 Добавил: Андрей Ковальчук

Как выделить окошко DBGrid другим цветом?

Необходимо обработать событие "OnDrawCellData". Например для того, чтобы пометить выбранное окошко красным фоном, необходимо сделать следующее:


procedure TForm1.DBGridDrawDataCell(Sender:TObject; const Rect:TRect;  
  Field:TField; State:TGridDrawState);  
begin  
  if gdFocused in State then  
    with (Sender as TDBGrid).Canvas do  
      begin  
        Brush.Color := clRed;  
        FillRect(Rect);  
        TextOut(Rect.Left, Rect.Top, Field.AsString);  
      end;  
end;  

Добавлено: 31 Июля 2018 21:25:37 Добавил: Андрей Ковальчук

Drag&amp;Drop, перетаскивание строк в компоненте DBGrid

Не мало статей уже написано про то как перетаскивать различные объекты, по форме используя функцию Drag&Drop, но все-таки в очередной раз хочу вернуться к этой теме и рассказать вам как можно используя Drag&Drop легко организовать перетаскивание строк в компоненте DBGrid. Не буду вас долго томить с введением, и поэтому давайте начинать...

Открываем Delphi и создаем новый проект. На форме нам понадобиться один компонент Memo с закладки Standard (именно в него мы будем перетаскивать строки), а также непосредсвенно сам компонент DbGrid с закладки DataControl.

Delphi Drag&Drop

Ну что я надеюсь, вы уже справились и кинули Memo и DbGrid на форму, да вот еще, в этом уроке я не буду рассказывать вам о том как подключиться к базе данных и как вывести таблицу из БД в компонент DBgrid, я предполагаю что вы это умеете делать.

Что теперь, выделяем DbGrid и в Object Inspector'e на вкладке Events создаем событие OnCellClick (кликаем 2 раза)
Теперь, когда Delphi создал для нас заготовку под будующую процедуру напишем между begin и end вот такой код:


DBGrid1.BeginDrag(True);  

Далее, нам нужно сказать компоненту Memo откуда ему можно принимать данные. Поэтому создаем обработчик событий OnDragOver на компоненте Memo и опять же между begin .. end прописываем вот такой код:


Accept:= Source IS TDBGrid; 

Ну и последние что нам нужно сделать это создать еще один обработчик событий OnDragDrop опять же на компоненте Memo. Ниже я привожу полный код процедуры DragDrop ну а вы уже смотрите на то что получилось у меня и добавляйте к себе в код недостающие строки.


procedure TForm1.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);  
var i : integer;  
begin  
Memo1.Clear;  
for i:= 0 to -1 + DBGrid1.FieldCount do  
begin  
Memo1.Lines.Add(DBGrid1.Fields[i].AsString);  
end;  
end;   

Вот и все как видите ничего сложного, запускаем проект и переносим строчку из DbGrid в Memo.

Добавлено: 31 Июля 2018 08:01:42 Добавил: Андрей Ковальчук

Создание таблиц и индексов в реалтайме

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

Для примера я бросил на форму две кнопки, один TEdit, TTable, TDataSource и DBGrid (см. рисунок 1). У DataSource1 свойство DataSet я поставил в Table1 , а у DBGrid в DataSource засунул DataSource1 . Всё это я сделал, чтобы можно было сразу увидеть созданную таблицу.

Кнопки у меня такие: первая для создания таблицы, а вторая для индексирования.

По нажатию первой, я намулевал вот что:


procedure TForm1.Button1Click(Sender: TObject);  
begin  
 with Table1 do  
  begin  
   Active := False;//Отключаю базу  
   TableName := Edit1.Text;//Задаю имя новой базы  
   FieldDefs.Clear;//Очищаю все текущие поля  
   with FieldDefs.AddFieldDef do//Добавляю новое поле  
    begin  
     Name := 'Field1';//Задаю имя нового поля  
     DataType := ftAutoInc;//Задаю тип autoincrement  
     Required := True;// Делаю поле обязательным  
    end;  
   with FieldDefs.AddFieldDef do//Добавляю ещё новое поле  
    begin  
     Name := 'Field2';  
     DataType := ftInteger;//Тип integer  
    end;  
   with FieldDefs.AddFieldDef do//Добавляю новое поле  
    begin  
     Name := 'Field3';  
     DataType := ftString;//Тип строка  
     Size := 30;// Размер строкового поля  
    end;  
  CreateTable;//Создаю новую базу с этими полями  
  Active:=true;//Активирую её.  
 end;  
end;  

В самом начале я устанавливаю Table1.Active в False, потому что создание таблицы можно производить только при отключённом компоненте. Если у тебя несколько компонентов ТTable связаны с базой, то нужно отключить их все.

Теперь процедура для кнопки 2, где я добавляю индексы. Обрати внимание, что таблица снова отключается Active := False.


procedure TForm1.Button2Click(Sender: TObject);  
begin  
 with Table1 do  
  begin  
   Active := False;//Отключаю таблицу  
   IndexDefs.Clear;//Очищаю текущие индексы  
   with IndexDefs.AddIndexDef do //Добавляю индекс  
    begin  
     Name := '';//Имя индекса. Это главный индекс, поэтому имя пустое  
     Fields := 'Field1';//Индексируемое поле  
     Options := [ixPrimary];//Тип индекса - главный  
    end;  
   with IndexDefs.AddIndexDef do//Добавляю ещё индекс  
    begin  
     Name := 'Fld2Indx'; //Имя индекса  
     Fields := 'Field3'; //Индексируемое поле  
     Options := [ixCaseInsensitive]; //Тип индекса (это вторичный)  
    end;  
   Active := true; //Активирую базу  
  end;  
end;  

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

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

Всё остальное описано в коментариях. Удачи!!!

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

Создание псевдонима с указанием пути к папке с базой


{ **** UBPFD *********** by delphibase.endimus.com **** 
>> Создание псевдонима базы данных с указанием пути к каталогу с базой 
 
Данная процедура создает нужный псевдоним (Alias), если он не существует, для 
базы данных, прописывает путь к базе данных. Если такой псевдоним существует, 
то проверяется его соответствие заданным параметрам. 
 
Зависимости: DBTables 
Автор: Александр, rda@im.net.ua, Мелитополь 
Copyright: Help Delphi 
Дата: 28 апреля 2002 г. 
***************************************************** }  
  
procedure Create_Alias;  
var  
AParams: TStringList;  
Dir: string;  
begin  
Dir := ExtractFilePath(ParamStr(0)) + ′BASE′; //Путь к базе. В данном случае  
//это Каталог программыBASE  
AParams := TStringList.Create;  
if not Session.IsAlias(′cssm′) then //Проверка существования псевдонима  
//cssm  
begin  
Session.AddStandardAlias(′cssm′, Dir, ′PARADOX′);  
end  
else  
try  
begin  
AParams.Clear;  
AParams.Add(′PATH=′ + Dir);  
Session.ModifyAlias(′cssm′, AParams);  
Session.SaveConfigFile;  
end;  
finally  
AParams.Free;  
end;  
end;   

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

Создание базы данных в Access и работа с ней

Сегодня я решил вернутся к этой теме и рассказать более подробно, как создавать базы данных и как с ними работать. Я это делаю, потому что все последующие статьи будут работать с базами только через ADO (пока это будет Access, а через пару месяцев я расскажу про MS SQL Server).

Запусти Access и выбери в меню Файл->Создать. В мастере создания базы выбери пункт "База данных" и нажми "ОК". Тебе предложат выбрать имя базы и место расположения, укажи что угодно, а я оставил значение по умолчанию db1.mdb .

После этого Access создаст базу и сохранит её по указанному пути. А ты увидишь окно как на рисунке 1, в котором и происходит работа с базой. Слевой стороны окна находится колонка выбора объектов, с которымы ты хочешь работать. Первым находится пункт "Таблицы" (он выделен по умолчанию) который и будет нас интересовать. Если этот объект у тебя не выделен, то выдели его. В окне справа находится три пункта:

Создание таблицы в режиме конструктора
Создание таблицы с помощью мастера
Создание таблицы путём ввода данных

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

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

Сверху находится сетка в которой ты вводишь поля таблицы, их тип и описание (последнее не обязательно). Когда ты вписал в сетку имя нового поля и указал тип, внизу окна появляются свойства нового поля. В зависимости от типа поля изменяется и количество свойств. Вот самые основные:

Масксимальная длинна поля. Для текстового поля размер не может быть больше 255. Если текст длинее, то надо использовать "Поле Memo".
Формат поля. Здесь ты можешь указать внешний вид данных. Например, поле может выглядить как "Yes/No" для логических полей, или например "mm yyyy" для поля даты.
Маска ввода. Здесь мы вводим маску, которая отвечает за отображение поля при редактировании. Если ты щёлкнешь на кнопке с точками "..." в строке "Маска ввода", то увидешь мастер, как на рисунке 3.
Значение по умолчанию. Умолчание, оно и в африке по умолчанию.
Обязательное поле. Если пользователь не введёт сюда значение, то появится сообщение об ошибке. Такое поле не может быть пустым.
Пустые строки. Похоже на предыдущий, потому что это поле тоже не может быть пустым.
Индексированное поле. Может быть неиндексированным, индексированным с допуском совпадений, и индексированным без допуска совпадений. Основной индекс всегда без допуска совпадений. Остальные желательно с допуском.
Сжатие Юникод - позволяет сжать данные в соответствии с Юникод.
Создай шесть полей:

Key1 - числовой. Это у нас будет ключик. Размер поля - "Длинное целое". Индексированное поле - "Да (Совпадения не допускаются)".
Фамилия - текстовый. Размер поля - 50. Индексированное поле - "Да (Допускаются совпадения)".
Имя - текстовый. Размер поля - 50. Индексированное поле - "Да (Допускаются совпадения)".
Телефон - текстовый. Размер поля - 10. Индексированное поле - "Да (Допускаются совпадения)".
e-mail - текстовый. Размер поля - 20. Индексированное поле - "Да (Допускаются совпадения)".
Город - числовой. Размер поля - Длинное целое. Индексированное поле - "Нет".
Помимо этого, у всех полей значение "Обязательно поле" стоит в "Нет", и "Пустые строки" выставлено в "Да".

Теперь выдели первое поле (Key1), щёлкни правой кнопкой мыши и выбери пункт "Ключевое поле".

Создай ещё одну таблицу "Справочник городов" с полями Key1 (числовое, ключевое) и город (текстовое, длинна 50). Сохрани таблицу.

Для открытия для заполнения полей таблицы нужно щёлкнуть на кнопке "Открыть". Для редактирования уже созданной таблицы нужно щёлкнуть на кнопке "Конструктор".

Теперь переходим в Delphi. Создай новый проект. Выбери File->New и создай новый модуль типа "DataModule". Брось на форму DataModule2 компонент ADOConnection из закладки ADO.

Щёлкни дважды по ADOConnection1. Появится знакомое окно (если ты читал статью в октябрьском номере). Выдели CheckBox "Use Connection String" и нажми кнопку "Build". Появится окно выбора поставщика драыйвера для работы с базой данных. Выбери "Microsoft Jet 4.0 OLE DB Provider". Здесь 4.0 обозначает номер версии и необходим для работы с Access 2000. Если у тебя установлен Office 97, то тебе достаточно версии 3.51. Нажми кнопку "Далее" и выбери в появившемся окне имя базы данных. Нажимай "ОК" и ещё в одном окне "ОК".

Теперь измени у ADOConnection1 свойство LoginPrompt на false, чтобы при коннекте с базой у тебя не запрашивали пароль (всё равно мы его не задали). Теперь можно коннектится к базе, для этього измени свойство Connected на true.

Теперь брось на эту же форму DataSource с закладки "Data Access" и ADOTable с закладки ADO.

У ADOTable установи следующие свойства:

Connection - ADOConnection1
TableName - "Главная таблица"
Active - true

У DataSource1 установи свойство DataSet в ADOTable1. Перейди в форму 1 (Form1). Выбери File->Use Unit и в появившемся окне выбери Unit2, чтобы подключить к Form1 наш модуль DataModule2.

Поставь на форму DBGrid с закладки "Data Controls". Измени его свойства DataSource на "DataModule2.DataSource1". Запускай программу и используй.

Пока хватит. Сегодня мы использовали только первую базу данных. Вторую мы подключим в следующий раз. Удачи.

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

Создание алиасов в Delphi


procedure CheckAlias(const AliasName, AliasType, AliasPath: String);  
{ Если алиас не существует, создать его }  
var  
SList: TStrings;  
i: Integer;  
AliasFound: Boolean;  
begin  
{ Проверка существования алиса BDE }  
try  
SList := TStringList.Create;  
Session.GetAliasNames(SList);  
AliasFound := False;  
for i:=0 to SList.Count-1 do  
if SList=AliasName then  
begin  
AliasFound := True;  
break;  
end;  
finally  
SList.Free;  
end;  
if AliasFound then  
begin  
try  
SList := TStringList.Create;  
Session.GetAliasParams(AliasName,SList);  
{А в 4-ой версии SList[2]!!! и без слова Path }  
if SList[0]< > ′PATH=′+AliasPath then { Правильно ли задан путь }  
begin  
SList[0] := ′PATH=′+AliasPath;  
Session.ModifyAlias(AliasName,SList);  
end;  
finally  
SList.Free;  
end;  
end  
else  
Session.AddStandardAlias(AliasName,AliasPath,AliasType); { Создать новый алиас }  
Session.SaveConfigFile;  
end;   

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

Секреты Delphi. Мониторинг SQL-запросов при работе с ADO-компонентами

Не секрет, что приложения баз данных составляют довольно большую долю всех вновь разрабатываемых приложений. Ни одна информационная система не может быть создана без соединения с той или иной СУБД. В первых версиях нам предлагался давно устаревший, но все еще успешно использующийся Borland Database Engine (BDE). Одним из альтернативных способов доступа к источникам данных стали компоненты ADO.

Хотя в новых версиях Delphi добавлены более современные компоненты dbExpress, а также огромное количество компонент сторонних производителей, компоненты ADO все еще заслуживают внимания. Из-за простоты использования, интеграции со средой разработки (в поставке Delphi Enterpise), а также довольно высокой скорости работы имеет смысл их использовать, если не планируется переходить на мультиплатформенную разработку.
Первой из рассматриваемых компонент будет TADOConnection. Не будем останавливаться на подробном процессе настройки соединения — информацию об этом можно прочитать и в help'е. Хочется отметить отсутствие мониторинга SQL-запросов при работе с ADO-компонентами. А при отладке программ данная функция будет далеко не последней. Особенно при работе с параметрическими запросами. Мониторинг позволяет визуально отследить, что же в действительности посылается серверу базы данных. Особую актуальность этот режим приобретает на компьютере заказчика. Delphi IDE с собой таскать ох как не хочется. Да и не на всяком компьютере развернешь эту среду разработки. Для реализации функции мониторинга напишем пару методов на события WillExecute и ExecuteComplete компоненты TADOConnection.


fExecuteTime     :dword;  
...  
  
procedure TDM.dbConnectionWillExecute(Connection: TADOConnection;  
  var CommandText: WideString; var CursorType: TCursorType;  
  var LockType: TADOLockType; var CommandType: TCommandType;  
  var ExecuteOptions: TExecuteOptions; var EventStatus: TEventStatus;  
  const Command: _Command; const Recordset: _Recordset);  
var  
  i,j:integer;  
  infoStr:String;  
  tmpParameters:Parameters;  
begin  
  if gDebugMode then  
    MonitorEvent('WillExecute.. ',[]);  
  fExecuteTime:=GetTickCount;  
  if gSqlMonitor and gDebugMode then  
  begin  
    MonitorEvent(CommandText,['']);  
    if Assigned(Recordset) then  
    begin  
      for i := 0 to (dbConnection.DataSetCount-1) do  
       if Assigned(dbConnection.DataSets[i].Recordset)  
        and (Recordset = dbConnection.DataSets[i].Recordset) then  
        if (dbConnection.DataSets[i] is TADODataSet)  
          and (TADODataSet(dbConnection.DataSets[i]).Parameters.Count > 0) then  
          for j:=0 to TADODataSet(dbConnection.DataSets[i]).Parameters.Count - 1 do  
          begin  
            infoStr:='P['+IntToStr(j)+'] '  
            + TADODataSet(dbConnection.DataSets[i]).Parameters.Items[j].Name+' = ';  
            if Not VarisNull(TADODataSet(dbConnection.DataSets[i]).  
               Parameters.Items[j].Value) then  
              infoStr:=infoStr  
              + String(TADODataSet(dbConnection.DataSets[i]).Parameters.Items[j].Value)  
            else  
              infoStr:=infoStr + 'Null';  
            MonitorEvent(infoStr,['']);  
          end;  
    end;  
    if Assigned(Command) then  
    begin  
      tmpParameters:=Command.Get_Parameters;  
      if (tmpParameters.Count > 0) then  
        for j:=0 to tmpParameters.Count - 1 do  
        begin  
          infoStr:=tmpParameters.Item[j].Name+' = ';  
          if Not VarisNull(tmpParameters.Item[j].Value) then  
            infoStr:=infoStr + String(tmpParameters.Item[j].Value)  
          else  
            infoStr:=infoStr + 'Null';  
          MonitorEvent(infoStr,['']);  
        end  
    end;  
    MonitorEvent('',['']);  
  end;  
end;  
  
procedure TDM.dbConnectionExecuteComplete(Connection: TADOConnection;  
  RecordsAffected: Integer; const Error: Error;  
  var EventStatus: TEventStatus; const Command: _Command;  
  const Recordset: _Recordset);  
begin  
  Self.fExecuteTime:=GetTickCount-Self.fExecuteTime;  
  if gDebugMode then  
    MonitorEvent('Execute time: ' + FloatToStr(Self.fExecuteTime / 1000) + ' s.',[]);  
end; 

Для управления режимом мониторинга и отладки введены глобальные переменные gSqlMonitor и gDebugMode. Функция вывода окна мониторинга MonitorEvent не приводится, так как написать ее очень просто.

Автор: Сергей Бердачук

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

Програмное создание нового DSN


type  
TSQLConfigDataSource =  
function(hwndParent: Integer;  
fRequest: Integer;  
lpszDriverString: string;  
lpszAttributes: string): Smallint; stdcall;  
  
function SQLConfigDataSource(hwndParent: Integer; fRequest: Integer;  
lpszDriverString: string; lpszAttributes: string): Integer; stdcall;  
var  
func: TSQLConfigDataSource;  
OdbccpHMODULE: HMODULE;  
  
begin  
OdbccpHMODULE := LoadLibrary(′c:WINDOWSSYSTEModbccp32.dll′);  
if OdbccpHMODULE = 0 then  
raise Exception.Create(SysErrorMessage(GetLastError));  
func := GetProcAddress(OdbccpHMODULE, PChar(′SQLConfigDataSource′));  
if @func = nil then  
raise Exception.Create(′Error Getting adress for SQLConfigDataSource′ +  
SysErrorMessage(GetLastError));  
Result := func(hwndParent, fRequest, lpszDriverString, lpszAttributes);  
FreeLibrary(OdbccpHMODULE);  
end;  
  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
if SQLConfigDataSource(0, 1, ′Microsoft Excel Driver (*.xls)′,  
Format(′DSN=%s;DBQ=%s;DriverID=790′, [′MyDSNName′,  
′c: emp emp.xls′])) <> 1 then  
ShowMessage(′Cannot create ODBC alias′);  
end;   

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

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


procedure TForm1.Button3Click(Sender: TObject);  
var  
MyList: TStringList;  
begin  
MyList := TStringList.Create;  
try  
with MyList do  
begin  
Add(′SERVER NAME=IB_SERVER:/PATH/DATABASE.GDB′);  
Add(′USER NAME=MYNAME′);  
end;  
Session1.AddAlias(′NewIBAlias′, ′INTRBASE′, MyList);  
finally  
MyList.Free;  
end;  
end;   

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