В стандартном контроле ComboBox обнаружен глюк! Он заключается в том, что при изменении цвета фона ComboBox'а, изменяется цвет фона только текущего пункта списка (над которым находится мышь). Мы использовали этот глюк и у нас получился выпадающий список с разноцветными пунктами!

Описание: Компонент, схожий со стандартным TTrackBar, но обладает большими возможностями. Главное эго отличие (собственно ради чего и создавался компонент) это возможность отследить изменяется ли в данный момент положение ползунка пользователем (свойство Changing). Кроме этого компонент позволяет изменять все цвета, использующиеся для его окраски, возможна также подсветка текущего положения ползунка...

Эта книга начинает с основ безопасности вашего компьютера, таких, как определение необходимости в средствах защиты и его текущего уровня защищенности. Далее в ней показывается и достаточно подробно объясняется, как усилить защищенность, выбрать высокоскоростное подключение к Интернету, установить средства защиты персонального компьютера и оценить новый уровень защищенности.
Книга дополнена материалами, отражающими специфику Интернета в России и в странах СНГ.

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

1. Введение

Во-первых, непосредственные команды из Delphi позволяют разработчику управлять таблицами, устанавливать пределы, удалять, вставлять и редактировать существующие записи.

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

Данный документ делает акцент на втором методе доступа к базам данных, на основе запросов SQL (pass-through). Авторы не стремились создать курсы по изучению синтаксиса языка SQL и его применения, они ставили перед собой цель дать несколько примеров использования компонентов TQuery и TStoredProc. Но чтобы сделать это, необходимо понимать концепцию SQL и знать как работают selects, inserts, updates, views, joins и хранимые процедуры (stored procedures). Документ также вскользь касается вопросов управления транзакциями и соединения с базой данных, но не акцентирует на этом внимание. Итак, приступая к теме, создайте простой запрос типа SELECT и отобразите результаты.

2. Компонент TQuery

Если в ваших приложениях вы собираетесь использовать SQL, то вам непременно придется познакомиться с компонентом TQuery. Компоненты TQuery и TTable наследуются от TDataset. TDataset обеспечивает необходимую функциональность для получения доступа к базам данных. Как таковые, компоненты TQuery и TTable имеют много общих признаков. Для подготовки данных для показа в визуальных компонентах используется все тот же TDatasource. Также, для определения к какому серверу и базе данных необходимо получить доступ, необходимо задать имя псевдонима. Это должно выполняться установкой свойства aliasName объекта TQuery.

Свойство SQL

Все же TQuery имеет некоторую уникальную функциональность. Например, у TQuery имеется свойство с именем SQL. Свойство SQL используется для хранения SQL-запроса. Ниже приведены основные шаги для составления запроса, где все служащие имеют зарплату свыше $50,000.

Создайте объект TQuery

Задайте псевдоним свойству DatabaseName. (Данный пример использует псевдоним IBLOCAL, связанный с демонстрационной базой данных employee.gdb).

Выберите свойство SQL и щелкните на кнопке с текстом - '...' (три точки, Инспектор Объектов - В.О.). Должен появиться диалог редактора списка строк (String List Editor).

Введите:

Код

Select * from EMPLOYEE where SALARY>50000

. Нажмите OK.

Выберите в Инспекторе Объектов свойство Active и установите его в TRUE.

Разместите на форме объект TDatasource.

Установите свойство Dataset у TDatasource в Query1.

Разместите на форме TDBGrid.

Установите его свойство Datasource в Datasource1.

Свойство SQL имеет тип TStrings. Объект TStrings представляет собой список строк, и чем-то похож на массив. Тип данных TStrings имеет в своем арсенале команды добавления строк, их загрузки из текстового файла и обмена данными с другим объектом TStrings. Другой компонент, использующий TStrings - TMemo. В демонстрационном проекте ENTRSQL.DPR (по идее, он должен находится на отдельной дискетте, но к "Советам по Delphi" она не прилагается - В.О.), пользователь должен ввести SQL-запрос и нажать кнопку "Do It" ("сделать это"). Результаты запроса отображаются в табличной сетке. В Листинге 1 полностью приведен код обработчика кнопки "Do It".

Листинг 1

Код

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Query1.close; {Деактивируем запрос в качестве одной из мер предосторожности }
Query1.SQL.Clear; {Стираем любой предыдущий запрос}
If Memo1.Lines[0] <> '' {Проверяем на предмет пустого ввода} then
Query1.SQL.Add(Memo1.Text) {Назначаем свойству SQL текст Memo}
else
begin
messageDlg('Не был введен SQL-запрос', mtError, [mbOK], 0);
exit;
end;
try {перехватчик ошибок}
Query1.Open; {Выполняем запрос и открываем набор данных}
except {секция обработки ошибок}
On e : EDatabaseError do {e - новый дескриптор ошибки}
messageDlg(e.message, mtError, [mbOK],0); {показываем свойство message объекта e}
end; {окончание обработки ошибки}
end;

Свойство Params

Этого должно быть достаточно для пользователя, знающего SQL. Тем не менее, большинство пользователей не знает этого языка. Итак, ваша работа как разработчика заключается в предоставлении интерфейса и создании SQL-запроса. В Delphi, для создания SQL-запроса на лету можно использовать динамические запросы. Динамические запросы допускают использование параметров. Для определения параметра в запросе используется двоеточие (:), за которым следует имя параметра. Ниже приведе пример SQL-запроса с использованием динамического параметра:

Код

select * from EMPLOYEE
where DEPT_NO = :Dept_no

Если вам нужно протестировать, или установить для параметра значение по умолчанию, выберите свойство Params объекта Query1. Щелкните на кнопке '...'. Должен появиться диалог настройки параметров. Выберите параметр Dept_no. Затем в выпадающем списке типов данных выберите Integer. Для того, чтобы задать значение по умолчанию, введите нужное значение в поле редактирования "Value".

Для изменения SQL-запроса во время выполнения приложения, параметры необходимо связать (bind). Параметры могут изменяться, запрос выполняться повторно, а данные обновляться. Для непосредственного редактирования значения параметра используется свойство Params или метод ParamByName. Свойство Params представляет из себя массив TParams. Поэтому для получения доступа к параметру, необходимо указать его индекс. Для примера,

Query1.params[0].asInteger := 900;

Свойство asInteger читает данные как тип Integer (название говорит само за себя). Это не обязательно должно указывать но то, что поле имеет тип Integer. Например, если тип поля VARCHAR(10), Delphi осуществит преобразование данных. Так, приведенный выше пример мог бы быть записан таким образом:

Query1.params[0].asString := '900';

или так:

Query1.params[0].asString := edit1.text;

Если вместо номера индекса вы хотели бы использовать имя параметра, то воспользуйтесь методом ParamByName. Данный метод возвращает объект TParam с заданным именем. Например:

Query1.ParamByName('DEPT_NO').asInteger := 900;

В листинге 2 приведен полный код примера.

Листинг 2

Код

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Query1.close; {Деактивируем запрос в качестве одной из мер предосторожности }
if not Query1.prepared then
Query1.prepare; {Убедимся что запрос подготовлен}
{Берем значение, введенное пользователем и заменяем
им параметр.}
if edit1.text <> '' then {Проверяем на предмет пустого ввода}
Query1.ParamByName('DEPT_NO').AsString := edit1.text
else
Begin
Query1.ParamByName('DEPT_NO').AsInteger := 0;
edit1.text := '0';
end;
try {перехватчик ошибок}
Query1.Open; {Выполняем запрос и открываем набор данных}
except {секция обработки ошибок}
On e : EDatabaseError do {e - новый дескриптор ошибки} messageDlg(e.message,
mtError,
[mbOK],0); {показываем свойство message объекта e}
end; {окончание обработки ошибки}
end;

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

[pagebreak]

Источник данных

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

Примечание: Следующий пример использует TTable с именем Table1. Для Table1 имя базы данных IBLOCAL, имя таблицы - DEPARTMENT. DataSource2 TDatasource связан с Table1. Таблица также активна и отображает записи в TDBGrid.

Способ подключения TQuery к TTable - через TDatasource. Есть два основных способа сделать это. Во-первых, разместить код в обработчике события TDatasource OnDataChange. Например, листинг 3 демонстрирует эту технику.

Листинг 3 - Использования события OnDataChange для просмотра дочерних записей

Код

procedure TForm1.DataSource2DataChange(Sender: TObject; Field: TField);
begin
Query1.Close;
if not Query1.prepared
then
Query1.prepare;
Query1.ParamByName('Dept_no').asInteger := Table1Dept_No.asInteger;
try
Query1.Open;
except
On e : EDatabaseError do
messageDlg(e.message, mtError, [mbOK], 0);
end;
end;

Техника с использованием OnDataChange очень гибка, но есть еще легче способ подключения Query к таблице. Компонент TQuery имеет свойство Datasource. Определяя TDatasource для свойства Datasource, объект TQuery сравнивает имена параметров в SQL-запросе с именами полей в TDatasource. В случае общих имен, такие параметры заполняются автоматически. Это позволяет разработчику избежать написание кода, приведенного в листинге 3 (*** приведен выше ***).

Фактически, техника использования Datasource не требует никакого дополнительного кодирования. Для поключения запроса к таблице DEPT_NO выполните действия, приведенные в листинге 4.

Листинг 4 - Связывание TQuery c TTable через свойство Datasource

Выберите у Query1 свойство SQL и введите:

Код

select * from EMPLOYEE
where DEPT_NO = :dept_no

Выберите свойство Datasource и назначьте источник данных, связанный с Table1 (Datasource2 в нашем примере)

Выберите свойство Active и установите его в True

Это все, если вы хотите создать такой тип отношений. Тем не менее, существуют некоторые ограничения на параметризованные запросы. Параметры ограничены значениями. К примеру, вы не можете использовать параметр с именем Column или Table. Для создания запроса, динамически изменяемого имя таблицы, вы могли бы использовать технику конкатенации строки. Другая техника заключается в использовании команды Format.

Команда Format

Команда Format заменяет параметры форматирования (%s, %d, %n и пр.) передаваемыми значениями. Например,

Format('Select * from %s', ['EMPLOYEE'])

Результатом вышеприведенной команды будет 'Select * from EMPLOYEE'. Функция буквально делает замену параметров форматирования значениями массива. При использовании нескольких параметров форматирования, замена происходит слева направо. Например,

Код

tblName := 'EMPLOYEE';
fldName := 'EMP_ID';
fldValue := 3;
Format('Select * from %s where %s=%d', [tblName, fldName, fldValue])

Результатом команды форматирования будет 'Select * from EMPLOYEE where EMP_ID=3'. Такая функциональность обеспечивает чрезвычайную гибкость при динамическом выполнении запроса. Пример, приведенный ниже в листинге 5, позволяет вывести в результатах поле salary. Для поля salary пользователь может задавать критерии.

Листинг 5 - Использование команды Format для создания SQL-запроса

Код

procedure TForm1.BitBtn1Click(Sender: TObject);
var
sqlString: string; {здесь хранится SQL-запрос}
fmtStr1,
fmtStr2: string; {здесь хранится строка, передаваемая для форматирования}

begin
{ Создание каркаса запроса }
sqlString := 'Select EMP_NO %s from employee where SALARY %s';

if showSalaryChkBox.checked {Если checkbox Salary отмечен} then
fmtStr1 := ', SALARY'
else
fmtStr1 := '';
if salaryEdit.text <> '' { Если поле редактирования Salary не пустое } then
fmtStr2 := salaryEdit.text
else
fmtStr2 := '>0';

Query1.Close; {Деактивируем запрос в качестве одной из мер предосторожности }
Query1.SQL.Clear; {Стираем любой предыдущий запрос}
Query1.SQL.Add(Format(sqlString, [fmtStr1, fmtStr2])); {Добавляем}
{форматированную строку к свойству SQL}

try {перехватчик ошибок}
Query1.Open; {Выполняем запрос и открываем набор данных}
except {секция обработки ошибок}
on e: EDatabaseError do {e - новый дескриптор ошибки}
messageDlg(e.message, mtError, [mbOK], 0);
{показываем свойство message объекта e}
end; {окончание обработки ошибки}
end;

В этом примере мы используем методы Clear и Add свойства SQL. Поскольку "подготовленный" запрос использует ресурсы сервера, и нет никакой гарантии что новый запрос будет использовать те же таблицы и столбцы, Delphi, при каждом изменении свойства SQL, осуществляет операцию, обратную "подготовке" (unprepare). Если TQuery не был подготовлен (т.е. свойство Prepared установлено в False), Delphi автоматически подготавливает его при каждом выполнении. Поэтому в нашем случае, даже если бы был вызван метод Prepare, приложению от этого не будет никакой пользы.

Open против ExecSQL

В предыдущих примерах TQuerie выполняли Select-запросы. Delphi рассматривает результаты Select-запроса как набор данных, типа таблицы. Это просто один класс допустимых SQL-запросов. К примеру, команда Update обновляет содержимое записи, но не возвращает записи или какого-либо значения. Если вы хотите использовать запрос, не возвращающий набор данных, используйте ExecSQL вместо Open. ExecSQL передает запрос для выполнения на сервер. В общем случае, если вы ожидаете, что получите от запроса данные, то используйте Open. В противном случае допускается использование ExecSQL, хотя его использование с Select не будет конструктивным. Листинг 6 содержит код, поясняющий сказанное на примере.

Листинг 6

Код

procedure TForm1.BitBtnClick(sender: TObject)
begin
Query1.Close;
Query1.Clear;
Query1.SQL.Add('Update SALARY from EMPLOYEE ' +
'where SALARY<:salary values (SALARY*(1+:raise)');
Query1.paramByName('salary').asString := edit1.text;
Query1.paramByName('raise').asString := edit2.text;
try
Query1.ExecSQL;
except
on e: EDatabaseError do
messageDlg(e.message, mtError, [mbOK], 0);
end;
end;

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

[pagebreak]

3. Компонент TStoredProc

Хранимая процедура представляет собой список команд (SQL или определенного сервера), хранимых и выполняемых на стороне сервера. Хранимые процедуры не имеют концептуальных различий с другими типами процедур. TStoredProc наследуется от TDataset, поэтому он имеет много общих характеристик с TTable и TQuery. Особенно заметно сходство с TQuery. Поскольку хранимые процедуры не требуют возврата значений, те же правила действуют и для методов ExecProc и Open. Каждый сервер реализует работу хранимых процедур с небольшими различиями. Например, если в качестве сервера вы используете Interbase, хранимые процедуры выполняются в виде Select-запросов. Например, чтобы посмотреть на результаты хранимой процедуры, ORG_CHART, в демонстрационной базе данных EMPLOYEE, используйте следующих SQL-запрос:

Код

Select * from ORG_CHART

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

4. TDatabase

Компонент TDatabase обеспечивает функциональность, которой не хватает TQuery и TStoredProc. В частности, TDatabase позволяет создавать локальные псевдонимы BDE, так что приложению не потребуются псевдонимы, содержащиеся в конфигурационном файле BDE. Этим локальным псевдонимом в приложении могут воспользоваться все имеющиеся TTable, TQuery и TStoredProc. TDatabase также позволяет разработчику настраивать процесс подключения, подавляя диалог ввода имени и пароля пользователя, или заполняя необходимые параметры. И, наконец, самое главное, TDatabase может обеспечивать единственную связь с базой данных, суммируя все операции с базой данных через один компонент. Это позволяет элементам управления для работы с БД иметь возможность управления транзакциями.

Транзакцией можно считать передачу пакета информации. Классическим примером транзакции является передача денег на счет банка. Транзакция должна состоять из операции внесения суммы на новый счет и удаления той же суммы с текущего счета. Если один из этих шагов по какой-то причине был невыполнен, транзакция также считается невыполненной. В случае такой ошибки, SQL сервер позволяет выполнить команду отката (rollback), без внесения изменений в базу данных. Управление транзакциями зависит от компонента TDatabase. Поскольку транзакция обычно состоит из нескольких запросов, вы должны отметить начало транзакции и ее конец. Для выделения начала транзакции используйте TDatabase.BeginTransaction. Как только транзакция начнет выполняться, все выполняемые команды до вызова TDatabase.Commit или TDatabase.Rollback переводятся во временный режим. При вызове Commit все измененные данные передаются на сервер. При вызове Rollback все изменения теряют силу. Ниже в листинге 7 приведен пример, где используется таблица с именем ACCOUNTS. Показанная процедура пытается передать сумму с одного счета на другой.

Листинг 7

Код

procedure TForm1.BitBtn1Click(Sender: TObject);
{ ПРИМЕЧАНИЕ: Поле BALANCE у ACCOUNTS имеет триггер, проверяющий
ситуацию, когда вычитаемая сумма превышает BALANCE. Если так, UPDATE
будет отменен}
begin
try
database1.StartTransaction;
query1.SQL.Clear;
{ Вычитаем сумму из выбранного счета }
query1.SQL.Add(Format('update ACCOUNTS ' +
'set BALANCE = BALANCE - %s ) ' +
'where ACCT_NUM = %s ',
[edit1.text,
Table1Acct_Num.asString]));
query1.ExecSQL;
query1.SQL.Clear;
{ Добавляем сумму к выбранному счету }
query1.SQL.Add(Format('update ACCOUNTS ' +
'set BALANCE = BALANCE + %s ' +
'where ACCT_NUM = %s ',
[edit1.text,
Table2Acct_Num.asString]));
query1.ExecSQL;
database1.Commit; {В этом месте делаем все изменения}
table1.Refresh;
table2.Refresh;
except
{При возникновении в приведенном коде любых ошибок,
откатываем транзакцию назад}
One: EDatabaseError do
begin
messageDlg(e.message, mtError, [mbOK], 0);
database1.rollback;
exit;
end;
One: Exception do
begin
messageDlg(e.message, mtError, [mbOK], 0);
database1.rollback;
exit;
end;
end;
end;

И последнее, что нужно учесть при соединении с базой данных. В приведенном выше примере, TDatabase использовался в качестве единственного канала для связи с базой данных, поэтому было возможным выполнение только одной транзакции. Чтобы выполнить это, было определено имя псевдонима (Aliasname). Псевдоним хранит в себе информацию, касающуюся соединения, такую, как Driver Type (тип драйвера), Server Name (имя сервера), User Name (имя пользователя) и другую. Данная информация используется для создания строки соединения (connect string). Для создания псевдонима вы можете использовать утилиту конфигурирования BDE, или, как показано в примере ниже, заполнять параметры во время выполнения приложения.

TDatabase имеет свойство Params, в котором хранится информация соединения. Каждая строка Params является отдельным параметром. В приведенном ниже примере пользователь устанавливает параметр User Name в поле редактирования Edit1, а параметр Password в поле Edit2. В коде листинга 8 показан процесс подключения к базе данных:

Листинг 8

Код

procedure TForm1.Button1Click(Sender: TObject);
begin
try
with database1 do
begin
Close;
DriverName := 'INTRBASE';
KeepConnection := TRUE;
LoginPrompt := FALSE;
with database1.Params do
begin
Clear;
Add('SERVER NAME=C:\IBLOCAL\EXAMPLES\EMPLOYEE.GDB');
Add('SCHEMA CACHE=8');
Add('OPEN MODE=READ/WRITE');
Add('SQLPASSTHRU MODE=SHARED NOAUTOCOMMIT');
Add('USER NAME=' + edit1.text);
Add('PASSWORD=' + edit2.text);
end;
Open;
end;
session.getTableNames(database1.databasename, '*',
TRUE,
TRUE,
ComboBox1.items);
except
One: EDatabaseError do
begin
messageDlg(e.message, mtError, [mbOK], 0);
end;
end;
end;

Этот пример показывает как можно осуществить подключение к серверу без создания псевдонима. Ключевыми моментами здесь являются определение DriverName и заполнение Params информацией, необходимой для подключения. Вам не нужно определять все параметры, вам необходимо задать только те, которые не устанавливаются в конфигурации BDE определенным вами драйвером базы данных. Введенные в свойстве Params данные перекрывают все установки конфигурации BDE. Записывая параметры, Delphi заполняет оставшиеся параметры значениями из BDE Config для данного драйвера. Приведенный выше пример также вводит такие понятия, как сессия и метод GetTableNames. Это выходит за рамки обсуждаемой темы, достаточно упомянуть лишь тот факт, что переменная session является дескриптором database engine. В примере она добавлена только для "показухи".

Другой темой является использование SQLPASSTHRU MODE. Этот параметр базы данных отвечает за то, как натив-команды базы данных, такие, как TTable.Append или TTable.Insert будут взаимодействовать с TQuery, подключенной к той же базе данных. Существуют три возможных значения: NOT SHARED, SHARED NOAUTOCOMMIT и SHARED AUTOCOMMIT. NOT SHARED означает, что натив-команды используют одно соединение с сервером, тогда как запросы - другое. Со стороны сервера это видится как работа двух разных пользователей. В любой момент времени, пока транзакция активна, натив-команды не будут исполняться (committed) до тех пор, пока транзакция не будет завершена. Если был выполнен TQuery, то любые изменения, переданные в базу данных, проходят отдельно от транзакции.

Два других режима, SHARED NOAUTOCOMMIT и SHARED AUTOCOMMIT, делают для натив-команд и запросов общим одно соединение с сервером. Различие между двумя режимами заключаются в передаче выполненной натив-команды на сервер. При выбранном режиме SHARED AUTOCOMMIT бессмысленно создавать транзакцию, использующую натив-команды для удаления записи и последующей попыткой осуществить откат (Rollback). Запись должна быть удалена, а изменения должны быть сделаны (committed) до вызова команды Rollback. Если вам нужно передать натив-команды в пределах транзакции, или включить эти команды в саму транзакцию, убедитесь в том, что SQLPASSTHRU MODE установлен в SHARED NOAUTOCOMMIT или в NOT SHARED.

5. Выводы

Delphi поддерживает множество характеристик при использовании языка SQL с вашими серверами баз данных. На этой ноте разрешите попрощаться и пожелать почаще использовать SQL в ваших приложениях.

TField-компоненты (или, точнее, потомки компонента TField с соответствующим типом поля) могут создаваться во время проектирования программы с помощью Fields Editor (редактора полей). Fields Editor вызывается двойным щелчком на иконке компонента TTable или TQuery. Но потомки TField могут быть созданы и удалены и в режиме выполнения программы.

Потомки компонента TField (такие как, например, TStringField, TIntegerField и др.) создаются методом Create для того типа потомка TField, который подходит к соответствующему полю набора данных. Другими словами, для поля строкового типа текущего набора данных необходимо вызвать метод Create класса TStringField, являющегося потомком TField. Методу Create необходим один параметр - владелец потомка TField, расположенный на TForm. После создания компонента наследника TField для того, чтобы новый экземпляр объекта мог установить связь с необходимым полем набора данных, необходимо установить несколько ключевых свойств. Вот их список:

FieldName: имя поля в таблице

Name: уникальный идентификатор компонента-потомка TField.

Index: позиция компонента-потомка TField в массиве TFields (свойство Fields компонента TTable или TQuery, с которым будет связан TField).

DataSet: компонент TTable или TQuery, с которым будет связан TField.

Приведенный ниже код демонстрирует способ создания TStringField. TForm названа Form1 (здесь ссылка на переменную Self), активный набор данных TQuery имеет имя Query1 и поле, для которого создается компонент TStringField, расположено в таблице dBASE с именем CO_NAME. Новый потомок TField будет вторым TField в свойстве-массиве Fields компонента Query1. Имейте в виду, что набор данных, связанный с новым потомком TField (в нашем случае Query1), перед добавлением TField должен быть закрыт, а после добавления вновь открыт.

Код

procedure TForm1.Button2Click(Sender: TOObject);
var
T: TStringField;
begin
Query1.Close;
T := TStringField.Create(Self);
T.FieldName := 'CO_NAME';
T.Name := Query1.Name + T.FieldName;
T.Index := Query1.FieldCount;
T.DataSet := Query1;
Query1.FieldDefs.UpDate;
Query1.Open;
end;

Вышеприведенный пример создает новый TStringField с именем Query1CO_NAME.

Для удаления существующего потомка TField достаточно вызова метода Free данного компонента. В примере, приведенном ниже, метод TForm FindComponent используется для получения указателя на компонент TStringField с именем Query1CO_NAME. Возвращаемая функцией FindComponent величина в случае успешного завершения будет иметь тип TComponent или nil в противном случае. Возвращаемое значение может использоваться для того, чтобы определить, действительно ли существует компонент до того, как будет применен метод Free.

Код

procedure TForm1.Button1Click(Sender: TObject);
var
TC: TComponent;
begin
TC := FindComponent('Query1CO_NAME');
if not (TC = nil) then
begin
Query1.Close;
TC.Free;
Query1.Open;
end;
end;

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

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

Ладно, хватит разговоров, давайте перейдем непосредственно к примерам. Для начала самый простой. Создайте новый HTML файл и пропишите в нем следующий код:

Код:

Код

<FORM name=test_form method=post>
<INPUT onclick="test_change ()" type=button value="Нажми на меня">
</FORM>

<SCRIPT language=javascript>
function test_change ()
{
document.all.resultat.innerHTML="Спасибо!";
}
</SCRIPT>

<DIV id=resultat></DIV>

Теперь сохраните файл и откройте его браузером. Вы увидите кнопку с надписью "Нажми на меня". Нажимайте, не бойтесь, баннеры не появятся ?. Что мы видим? Код изменился. Под кнопкой появилась надпись "Спасибо!". Содержание страницы изменилось. Но если вы загляните в файл с кодом, он неизменен. Как такое возможно? Все очень просто. Дело в том, что JS является client-side технологией. Т.е. он исполняется на машине посетителя, а не на сервере. А теперь давайте разберемся с кодом. Итак, с начала ничего нового не видим: форма с кнопкой, при клике на которую исполняется функция “test_change”. Сама функция содержит одну - единую строчку:

Код:

Код

document.all.resultat.innerHTML="Спасибо!";

Это и есть команда JS на вставку. Все что остается добавить это место, куда делать вставку. Место мы обозначили идентификатором "resultat". Идентификатор вы можете изменять вольно по своему усмотрению. Теперь создаем новый слой и связываем его с идентификатором "resultat":

Код:

Код

<DIV id=resultat></DIV>

Ну как, неплохо? Сразу хочу вас обрадовать, динамически можно вставлять не только простой текст, но и HTML теги! А теперь рассмотрим более сложный пример. Создадим калькулятор, который по веденным данным подсчитает вашу месячную зарплату ?. Итак создайте новый HTML файл и наберите следующее:

Код:

Код

<TABLE>
<FORM name=cash_form method=post>

<TR><TD>Оплата, $/час: <TD><INPUT size=10 name=Oplata></td></tr>
<TR><TD>Рабочих часов в день: <TD><INPUT size=10 name=Chasov></td></tr>
<TR><TD>Рабочих дней в месяц: <TD><INPUT size=10 name=Dney></td></tr>

<TR><TD colSpan=2>

<INPUT onclick="getmoney (this.form.Oplata.value,this.form.Chasov.value,this.form.Dney.value)" type=button value="Подсчитать"></td></tr>

</FORM>
</TABLE>

<SCRIPT language=javascript>
function getmoney (dat1,dat2,dat3)
{
month=dat1*dat2*dat3;
document.all.resultat.innerHTML="За месяц Вы заработаете "+month+" $";
}
</SCRIPT>

<DIV id=resultat></DIV>

Сохраняем файл и открываем его браузером. Что мы видим? Три поля для ввода и кнопку с надписью "Подсчитать", при клике на которую запускается функция "getmoney". Она получает введенные значения, вычисляет месячную зарплату и выводит ее в браузере. Введите значения и нажмите кнопку "Подсчитать". Обратите внимание на значение месячной зарплаты. А теперь измените одно или несколько введенных значений и снова нажмите кнопку "Подсчитать". Как вы видите новое значение заменило старое. Очень удобно. А можно, например, выводить новое значение под старым, для этого нужно изменить строчку

Код:

Код

document.all.resultat.innerHTML="За месяц Вы заработаете "+month+" $";

на

Код:

Код

document.all.resultat.innerHTML=document.all.resultat.innerHTML+"За месяц Вы заработаете "+month+" $<br>";

Теперь новые данные будут прибавляться к более ранним, и все они вместе будут выведены на экран. Обратите внимание на добавленный HTML тег в конце кода. Это перевод строки. Вот мы и протестировали использование HTML кода в динамически изменяемых страницах.

Конечно, калькуляторы нужны далеко не каждому сайту. И правильно, не стоит на одном зацикливаться. Подключите свое воображение. Возможность динамически добавлять HTML код открывает воистину огромный потенциал для разработчика. Конечно, меню на таком коде вряд ли сможет превзойти выпадающее меню JS - кликать надоест. А вот для экономии места и для организации пояснений к разным элементам сайта такие возможности JS идеально подходят. Простой пример - страница контактов на сайте компании. Там, как правило, размещена контактная информация компании, дистрибьюторов, представителей, разработчика сайта. Куча адресов, телефонов и e-mail'ов. Так и заблудиться можно. А вот если разместить ссылки "Компания", "Дистрибьюторы", "Представители", "Разработчик", посетитель быстро сориентируется и выберет нужную ссылку. Осталось только написать JS код, который при клике на ссылку выводит под ссылкой соответствующую информацию и убирал ранее выведеную. Многие могут возразить, мол можно сделать просто ссылку на нужный файл и не нужно динамическое изменение текущего. Но, во-первых, возможно посетитель заинтересован не одной ссылкой - ему придется возвращаться, а во-вторых, намного приятнее кликнуть и моментально (!!!) увидеть нужную информацию (загруженную вместе со страницей), чем ожидать загрузку очередной страницы. Давайте я дам простой примерчик, а разработка подобного кода останется вам как домашнее задание для закрепления материала. Итак, код:

Код:

Код

<FORM name=test_form method=post>
<INPUT onclick="test_on_off (1)" type=button value="Включить">
<INPUT onclick="test_on_off (0)" type=button value="Выключить">
</FORM>

<SCRIPT language=javascript>
function test_on_off (dat1)
{
if (dat1==1)
{document.all.resultat.innerHTML="<table border=1><tr><td>Ура! Работает!</td></tr></table>";}
else
{document.all.resultat.innerHTML="";}
}
</SCRIPT>

<DIV id=resultat></DIV>

При открытии файла, содержащего вышеуказанный код, в окне браузера можно будет увидеть две кнопки: "Включить" и "Выключить". При клике на первую из них функции "test_on_off" передается значение 1, а при клике на вторую - 0. В зависимости от полученного значения функция "test_on_off" либо выводит таблицу, либо убирает ее. Это лишь простой пример. Его можно немного улучшить, убрав одну кнопку и подправив код:

Код:

Код

<FORM name=test_form method=post>
<INPUT onclick="test_change ()" type=button value="ВключитьВыключить">
</FORM>

<SCRIPT language=javascript>
function test_change ()
{
if (document.all.resultat.innerHTML=="")
{document.all.resultat.innerHTML="<table border=1><tr><td>Ура! Работает!</td></tr></table>";}
else
{document.all.resultat.innerHTML="";}
}
</SCRIPT>

<DIV id=resultat></DIV>

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

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

В общем теперь вы имеете немалый арсенал средств для сайтостроителя, так что удачной работы!

Итак, что нам понадобится. В первую очередь - Delphi 5-7 (у меня стоит 7-я версия, и весь код тестировался именно в этой версии). Это вызвано тем, что компонент TWebBrowser впервые "прописался" на вкладке Internet именно в 5-й версии (в 4-й его надо было устанавливать как компонент ActiveX).

Сначала нам надо перевести WebBrowser в режим редактирования. Для этого у каждого документа (согласно объектной модели это document) существует свойство DesignMode. Если установить его в 'On', то наша компонента автоматически переключается в режим редактирования, а если установить его в 'Off', то компонент вернется в режим просмотра.

Проверим это! Создадим новую форму, разместим на ней компоненту TWebBrowser и несколько компонент TSpeedButton. Затем напишем такой код:

Код:

Код

unit main;

interface
...

var
Form1: TForm1;
Disp: IDispatch;
Editor: IHTMLDocument2;

implementation

{$R *.dfm}

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
CurrentWB: IWebBrowser;
Editor: IHTMLDocument2;
begin
Disp := pDisp;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
CurrentWB: IWebBrowser;
begin
CurrentWB := Disp as IWebBrowser;
editor := (CurrentWB.Document as IHTMLDocument2);
editor.DesignMode := 'On';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('About');
end;

Теперь по порядку о том, что мы написали. В событии OnCreate формы мы загружаем в браузер простую страницу (напомню, что протокол About позволяет загружать в браузер HTML строку). Это необходимо для того, чтобы в последующем мы могли обращаться к документу. Сразу после этого будет вызван обработчик события OnDocumentComplete. Но пока еще ничего не произошло. Внимательный читатель мог обратить внимание, что для перевода браузера в режим редактирования надо нажать кнопку 1. Editor - это экземпляр нашего документа (document). Его свойство DesignMode устанавливается в 'On'. Теперь наш редактор практически готов. Он уже умеет править текст, копировать/вырезать/вставлять текст и картинки, делать текст жирным/подчеркнутым/наклонным. Для этого есть соответствующие комбинации клавиш.

Ctrl + C Копировать
Ctrl + X Вырезать
Ctrl + V Вставить


Ctrl + B Жирный текст
Ctrl + I Наклонный текст
Ctrl + U Подчеркнутый текст


Ctrl + Z Отменить
Ctrl + Y Повторить
Ctrl + K Гиперссылка


Ctrl + F Найти
Ctrl + A Выделить всё
Ctrl + Left-Click Выделить блок

"Это, конечно, хорошо, что есть горячие клавиши, но мне не хотелось бы все их запоминать" - можете сказать вы. Хорошо. Тогда давайте разберем, как из Delphi заставить WebBrowser выполнять все эти действия. Для этого есть метод Command интерфейса IHTMLTxtRange (он описан в модуле MSHTML_TLB). Рассмотрим простой пример.

Код:

Код

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
Range: IHTMLTxtRange;
begin
Range := (editor.selection.createRange as IHTMLTxtRange);
Range.Command('bold', false, emptyparam)
end;

Сначала в этой процедуре создается объект Range. После этого вызывается метод Command:

Код:

Код

function Command(cmdID: WideString; ShowUI: WordBool;
Value: OleVariant): wordbool;

cmdID – это строка идентификатор команды (в нашем примере 'bold' заставляет редактор переключаться между жирным и обычным начертанием текста); полный список команд смотри в приложении.

ShowUI – Show User Interface - показывать интерфейс пользователя (если таковой имеется, как правило это различные диалоговые окна). Если параметр равен False, то команда выполняется без предупреждения.

value – содержит дополнительную информацию в зависимости от команды.

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

Text - Содержит текст выделения (без тегов HTML)

HTMLText - Полный текст выделения

Код:

Код

moveStart(const unit_: widestring; count: integer)

procedure - Перемещает начальную позицию выделения на count символов вправо (если count<0, то влево), unit_-единицы измерения смещения (чаще всего используется 'character': 1 символ). При этом конечная позиция не смещается.

Код:

Код

moveStart(const unit_: widestring; count: integer)

То же самое, только для конечной позиции выделения.

Код:

Код

PasteHTML(const html: widestring);

Вставляет HTML-строку

Код:

Код

CommandShowHelp(cmdID: widestring);

Отображает помощь по команде, указанной в cmdID

Пожалуй, на сегодня всё. Об остальных объектах (картинки, таблицы, элементы управления) поговорим в другой раз. Будут вопросы - пишите: [email=samum2000@mail15.com?subject=Question about visualhtml part1]samum2000@mail15.com[/email].

Приложение. Доступные команды:

BackColor - Устанавливает или получает цвет фона текущего выделения. Value должно содержать имя цвета или его шеснадцитиричный RGB эквивалент (например, #FFCC00).
Bold - Переключает начертание текста текущего выделения между полужирным и нормальным.
Copy - Копирует выделение в буфер обмена
CreateBookmark - Получает имя якоря или создает его для текущего выделения. Value - строка, содержащая имя якоря.
CreateLink - Получает URL ссылки или создает новую ссылку. Параметр Value должен содержать URL.
Cut - Вырезает текущее выделение в буфер обмена.
Delete - Очищает текущее выделение (удаляет всё его содержимое).
Find - Находит текст, заданный в параметре Value в текущем выделении.
FontName - Устанавливает шрифт для текущего выделения. Value содержит описание этого шрифта (как в теге FONT).
FontSize - Устанавливает размер шрифта. Value - число от 1 до 7 включительно.
ForeColor - Устанавливает цвет текста. Value должно содержать имя цвета или его шеснадцитиричный RGB эквивалент (например, #FFCC00)
FormatBlock - Устанавливает или получает форматирование текущего блока. Value может содержать теги-описатели.
Indent - Увеличивает отступ выделенного текста на одну единицу приращения
InsertButton - Перезаписывает идентификатор кнопки вместо текущего выделения. Value - строка, содержащая идентификатор кнопки.
InsertFieldset - То же для поля ввода.
InsertHorizontalRule - То же для горизонтальной полосы.
InsertIFrame - То же для встроеных фреймов (IFRAME).
InsertImage - То же для изображений.
InsertInputButton - То же для кнопки.
InsertInputCheckbox - То же для чекбоксов (checkBox).
InsertInputFileUpload - То же для элемента выбора файла.
InsertInputHidden - То же для скрытого поля (hidden)
InsertInputImage - То же для изображения.
InsertInputPassword - То же для поля ввода пароля.
InsertInputRadio - То же для радио-кнопок (Radio)
InsertInputReset - То же для кнопки reset.
InsertInputSubmit - То же для кнопки Submit.
InsertInputText - То же для поля ввода текста.
InsertParagraph - Вставляет новый раздел (абзац).
InsertOrderedList - Переключает стиль текущего выделения между списком и простым текстом.
InsertUnorderedList - То же самое.
InsertSelectDropdown - Записывает элемент Drop-down вместо текущего выделения. Value должно содержать идентификатор элемента.
InsertTextArea - То же для элемента TextArea.
Italic - Переключает начертание текста текущего выделения между наклонным и обычным.
JustifyCenter - Устанавливает выравнивание по центру для всего блока, в котором расположено текущее выделение.
JustifyLeft - Устанавливает выравнивание по левому краю для всего блока, в котором расположено текущее выделение.
JustifyRight - Устанавливает выравнивание по правому краю для всего блока, в котором расположено текущее выделение.
Outdent - Уменьшает отступ для всего блока, в котором расположено выделение, на одну единицу.
OverWrite - Переключается между режимами вставки текста и замены текста при вводе. Value: true - замена, false - вставка.
Paste - Вставляет текст из буфера обмена вместо текущего выделения.
Refresh - Обновляет текущий документ.
RemoveFormat - Удаляет из текущего фрагмента все теги форматирования
SelectAll - Выделяет все содержимое документа.
UnBookmark - Удаляет все закладки из текущего выделения.
Underline - Переключает начертание текста текущего выделения между подчеркнутым и обычным.
Unlink - Удаляет все гиперссылки из текущего выделенного фрагмента.
Unselect - Снимает выделение.

Для программирования расширенных хранимых процедур Microsoft предоставляет ODS (Open Data Service) API набор макросов и функций, используемых для построения серверных приложений позволяющих расширить функциональность MS SQL Server 2000.

---

Расширенные хранимые процедуры - это обычные функции написанные на С/C++ с применением ODS API и WIN32 API, оформленные в виде библиотеки динамической компоновки (dll) и призванные, как я уже говорил, расширять функциональность SQL сервера. ODS API предоставляет разработчику богатый набор функций позволяющих передавать данные клиенту, полученные от любых внешних источников данных (data source) в виде обычных наборов записей (record set). Так же, extended stored procedure может возвращать значения через переданный ей параметр (OUTPUT parametr).

Как работают расширенные хранимые процедуры.

* Когда клиентское приложение вызывает расширенную хранимую процедуру, запрос передаётся в TDS формате через сетевую библиотеку Net-Libraries и Open Data Service ядру MS SQL SERVER.
* SQL Sever находит dll библиотеку ассоциированную с именем расширенной хранимой процедуры и загружает её в свой контекст, если она не была загружена туда ранее, и вызывает расширенную хранимую процедуру, реализованную как функцию внутри dll.
* Расширенная хранимая процедура выполняет на сервере необходимые ей действия и передаёт набор результатов клиентскому приложению, используя сервис предоставляемый ODS API.


Особенности расширенных хранимых процедур.

* Расширенные хранимые процедуры - это функции выполняющиеся в адресном пространстве MS SQL Server и в контексте безопасности учётной записи под которой запущена служба MS SQL Server;
* После того, как dll библиотека с расширенными хранимыми процедурами была загружена в память, она остаётся там до тех пор, пока SQL Server не будет остановлен, или пока администратор не выгрузит её принудительно, используя команду :
DBCC DLL_name (FREE).
* Расширенная хранимая процедура запускается на выполнение так же, как и обычная хранимая процедура:
EXECUTE xp_extendedProcName @param1, @param2 OUTPUT
@param1 входной параметр
@param2 входной/выходной параметр


Внимание!
Так как расширенные хранимые процедуры выполняются в адресном пространстве процесса службы MS SQL Server, любые критические ошибки, возникающие в их работе, могут вывести из строя ядро сервера, поэтому рекомендуется тщательно протестировать Вашу DLL перед установкой на рабочий сервер.

Создание расширенных хранимых процедур.

Расширенная хранимая процедура эта функция имеющая следующий прототип:

Код

SRVRETCODE xp_extendedProcName (SRVPROC * pSrvProc);

Параметр pSrvProc указатель на SRVPROC структуру, которая является описателем (handle) каждого конкретного клиентского подключения. Поля этой структуры недокументированны и содеражат информацию, которую библиотека ODS использует для управления коммуникацией и данными между серверным приложением (Open Data Services server application) и клиентом. В любом случае, Вам не потребуется обращаться к этой структуре и тем более нельзя модифицоравать её. Этот параметр требуется указывать при вызове любой функции ODS API, поэтому в дальнейшем я небуду останавливаться на его описании.
Использование префикса xp_ необязательно, однако существует соглашение начинать имя расширенной хранимой процедуры именно так, чтобы подчеркнуть отличие от обычной хранимой процедуры, имена которых, как Вы знаете, принято начинать с префикса sp_.
Так же следует помнить, что имена расширенных хранимых процедур чувствительны к регистру. Не забывайте об этом, когда будете вызвать расширенную хранимую процедуру, иначе вместо ожидаемого результата, Вы получите сообщение об ошибке.
Если Вам необходимо написать код инициализации/деинициализации dll, используйте для этого стандартную функцию DllMain(). Если у Вас нет такой необходимости, и вы не хотите писать DLLMain(), то компилятор соберёт свою версию функции DLLMain(), которая ничего не делает, а просто возвращает TRUE. Все функции, вызываемые из dll (т.е. расширенные хранимые процедуры) должны быть объявлены, как экспортируемые. Если Вы пишете на MS Visual C++ используйте директиву __declspec(dllexport). Если Ваш компилятор не поддерживает эту директиву, опишите экспортируемую функцию в секции EXPORTS в DEF файле.
Итак, для создания проекта, нам понадобятся следующие файлы:

* Srv.h заголовочный файл, содержит описание функций и макросов ODS API;
* Opends60.lib файл импорта библиотеки Opends60.dll, которая и реализует весь сервис предоставляемый ODS API.

Microsoft настоятельно рекомендует, чтобы все DLL библиотеки реализующие расширенные хранимые процедуры экспортировали функцию:

Код

__declspec(dllexport) ULONG __GetXpVersion()
{
return ODS_VERSION;
}

Когда MS SQL Server загружает DLL c extended stored procedure, он первым делом вызывает эту функцию, чтобы получить информацию о версии используемой библиотеки.

Для написания своей первой extended stored procedure, Вам понадобится установить на свой компьютер:

- MS SQL Server 2000 любой редакции (у меня стоит Personal Edition). В процесе инсталляции обязательно выберите опцию source sample
- MS Visual C++ (я использовал версию 7.0 ), но точно знаю подойдёт и 6.0

Установка SQL Server -a нужна для тестирования и отладки Вашей DLL. Возможна и отладка по сети, но я этого никогда не делал, и поэтому установил всё на свой локальный диск. В поставку Microsoft Visual C++ 7.0 редакции Interprise Edition входит мастер Extended Stored Procedure DLL Wizard. В принципе, ничего сверх естественного он не делает, а только генерирует заготовку шаблон расширенной хранимой процедуры. Если Вам нравятся мастера, можете использовать его. Я же предпочитаю делать всё ручками, и поэтому не буду рассматривать этот случай.

Теперь к делу:
- Запустите Visual C++ и создайте новый проект - Win32 Dynamic Link Library.
- Включите в проект заголовочный файл - #include <srv.h>;
- Зайдите в меню Tools => Options и добавьте пути поиска include и library файлов. Если , при установке MS SQL Server, Вы ничего не меняли, то задайте:

- C:Program FilesMicrosoft SQL Server80ToolsDevToolsInclude для заголовочных файлов;
- C:Program FilesMicrosoft SQL Server80ToolsDevToolsLib для библиотечных файлов.
- Укажите имя библиотечного файла opends60.lib в опциях линкера.

На этом подготовительный этап закончен, можно приступать к написанию своей первой extended stored procedure.

Постановка задачи.

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

Разработать расширенную хранимую процедуру для MS SQL Server 2000, которая получает полный список пользователей зарегистрированных в домене, и возвращает его клиенту в виде стандартного набора записей (record set). В качестве первого входного параметра функция получает имя сервера содержащего базу данных каталога (Active Directory), т.е имя контролера домена. Если этот параметр равен NULL, тогда необходимо передать клиенту список локальных групп. Второй параметр будет использоваться extended stored procedure для возварата значения результата успешной/неуспешной работы (OUTPUT параметр). Если, расширенная хранимая процедура выполнена успешно, тогда необходимо передать количество записей возвращённых в клиентский record set , если в процессе работы не удалось получить требуемую информацию, значение второго параметра необходимо установить в -1, как признак неуспешного завершения.

Условный прототип расширенной хранимой процедуры следующий:

Код

xp_GetUserList(@NameServer varchar[15], @CountRec int OUTPUT);

.
А вот шаблон расширенной хранимой процедуры, который нам предстоит наполнить содержанием:

Код

#include <windows.h>
#include <srv.h>
#define XP_NOERROR 0
#define XP_ERROR -1


__declspec(dllexport) SERVRETCODE xp_GetGroupList(SRVPROC* pSrvProc)
{

//Проверка кол-ва переданных параметров

//Проверка типа переданных параметров

//Проверка, является ли параметр 2 OUTPUT параметром

//Проверка, имеет ли параметр 2 достаточную длину для сохранения значения

//Получение входных параметров

//Получение списка пользователей

// Посылка полученных данных клиенту в виде стандартного набора записей (record set)

//Установка значения OUTPUT параметра

return (XP_NOERROR);
}

Работа с входными параметрами

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

Первое действие, которое должна выполнить наша exteneded stored procedure , - получить параметры, которые были переданы ей при вызове. Следуя приведённому выше алгоритму нам необходимо выполнить следующие действия:

- Определить кол-во переданных параметров;
- Убедится, что переданные параметры имеют верный тип данных;
- Убедиться, что указанный OUTPUT параметр имеет достаточную длину, для сохранения в нём значения возвращаемого нашей extended stored procedure.
- Получить переданные параметры;
- Установить значения выходного параметра как результат успешного/неуспешного завершения работы extended stored procedure .

Теперь рассмотрим подробно каждый пункт:

Определение количества переданных в расширенную хранимую процедуру параметров

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

Код

int srv_rpcparams ( SRV_PROC * srvproc );

.
При успешном завершении функция возвращает количество переданных в расширенную хранимую процедуру параметров. Если extended stored procedure была вызвана без параметров - srv_rpcparams ввернёт -1. Параметры могут быть переданы по имени или по позиции (unnamed). В любом случае, нельзя смешивать эти два способа. Попытка передачи в функцию входных параметров по имени и по позиции одновременно - приведёт к возникновению ошибки, и srv_rpcparams вернёт 0 .

[pagebreak]

Определение типа данных и длины переданых параметров

Для получения информации о типе и длине переданных параметров Microsoft рекомендует использовать функцию srv_paramifo. Эта универсальная функция заменяет вызовы srv_paramtype, srv_paramlen, srv_parammaxlen, которые теперь считаются устаревшими. Вот её прототип:

Код

int srv_paraminfo (
SRV_PROC * srvproc,
int n,
BYTE * pbType,
ULONG* pcbMaxLen,
ULONG * pcbActualLen,
BYTE * pbData,
BOOL * pfNull );

.
.
.
.
.
.
.
.
.
.
pByte - указатель на переменную получающую информацию о типе входного параметра;
pbType задаёт порядковый номер параметра. Номер первого параметра начинается с 1.
pcbMaxLen - указатель на переменную, в которую функция заносит максимальное значение длины параметра. Это значение обусловлено конкретным типом данных переданного параметра, его мы и будем использовать, чтобы убедиться втом, что OUTPUT параметр имеет достаточную длину для сохранения передаваемых данных.
pcbActualLen указатель на реальную длину параметра переданного в расширенную хранимую процедуру при вызове. Если передаваемый параметр имеет нулевую длину, а флаг pfNull устанавлен в FALSE то (* pcbActualLen) ==0.
pbData - указатель на буфер, память для которого должна быть выделена перед вызовом srv_paraminfo. В этом буфере функция размещает полученные от extended stored procedure входные параметры. Размер буфера в байтах равен значению pcbMaxLen. Если этот параметр установлен в NULL, данные в буфер не записываются, но функция корректно возвращает значения *pbType, *pcbMaxLen, *pcbActualLen, *pfNull. Поэтому вызывать srv_paraminfo нужно дважды: сначала с pbData=NULL, потом, выделив необходимый размер памяти под буфер равный pcbActualLen, вызвать srv_paraminfo второй раз, передав в pbData указатель на выделенный блок памяти.
pfNull указатель на NULL-флаг. srv_paraminfo устанавливает его в TRUE, если значение входного параметра равно NULL.

Проверка, является ли второй параметр OUTPUT параметром.

Функция srv_paramstatus() предназначена для определения статуса переданного параметра:

Код

int srv_paramstatus (
SRV_PROC * srvproc,
int n
);

.
.
.
.
.
n - номер параметра переданного в расширенную хранимую процедуру при вызове. Напомню: параметры всегда нумеруются с 1.
Для возврата значения, srv_paramstatus использует нулевой бит. Если он установлен в 1 переданный параметр является OUTPUT параметром, если в 0 обычным параметром, переданным по значению. Если, exteneded stored procedure была вызвана без параметров, функция вернёт -1.

Установка значения выходного параметра.

Выходному параметру, переданному в расширеную хранимую можно передать значение используя функцию srv_paramsetoutput. Эта новая функция заменяет вызов функции srv_paramset, которая теперь считается устаревашай, т.к. не поддерживает новые типы данных введённые в ODS API и данные нулевой длины.

Код

int srv_paramsetoutput (
SRV_PROC * srvproc,
int n,
BYTE * pbData,
ULONG cbLen,
BOOL fNull
);

.
.
.
.
.
.
.
.
n - порядковый номер параметра, которому будет присвоено новое значение. Это должен быть OUTPUT параметр.
pbData указатель на буфер с данными, которые будут посланы клиенту для установки значения выходного параметра.
cbLen длина буфера посылаемых данных. Если тип данных переданного OUTPUT параметра определяет данные постоянной длины и не разрешает хранение значения NULL (например SRVBIT или SRVINT1), то функция игнорирует параметр cbLen. Значение cbLen=0 указывает на данные нулевой длины, при этом парметр fNull должен быть установлен в FALSE.
fNull установите этот его в TRUE, если возвращаемому параметру необходимо присвоить значение NULL, при этом значение cbLen должно быть равно 0, иначе функция завершится с ошибкой. Во всех остальных случаях fNull=FALSE.
В случае успешного завершения функция возвращает SUCCEED. Если возвращаемое значение равно FAIL, значит вызов был неудачным. Всё просто и понятно
Теперь мы достаточно знаем, для того чтобы написать свою первую расширенную хранимую процедуру, которая будет возвращать значение через переданный ей параметр.Пусть, по сложившейся традиции, это будет строка Hello world! Отладочну версию примера можно скачать здесь.

Код

#include <srv.h>

#define XP_NOERROR 0
#define XP_ERROR 1

#define MAX_SERVER_ERROR 20000
#define XP_HELLO_ERROR MAX_SERVER_ERROR+1

void printError (SRV_PROC*, CHAR*);

#ifdef __cplusplus
extern "C" {
#endif

SRVRETCODE __declspec(dllexport) xp_helloworld(SRV_PROC* pSrvProc);

#ifdef __cplusplus
}
#endif

SRVRETCODE xp_helloworld(SRV_PROC* pSrvProc)
{
char szText[13] = "Hello World!";
BYTE bType;
ULONG cbMaxLen;
ULONG cbActualLen;
BOOL fNull;

/* Определение количества переданных в расширенную хранимую
процедуру параметров */
if (srv_rpcparams(pSrvProc) != 1)
{
printError(pSrvProc, "Не верное количество параметров!");
return (XP_ERROR);
}

/* Получение информации о типе данных и длине переданых параметров */
if (srv_paraminfo(pSrvProc, 1, &bType, &cbMaxLen,
&cbActualLen, NULL, &fNull) == FAIL)
{
printError (pSrvProc,
"Не удаётся получить информацию о входных параметрах ...");
return (XP_ERROR);
}

/* Проверяем, является ли переданный параметр OUTPUT параметром */
if ((srv_paramstatus(pSrvProc, 1) & SRV_PARAMRETURN) == FAIL)
{
printError (pSrvProc,
"Переданный параметр не является OUTPUT параметром!");
return (XP_ERROR);
}

/* Проверяем тип данных переданного параметра */
if (bType != SRVBIGVARCHAR && bType != SRVBIGCHAR)
{
printError (pSrvProc, "Не верный тип переданного параметра!");
return (XP_ERROR);
}

/* Убедимся, что переданный параметр имеет достаточную длину для сохранения возвращаемой строки */
if (cbMaxLen < strlen(szText))
{
printError (pSrvProc,
"Передан параметр не достаточной длины для сохранения n возвращаемой строки!");
return (XP_ERROR);
}

/* Устаналиваем значение OUTPUT параметра */
if (FAIL == srv_paramsetoutput(pSrvProc, 1, (BYTE*)szText, 13, FALSE))
{
printError (pSrvProc,
"Не могу установить значение OUTPUT параметра...");
return (XP_ERROR);
}

srv_senddone(pSrvProc, (SRV_DONE_COUNT | SRV_DONE_MORE), 0, 1);
return (XP_NOERROR);
}

void printError (SRV_PROC *pSrvProc, CHAR* szErrorMsg)
{
srv_sendmsg(pSrvProc, SRV_MSG_ERROR, XP_HELLO_ERROR, SRV_INFO, 1,
NULL, 0, 0, szErrorMsg,SRV_NULLTERM);

srv_senddone(pSrvProc, (SRV_DONE_ERROR | SRV_DONE_MORE), 0, 0);
}

. Не рассмотренными остались функции srv_sendmsg и srv_senddone. Функция srv_sendmsg используется для посылки сообщений клиенту. Вот её прототип:

Код

int srv_sendmsg (
SRV_PROC * srvproc,
int msgtype,
DBINT msgnum,
DBTINYINT class,
DBTINYINT state,
DBCHAR * rpcname,
int rpcnamelen,
DBUSMALLINT linenum,
DBCHAR * message,
int msglen
);

msgtype определяет тип посылаемого клиенту сообщения. Константа SRV_MSG_INFO обозначает информационное сообщение, а SRV_MSG_ERROR сообщение об ошибке;
msgnum номер сообщения;
class - степень тяжести возникшей ошибки. Информационные сообщения имеют значение степени тяжести меньшее или равное 10;
state номер состояния ошибки для текущего сообщения. Этот параметр предоставляет информацию о контексте возникшей ошибки. Допустимые значения лежат в диапазоне от 0 до 127;
rpcname в настоящее время не используется;
rpcnamelen - в настоящее время не используется;
linenum здесь можно указать номер строки исходного кода. По этому значению, в последствие будет легко установить в каком месте возникла ошибка. Если Вы не хотите использовать эту возможность, тогда установите linenum в 0;
message указатель на строку посылаемую клиенту;
msglen определяет длину в байтах строки сообщения. Если это строка заканчивается нулевым символом, то значение этого параметра можно установить равным SRV_NULLTERM.
Возвращаемыме значения:
- в случае успеха SUCCEED
- при неудаче FAIL.

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

Код

int srv_senddone (
SRV_PROC * srvproc,
DBUSMALLINT status,
DBUSMALLINT info,
DBINT count
);

status - статус флаг. Значение этого параметра можно задавать использую логические операторы AND и OR для комбинирования констант приведённых в таблице:
Status flag Описание
SRV_DONE_FINAL Текущий набор результатов является окончательным;
SRV_DONE_MORE Текущий набор результатов не является окончательным следует ожидать очердную порцию данных;
SRV_DONE_COUNT Параметр count содержит верное значение
SRV_DONE_ERROR Используется для уведомления о возникновении ошибок и немедленном завершении.
into зарезервирован, необходимо установить в 0.
count количество результирующих наборов данных посылаемых клиенту. Если флаг status установлен в SRV_DONE_COUNT, то count должен содержать правильное количество посылаемый клиенту наборв записей.
Возвращаемыме значения:
- в случае успеха SUCCEED
- при неудаче FAIL.

Установка расширенных хранимых процедур на MS SQL Server 2000

1.Скопируйте dll библиотеку с расширенной хранимой процедурой в каталог binn на машине с установленным MS SQL Server. У меня этот путь следующий: C:Program FilesMicrosoft SQL ServerMSSQLBinn;
2.Зарегистрирйте расширенную хранимую процедуру на серверt выполнив следующий скрипт:

Код

USE Master
EXECUTE SP_ADDEXTENDEDPROC xp_helloworld, xp_helloworld.dll
Протестируйте работу xp_helloworld, выполнив такой скрипт:
Код:
DECLARE @Param varchar(33)
EXECUTE xp_helloworld @Param OUTPUT
SELECT @Param AS OUTPUT_Param

Заключение

На этом первая часть моей статьи закончена. Теперь я уверен Вы готовы справиться с нашим техническим заданием на все 100%. В следующей статье Вы узнаете:
- Типы данных определённые в ODS API;
- Особенности отладки расширенных хранимых процдур;
- Как формировать recordset-ы и передавать их клиентскому приложению;
- Чстично мы рассмотрим функции Active Directory Network Manegment API необходимые для получения списка доменных пользователей;
- Создадим готовый проект (реализуем наше техническое задание)
Надеюсь - до скорой встречи!

Реферал - это url, с которого посетитель приходит на ваш сайт. К примеру, на странице http://www.site.com/links.html есть ссылка на ваш сайт. Если человек нажмет на нее, то он попадет на ваш сайт. Тогда url http://www.site.com/links.html будет вашим рефералом. Каждому владельцу ресурса не будет лишним знать, откуда именно заходят посетители на его сайт. Для тех, кому интересно решение данной проблемы (задачи) с помощью PHP, и посвящена данная статья.

---

Не спорю, что у любой уважающей себя CMS (content management system, система управления содержанием) есть модули (боты), которые отвечают за сбор статистики. Для тех же, у кого на сайте не стоит CMS, есть возможность попрактиковаться в написании и конфигурировании собственного мини-модуля статистики.

Его можно реализовать в небольшом скрипте, который будет отслеживать нажатия на ссылки, записывать их URL'ы в базу данных (в нашем примере это MySQL) и генерировать статистику в виде графика. Да и поможет разобраться, как это все работает на самом деле, не копаясь в модулях сторонних разработчиков.

Нам потребуется три файла:

* referer.sql (запрос к БД на создание таблицы, где будет храниться статистика);
* referer.php (сам скрипт);
* viewreferer.php (скрипт для просмотра статистики).

Для создания таблицы referer необходимо выполнить запрос referer.sql. Вот его содержание:

Код

CREATE TABLE referer (
url varchar(100) NOT NULL,
hits int(10) DEFAULT '0' NOT NULL,
PRIMARY KEY (url)
);

Теперь займемся файлом referer.php. Зададим значения переменным:

PHP - Код

$hostname = "localhost"; // предоставляется вашим хостером. 
//В большинстве случаев это - localhost (иногда бывает 127.0.0.1)
$username = "your-username"; // имя пользователя - ваш 
//логин для подключения к базе данных
$password = "your-password"; // вы должны получить его 
//у своего хостинг-провайдера
$userstable = "referer"; // таблица, в которой будут 
//храниться результаты работы нашего скрипта
$dbName = "your-db-name"; // имя БД, в которой 
//содержится таблица referer

.
.
.
.
.
.
.
.
.
.
.
.
В переменную $ref заносим информацию о ссылке-реферере:

PHP - Код

$ref = strtolower($HTTP_REFERER);

.
.
С помощью функции strtolower переводим значение переменной $ref в нижний регистр. Это делается для того, чтобы ссылки типа www.site.com, www.Site.com или WWW.SITE.COM были одинакового регистра.

Если переменная $ref не пустая,

PHP - Код

if(!empty($ref)){

.
.
то подключаемся к БД:

PHP - Код

mysql_connect($hostname,$username, $password) or die(mysql_error());
mysql_select_db("$dbName") or die(mysql_error());

Производим выборку из столбца url, значение которого совпадает с $ref

PHP - Код

$query = "select * from $userstable where url = '$ref'";

Переменная $rows содержит количество совпадений

PHP - Код

$result = mysql_query($query);
$rows = mysql_num_rows($result);

.
.
.
Если же не найдено ни одной записи (т.е c такого url'a еще не было рефералов)

PHP - Код

if ($rows == 0){

устанавливаем значение переменной $hits в "1"

PHP - Код

$hits = "1";

.
.
А далее просто выполняем вставку url'а и переменной $hits в нашу таблицу (referer):

PHP - Код

$query1 = " into $userstable (url,hits) values('$ref','$hits')";

Выполняем запрос:

PHP - Код

mysql_query($query1);
}

.
.
.
Если же были найдены записи по данному url (т.е c этого url'a уже заходили рефералы),

PHP - Код

else {
$hitquery = "select hits from $userstable where url = '$ref'";
$result2 = mysql_query($hitquery);
$row = mysql_fetch_array($result2);
$hits = $row["hits"];

Инкрементируем значение переменной $hits (увеличиваем на "1")

PHP - Код

$query2 = "update $userstable set hits = hits+1 where url = '$ref'";
mysql_query($query2);>
}
}

.
.
.
.
.
.
В ту страницу сайта, для которой необходима статистика по рефералам (как правило - это главная страница, index.php), необходимо вставить ссылку на скрипт referer.php. Предполагается, что файлы referer.php и index.php находятся в одной папке.

PHP - Код

include("referer.php");

.
.
.
На этом и заканчивается содержимое скрипта referer.php. Но, как я написал выше, есть также и графическая статистика. Это будет наш третий файл - viewreferer.php.

Задаем переменные для подключения к БД:

PHP - Код

$hostname = "localhost";
$username = "your-username";
$password = "your-password";
$userstable = "referer";
$dbName = "your-db-name";

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

PHP - Код

$color10 = "#FFFF00";
$color20 = "#FF0000";
$color50 = "#008000";
$color1k = "#0000FF";
$color2k = "#0000A0";
$color5k = "#000040";

Опять соединяемся с БД:

PHP - Код

mysql_connect($hostname, $username,$password) or die(mysql_error());
mysql_select_db("$dbName") or die(mysql_error());

Делаем выборку из БД и упорядочиваем ее по убыванию (desc) количества хитов (столбец hits).

PHP - Код

$query = "select * from $userstable order by hits desc";
$result = mysql_query($query);

Подсчитываем количество строк с уникальными рефералами (это попросту число строк в нашей таблице referer).

PHP - Код

$number = mysql_num_rows($result) or die (mysql_error());
$i = 0;

.
.
.
Если же не найдено ни одной записи (таблица пуста), то выводим сообщение:

PHP - Код

if ($number == 0) {
echo "<center><p><b>Сведений о рефералах не обнаружено!</b></center>";
}

Если же рефералы есть:
elseif ($number >= 1) {
while ($i < $number){
$row = mysql_fetch_array($result);
$hits = $row["hits"];
$ref = $row["url"];

Выбираем цвет для текущего значения hits:

PHP - Код

if ($hits <10){
$color = "$color10";
}
elseif (($hits >= 10 )
and ($hits < 20)){
$color = "$color20";
}
elseif (($hits >= 20 )
and ($hits < 50)){
$color = "$color50";
}
elseif (($hits >= 50 )
and ($hits < 100)){
$color = "$color1k";
}
elseif (($hits >= 100 )
and ($hits < 200)){
$color = "$color2k";
}
elseif ($hits >= 200){
$color = "$color5k";
}

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

PHP - Код

echo "<div align="left">";
echo "<table cols=3 border="0" width="100%">
<tr><td align=left width="400"><b>
<a href="$ref">$ref</a></b></td>";
echo "<td align=right width="60"><b>$hits</b></td>";
echo "<td align=left width="$hits" bgcolor="$color"> </td></tr>";
$i++;
echo "</table>n";
}
}

.
.
.
.
.
.
.
.
.
.
.
Итак, все готово! Теперь можно периодически вызывать скрипт viewreferer.php и смотреть графическую статистику переходов на ваш сайт.

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

---

Так как "работа кипит", я хотел бы отреагировать на изменение ItemIndex несколько позднее, например, 100 миллисекунд спустя. Вот что у меня получилось. На простой форме располагаем компоненты ComboBox и Label. Необходимым дополнением является вызов Application.ProcessMessages, позволяющий избежать замедления работы PC, когда очередь сообщений для формы пуста.

Код

unit Unit1;

interface

uses

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

StdCtrls;

const

// Просто некоторая константа сообщения
PM_COMBO = WM_USER + 8001;

// 500 миллисекунд
CWantedDelay = 500;

type

TForm1 = class(TForm)
ComboBox1: TComboBox;
Label1: TLabel;
procedure ComboBox1(Sender: TObject);
private
procedure PMCombo(var message : TMessage); message PM_COMBO;
public
end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ComboBox1(Sender: TObject);
begin

PostMessage(Handle, PM_COMBO, 0, 0);
end;

procedure TForm1.PMCombo(var message : TMessage);
const

InProc : BOOLEAN = FALSE;
StartTick : LONGINT = 0;
begin

if InProc then begin
// Обновляем стартовое время задержки
StartTick := GetTickCount;

end else begin
// Организация цикла
InProc := TRUE;

// Инициализация стартового времени
StartTick := GetTickCount;

// Ожидаем истечения стартового времени.
// Пока стартовое время не исчерпалось, позволяем операционной системе обрабатывать сообщения
while GetTickCount - StartTick < CWantedDelay do Application.ProcessMessages;

// Иллюстративное приращение счетчика, задающее некоторую реальную работу обработчику события On
Label1.Caption := IntToStr ( StrToIntDef ( Label1.Caption, 0 ) + 1);

// Завершение цикла
InProc := FALSE;
end;
end;

end.

Интересно, есть ли технология преобразования Wave-формата в обычный набор звуковых данных? К примеру, мне необходимо удалить заголовок и механизм (метод) сжатия, которые могут компилироваться и сохраняться вместе с Wave-файлами.

---

Код

unit LinearSystem;

interface

{============== Тип, описывающий формат WAV ==================}
type WAVHeader = record

nChannels : Word;
nBitsPerSample : LongInt;
nSamplesPerSec : LongInt;
nAvgBytesPerSec : LongInt;
RIFFSize : LongInt;
fmtSize : LongInt;
formatTag : Word;
nBlockAlign : LongInt;
DataSize : LongInt;
end;

{============== Поток данных сэмпла ========================}
const MaxN = 300; { максимальное значение величины сэмпла }
type SampleIndex = 0 .. MaxN+3;
type DataStream = array[ SampleIndex ] of Real;

var N : SampleIndex;

{============== Переменные сопровождения ======================}
type Observation = record

Name : String[40]; {Имя данного сопровождения}
yyy : DataStream; {Массив указателей на данные}
WAV : WAVHeader; {Спецификация WAV для сопровождения}
Last : SampleIndex; {Последний доступный индекс yyy}
MinO, MaxO : Real; {Диапазон значений yyy}
end;

var K0R, K1R, K2R, K3R : Observation;

K0B, K1B, K2B, K3B : Observation;

{================== Переменные имени файла ===================}
var StandardDatabase : String[ 80 ];

BaseFileName : String[ 80 ];
StandardOutput : String[ 80 ];
StandardInput : String[ 80 ];

{=============== Объявления процедур ==================}
procedure ReadWAVFile (var Ki, Kj : Observation);
procedure WriteWAVFile (var Ki, Kj : Observation);
procedure ScaleData (var Kk : Observation);
procedure InitAllSignals;
procedure InitLinearSystem;


implementation
{$R *.DFM}
uses VarGraph, SysUtils;

{================== Стандартный формат WAV-файла ===================}
const MaxDataSize : LongInt = (MaxN+1)*2*2;
const MaxRIFFSize : LongInt = (MaxN+1)*2*2+36;
const StandardWAV : WAVHeader = (

nChannels : Word(2);
nBitsPerSample : LongInt(16);
nSamplesPerSec : LongInt(8000);
nAvgBytesPerSec : LongInt(32000);
RIFFSize : LongInt((MaxN+1)*2*2+36);
fmtSize : LongInt(16);
formatTag : Word(1);
nBlockAlign : LongInt(4);
DataSize : LongInt((MaxN+1)*2*2)
);


{================== Сканирование переменных сопровождения ===================}


procedure ScaleData(var Kk : Observation);
var I : SampleIndex;
begin


{Инициализация переменных сканирования}
Kk.MaxO := Kk.yyy[0];
Kk.MinO := Kk.yyy[0];


{Сканирование для получения максимального и минимального значения}
for I := 1 to Kk.Last do
begin
if Kk.MaxO < Kk.yyy[I] then Kk.MaxO := Kk.yyy[I];
if Kk.MinO > Kk.yyy[I] then Kk.MinO := Kk.yyy[I];
end;
end; { ScaleData }

procedure ScaleAllData;
begin

ScaleData(K0R);
ScaleData(K0B);
ScaleData(K1R);
ScaleData(K1B);
ScaleData(K2R);
ScaleData(K2B);
ScaleData(K3R);
ScaleData(K3B);
end; {ScaleAllData}

{================== Считывание/запись WAV-данных ===================}

VAR InFile, : file of Byte;

type Tag = (F0, T1, M1);
type FudgeNum = record

case X:Tag of
F0 : (chrs : array[0..3] of Byte);
T1 : (lint : LongInt);
M1 : (up,dn: Integer);
end;
var ChunkSize : FudgeNum;

procedure WriteChunkName(Name:String);
var i : Integer;

MM : Byte;
begin

for i := 1 to 4 do
begin
MM := ord(Name[i]);
write(,MM);
end;
end; {WriteChunkName}

procedure WriteChunkSize(LL:Longint);
var I : integer;
begin

ChunkSize.x:=T1;
ChunkSize.lint:=LL;
ChunkSize.x:=F0;
for I := 0 to 3 do Write(,ChunkSize.chrs[I]);
end;

procedure WriteChunkWord(WW:Word);
var I : integer;
begin

ChunkSize.x:=T1;
ChunkSize.up:=WW;
ChunkSize.x:=M1;
for I := 0 to 1 do Write(,ChunkSize.chrs[I]);
end; {WriteChunkWord}

procedure WriteOneDataBlock(var Ki, Kj : Observation);
var I : Integer;
begin

ChunkSize.x:=M1;
with Ki.WAV do
begin
case nChannels of
1:if nBitsPerSample=16
then begin {1..2 Помещаем в буфер одноканальный 16-битный сэмпл}
ChunkSize.up := trunc(Ki.yyy[N]+0.5);
if N<=Ki.Last do WriteOneDataBlock(Ki,Kj); {помещаем 4 байта и увеличиваем счетчик N}


{Освобождаем буфер файла}
CloseFile( );
end; {WriteWAVFile}

procedure InitSpecs;
begin
end; { InitSpecs }

procedure InitSignals(var Kk : Observation);
var J : Integer;
begin

for J := 0 to MaxN do Kk.yyy[J] := 0.0;
Kk.MinO := 0.0;
Kk.MaxO := 0.0;
Kk.Last := MaxN;
end; {InitSignals}

procedure InitAllSignals;
begin
InitSignals(K0R);
InitSignals(K0B);
InitSignals(K1R);
InitSignals(K1B);
InitSignals(K2R);
InitSignals(K2B);
InitSignals(K3R);
InitSignals(K3B);
end; {InitAllSignals}

[pagebreak]

Код

var ChunkName : string[4];

procedure ReadChunkName;
var I : integer;

MM : Byte;
begin

ChunkName[0]:=chr(4);
for I := 1 to 4 do
begin
Read(InFile,MM);
ChunkName[I]:=chr(MM);
end;
end; {ReadChunkName}

procedure ReadChunkSize;
var I : integer;

MM : Byte;
begin

ChunkSize.x := F0;
ChunkSize.lint := 0;
for I := 0 to 3 do
begin
Read(InFile,MM);
ChunkSize.chrs[I]:=MM;
end;
ChunkSize.x := T1;
end; {ReadChunkSize}

procedure ReadOneDataBlock(var Ki,Kj:Observation);
var I : Integer;
begin

if N<=MaxN then
begin
ReadChunkSize; {получаем 4 байта данных}
ChunkSize.x:=M1;
with Ki.WAV do
case nChannels of
1:if nBitsPerSample=16
then begin {1..2 Помещаем в буфер одноканальный 16-битный сэмпл}
Ki.yyy[N] :=1.0*ChunkSize.up;
if N<=MaxN then begin {LastN := N;}
Ki.Last := N;
if Ki.WAV.nChannels=2 then Kj.Last := N;
end
else begin {LastN := MaxN;}
Ki.Last := MaxN;
if Ki.WAV.nChannels=2 then Kj.Last := MaxN;

end;
end;
end; {ReadOneDataBlock}

procedure ReadWAVFile(var Ki, Kj :Observation);
var MM : Byte;

I : Integer;
OK : Boolean;
NoDataYet : Boolean;
DataYet : Boolean;
nDataBytes : LongInt;
begin

if FileExists(StandardInput)
then
with Ki.WAV do
begin { Вызов диалога открытия файла }
OK := True; {если не изменится где-нибудь ниже}
{Приготовления для чтения файла данных}
AssignFile(InFile, StandardInput); { Файл, выбранный в диалоговом окне }
Reset( InFile );


{Считываем ChunkName "RIFF"}
ReadChunkName;
if ChunkName<>'RIFF' then OK := False;


{Считываем ChunkSize}
ReadChunkSize;
RIFFSize := ChunkSize.lint; {должно быть 18,678}


{Считываем ChunkName "WAVE"}
ReadChunkName;
if ChunkName<>'WAVE' then OK := False;


{Считываем ChunkName "fmt_"}
ReadChunkName;
if ChunkName<>'fmt ' then OK := False;


{Считываем ChunkSize}
ReadChunkSize;
fmtSize := ChunkSize.lint; {должно быть 18}


{Считываем formatTag, nChannels}
ReadChunkSize;
ChunkSize.x := M1;
formatTag := ChunkSize.up;
nChannels := ChunkSize.dn;


{Считываем nSamplesPerSec}
ReadChunkSize;
nSamplesPerSec := ChunkSize.lint;


{Считываем nAvgBytesPerSec}
ReadChunkSize;
nAvgBytesPerSec := ChunkSize.lint;


{Считываем nBlockAlign}
ChunkSize.x := F0;
ChunkSize.lint := 0;
for I := 0 to 3 do
begin Read(InFile,MM);
ChunkSize.chrs[I]:=MM;
end;
ChunkSize.x := M1;
nBlockAlign := ChunkSize.up;


{Считываем nBitsPerSample}
nBitsPerSample := ChunkSize.dn;
for I := 17 to fmtSize do Read(InFile,MM);


NoDataYet := True;
while NoDataYet do
begin
{Считываем метку блока данных "data"}
ReadChunkName;


{Считываем DataSize}
ReadChunkSize;
DataSize := ChunkSize.lint;


if ChunkName<>'data' then
begin
for I := 1 to DataSize do {пропуск данных, не относящихся к набору звуковых данных}
Read(InFile,MM);
end
else NoDataYet := False;
end;


nDataBytes := DataSize;
{Наконец, начинаем считывать данные для байтов nDataBytes}
if nDataBytes>0 then DataYet := True;
N:=0; {чтение с первой позиции}
while DataYet do
begin
ReadOneDataBlock(Ki,Kj); {получаем 4 байта}
nDataBytes := nDataBytes-4;
if nDataBytes<=4 then DataYet := False;
end;


ScaleData(Ki);
if Ki.WAV.nChannels=2
then begin Kj.WAV := Ki.WAV;
ScaleData(Kj);
end;
{Освобождаем буфер файла}
CloseFile( InFile );
end
else begin
InitSpecs;{файл не существует}
InitSignals(Ki);{обнуляем массив "Ki"}
InitSignals(Kj);{обнуляем массив "Kj"}
end;
end; { ReadWAVFile }



{================= Операции с набором данных ====================}

const MaxNumberOfDataBaseItems = 360;
type SignalDirectoryIndex = 0 .. MaxNumberOfDataBaseItems;

VAR DataBaseFile : file of Observation;

LastDataBaseItem : LongInt; {Номер текущего элемента набора данных}
ItemNameS : array[SignalDirectoryIndex] of String[40];

procedure GetDatabaseItem( Kk : Observation; N : LongInt );
begin

if N<=LastDataBaseItem
then begin
Seek(DataBaseFile, N);
Read(DataBaseFile, Kk);
end
else InitSignals(Kk);
end; {GetDatabaseItem}
procedure PutDatabaseItem( Kk : Observation; N : LongInt );
begin

if N<=LastDataBaseItem
then begin
Seek(DataBaseFile, N);
Write(DataBaseFile, Kk);
LastDataBaseItem := LastDataBaseItem+1;
end
else while LastDataBaseItem<=N do
begin
Seek(DataBaseFile, LastDataBaseItem);
Write(DataBaseFile, Kk);
LastDataBaseItem := LastDataBaseItem+1;
end
else ReportError(1); {Попытка чтения MaxNumberOfDataBaseItems}
end; {PutDatabaseItem}

procedure InitDataBase;
begin

LastDataBaseItem := 0;
if FileExists(StandardDataBase)
then
begin
Assign(DataBaseFile,StandardDataBase);
Reset(DataBaseFile);
while not EOF(DataBaseFile) do
begin
GetDataBaseItem(K0R, LastDataBaseItem);
ItemNameS[LastDataBaseItem] := K0R.Name;
LastDataBaseItem := LastDataBaseItem+1;
end;
if EOF(DataBaseFile)
then if LastDataBaseItem>0
then LastDataBaseItem := LastDataBaseItem-1;
end;
end; {InitDataBase}

function FindDataBaseName( Nstg : String ):LongInt;
var ThisOne : LongInt;
begin

ThisOne := 0;
FindDataBaseName := -1;
while ThisOne