единица bdeclientdataset;
интерфейс
Использует Windows, Sysutils, варианты, классы, DB, DBCommon, Midas,
SQLTIMST, DBCLIENT, DBLOCAL, PRODIDER, DBTABLES;
тип
{Tbdequery}
Tbdequery = class (tquery)
частный
FkeyFields: String;
защищен
Функция psgetDefaultOrder: tindexDef; переопределить;
конец;
{Tbdeclientdataset}
Tbdeclientdataset = class (tcustomcacheddataset)
частный
Fcommandtext: String;
FcurrentCommand: String;
Fdataset: tbdequery;
Fdatabase: tdatabase;
FlocalParams: Tparams;
Fstreamedactive: логический;
Процедура проверка мастер -учебных действий (Mastersource: TdataSource);
процедура setDetailSactive (значение: логическое);
Функция GetConnection: tdatabase;
функция getDataset: tdataset;
Функция GetMasterSource: tdatasource;
Функция getMasterFields: String;
Процедура setConnection (значение: tdatabase);
процедура setDataSource (значение: tdatasource);
процедура SetLocalParams;
процедура setMasterFields (const value: string);
процедура setParamSfromSQL (const value: string);
процедура setSQL (const value: string);
защищен
Функция getCommandText: String; переопределить;
процедура загружена; переопределить;
Уведомление о процедуре (ACOMPONEONT: TCOMPONENT; Операция: Топирация); переопределить;
процедура SetActive (значение: логическое); переопределить;
процедура setCommAndText (значение: String); переопределить;
публичный
конструктор Create (AOWNER: TCOMPONENT); переопределить;
разрушитель разрушил; переопределить;
процедура клонекурсор (источник: tcustomClientDataset; сброс: логический;
HEASTSETTINGS: BOOLEAN = FALSE); переопределить;
Процедура GetFieldNames (список: tstrings); переопределить;
функция getQuoteChar: String;
Набор данных свойств: tdataset Read GetDataset;
опубликовано
собственность активна;
Свойство CommandText: String Read GetCommandText write setCommandText;
Свойство dbconnection: tdatabase Read GetConnection Write SetConnection;
свойство Masterfields Read Getmasterfields write setmasterfields;
Property MasterSource: tdatasource Read Getmastersource write setdatasource;
конец;
Регистр процедур;
выполнение
использует bdeconst, midconst;
тип
{Tbdecdsparams}
Tbdecdsparams = class (tparams)
частный
FieldName: TStrings;
защищен
процедура parseselect (sql: string);
публичный
конструктор Create (владелец: tpersistent);
Разрушитель разрушил; переопределить;
конец;
конструктор tbdecdsparams.create (владелец: tpersistent);
начинать
унаследован;
FieldName: = tstringlist.create;
конец;
деструктор tbdecdsparams.destroy;
начинать
Freeandnil (fieldname);
унаследован;
конец;
Процедура tbdecdsparams.parseselect (sql: string);
констант
Sselect = 'select';
вар
FwhereFound: логический;
Начало: pchar;
Fname, значение: строка;
SQLTOKEN, Курс, LastToken: TSQLTOKEN;
Парамы: целое число;
начинать
Если pos ('' + ssect + '', нижний регистр (string (pchar (sql) +8)))> 1 затем выйдет; // не может проанализировать подпрограммы
Start: = pchar (parsesql (pchar (sql), true));
Курс: = Stunknown;
LastToken: = Stunknown;
FwhereFound: = false;
PARAMS: = 0;
повторить
повторить
Sqltoken: = nextsqltoken (start, fname, curnesection);
Если sqltoken в [Stwhere], то тогда
начинать
FwhereFound: = true;
LastToken: = Stwhere;
Конец еще, если sqltoken в [sttablename], тогда
начинать
{Проверить на квалифицированное имя таблицы владельца}
Если запустить^ = '.' затем
Nextsqltoken (start, fname, councection);
конец еще
if (sqltoken = stvalue) и (lastToken = stwhere), тогда
SQLTOKEN: = stfieldName;
Если sqltoken в SQLSections, то Crackection: = sqltoken;
до тех пор, пока не Sqltoken в [stfieldname, stend];
Если FwhereFound и (sqltoken в [stfieldname]), то тогда
повторить
Sqltoken: = nextsqltoken (start, значение, курс);
Если sqltoken в SQLSections, то Crackection: = sqltoken;
до тех пор, пока не Sqltoken [stend, stvalue, stisnull, stisnotnull, stfieldname];
Если значение = '? затем
начинать
Fieldname.add (fname);
Inc (Params);
конец;
до (params = count) или (sqltoken в [stend]);
конец;
{Tbdequery}
function tbdequery.psgetDefaultOrder: tindexDef;
начинать
Если fkeyfields = '', то
Результат: = унаследованное psgetdefaultorder
еще
начало // таблица подробной таблицы по умолчанию
Результат: = tindexDef.create (nil);
Result.options: = [ixunique]; // Keyfield уникально
Result.name: = StringReplace (fkeyFields, ';', '_', [rfreplaceall]);
Result.fields: = fkeyFields;
конец;
конец;
{Tbdeclientdataset}
конструктор tbdeclientdataset.create (aowner: tcomponent);
начинать
унаследованное создание (аоаллер);
Fdataset: = tbdequery.create (nil);
Fdataset.name: = self.name + 'DataSet1';
Provider.dataset: = fdataset;
Sqldbtype: = typebde;
FlocalParams: = tparams.create;
конец;
деструктор tbdeclientdataset.destroy;
начинать
Freeandnil (FlocalParams);
Fdataset.close;
Freeandnil (fdataset);
унаследованное уничтожение;
конец;
Процедура tbdeclientdataset.getfieldnames (список: tstrings);
вар
Открыто: логический;
начинать
Открыто: = (Active = false);
пытаться
Если открыто, тогда
Открыть;
унаследован GetfieldNames (список);
окончательно
Если открыть, то закройте;
конец;
конец;
Функция tbdeclientdataset.getCommandtext: String;
начинать
Результат: = fcommandText;
конец;
функция tbdeclientdataset.getDataset: tdataset;
начинать
Результат: = fdataset как tdataset;
конец;
Процедура tbdeclientdataset.checkmastersourceactive (Mastersource: Tdatasource);
начинать
Если назначено (MasterSource) и назначено (mastersource.dataset), тогда
Если не mastersource.dataset.active тогда
DatabaseError (smasternotopen);
конец;
Процедура tbdeclientdataset.setparamsfromsql (const value: string);
вар
Набор данных: TQUERY;
TableName, Tempquery, Q: String;
Список: tbdecdsparams;
Я: целое число;
Поле: Tfield;
начинать
TableName: = getTableNameFromSQL (значение);
Если табличка <> '', тогда
начинать
Tempquery: = value;
Список: = tbdecdsparams.create (self);
пытаться
List.parseselect (tempquery);
List.assignvalues (params);
для i: = 0 к списку. Count - 1 do
Список [i] .paramType: = ptinput;
Набор данных: = tquery.create (nil);
пытаться
DataSet.databaseName: = fdataset.databaseName;
Q: = getQuoteChar;
DataSet.sql.add ('select * from' + Q + tableName + q + 'где 0 = 1'); {не локализовать}
пытаться
DataSet.Open;
для i: = 0 к списку. Count - 1 do
начинать
Если list.ffieldname.count> я тогда
начинать
пытаться
Field: = dataSet.fieldbyName (list.ffieldname [i]);
кроме
Поле: = nil;
конец;
конец еще
Поле: = nil;
Если назначено (поле), то
начинать
Если Field.datatype <> ftString, тогда
Список [i] .datatype: = field.datatype
иначе, если tstringfield (Field) .fixedchar
Список [i] .datatype: = ftfixedchar
еще
Список [i] .datatype: = ftString;
конец;
конец;
кроме
// игнорируйте все исключения
конец;
окончательно
DataSet.free;
конец;
окончательно
Если list.count> 0, тогда
Params.assign (список);
List.free;
конец;
конец;
конец;
Процедура tbdeclientdataset.setsql (const value: string);
начинать
Если назначено (vovider.dataset), то
начинать
Tquery (поставщик.dataset) .sql.clear;
Если значение <> '', тогда
Tquery (поставщик.dataset) .sql.add (значение);
унаследован SetCommandtext (значение);
конец еще
DatabaseError (snodataprovider);
конец;
Процедура tbdeclientdataset.laded;
начинать
унаследован нагружен;
Если fstreamedactive, то
начинать
SetActive (true);
Fstreamedactive: = false;
конец;
конец;
функция tbdeclientdataset.getmasterfields: string;
начинать
Результат: = Унаследованные Masterfields;
конец;
Процедура tbdeclientdataset.setmasterfields (const value: string);
начинать
Унаследованные Masterfields: = значение;
Если значение <> '', тогда
IndexfieldNames: = значение;
Fdataset.fkeyfields: = '';
конец;
Процедура tbdeclientdataset.setCommandText (значение: String);
начинать
унаследован SetCommandtext (значение);
Fcommandtext: = value;
Если нет (CSLoading in ComponentState), тогда
начинать
Fdataset.fkeyfields: = '';
IndexfieldNames: = '';
Masterfields: = '';
IndexName: = '';
IndexDefs.clear;
Params.clear;
if (csdesigning in componentState) и (значение <> '') тогда
SetParamSfromSQL (значение);
конец;
конец;
функция tbdeclientdataset.getConnection: tdatabase;
начинать
Результат: = fdatabase;
конец;
Процедура tbdeclientdataset.setConnection (значение: tdatabase);
начинать
Если значение = fdatabase, затем выйти;
Checkinactive;
Если назначено (значение), то
начинать
Если нет (csloading in componentState) и (value.databasename = '') тогда
База данных (sdatabasenamisising);
Fdataset.databaseName: = value.databaseName;
конец еще
Fdataset.databaseName: = '';
Fdatabase: = значение;
конец;
Функция tbdeclientdataset.getQuotechar: String;
начинать
Результат: = '';
Если назначено (fdataset), тогда
Результат: = fdataset.psgetQuotechar;
конец;
Процедура tbdeclientdataset.clonecursor (источник: tcustomclientdataset; сброс: логический;
HEASTSETTINGS: BOOLEAN = FALSE);
начинать
Если нет (источник - это tbdeclientdataset), то тогда
DatabaseError (sinvalidclone);
Provider.dataset: = tbdeclientdataset (источник) .provider.dataset;
Dbconnection: = tbdeclientdataset (источник) .dbconnection;
CommandText: = tbdeclientDataset (Source) .CommAndText;
унаследованный клонекурсор (источник, сброс, снятия сбоя);
конец;
Процедура tbdeclientdataset.notification (Acomponent: Tcomponent; Операция: Топирация);
начинать
унаследованное уведомление (Acomponent, Operation);
Если операция = OpreMove, тогда
Если acomponent = fdatabase, тогда
начинать
Fdatabase: = nil;
SetActive (false);
конец;
конец;
Процедура tbdeclientdataset.setlocalparams;
Процедура CreateParamsFrommasterFields (Create: Boolean);
вар
Я: целое число;
Список: TStrings;
начинать
Список: = tStringList.create;
пытаться
Если создать, тогда
FlocalParams.clear;
Fdataset.fkeyfields: = Masterfields;
List.commatext: = MasterFields;
для i: = 0 для списка.
начинать
Если создать, тогда
FlocalParams.createParam (ftunknown, mastersource.dataset.fieldbyname (список [i]). Fieldname,
ptinput);
FlocalParams [i] .assignfield (mastersource.dataset.fieldbyname (list [i]));
конец;
окончательно
List.free;
конец;
конец;
начинать
if (masterfields <> '') и назначен (Mastersource) и назначен (masterource.dataset) тогда
начинать
CreateParamsFrommasterFields (True);
FcurrentCommand: = addParamSqlfordetail (FlocalParams, CommandText, True, GetQuoteChar);
конец;
конец;
Процедура tbdeclientdataset.setDataSource (значение: tdataSource);
начинать
Унаследованное Mastersource: = значение;
Если назначено (значение), то
начинать
Если PacketRecords = -1, то PacketRecords: = 0;
конец еще
начинать
Если PacketRecords = 0, то PacketRecords: = -1;
конец;
конец;
Функция tbdeclientdataset.getmastersource: tdatasource;
начинать
Результат: = унаследованный Mastersource;
конец;
Процедура tbdeclientdataset.setDetailSactive (значение: логическое);
вар
Detaillist: tlist;
Я: целое число;
начинать
Detaillist: = tlist.create;
пытаться
GetDetailDatasets (detaillist);
для i: = 0 в detaillist.count -1 do
Если tdataset (detaillist [i]) является tbdeclientdataset, то
Tbdeclientdataset (tdataset (detaillist [i])). Active: = value;
окончательно
Detaillist.free;
конец;
конец;
Процедура tbdeclientdataset.setactive (значение: логическое);
начинать
Если значение, тогда
начинать
Если CSloading в ComponentState, то
начинать
Fstreamedactive: = true;
Выход;
конец;
Если Masterfields <> '', тогда
начинать
Если нет (CSLoading in ComponentState), тогда
Checkmastersourceactive (MasterSource);
SetLocalParams;
SetSQL (fcurrentCommand);
PARAMS: = FLOCALPARAMS;
FetchParams;
конец еще
начинать
Setsql (fcommandtext);
Если Params.count> 0, тогда
начинать
Fdataset.params: = params;
FetchParams;
конец;
конец;
конец;
Если значение и (fdataset.objectView <> ObjectView) тогда
Fdataset.objectView: = ObjectView;
унаследованные setActive (значение);
SetDetailSactive (значение);
конец;
Регистр процедур;
начинать
RegisterComponents ('bde', [tbdeclientdataset]);
конец;
конец.
// 以上经 dblocalb.pas 改装而成, 可存为任意文件名, 当然扩展名是 pas
// 然后安装此控件即可