Unidad BDeclientDataset;
interfaz
Utiliza ventanas, sysutils, variantes, clases, db, dbcommon, midas,
Sqltimst, dbclient, dBlocal, proveedor, dBtables;
tipo
{TbDequery}
TbDequery = class (tQuery)
privado
Fkeyfields: cadena;
protegido
función psgetDefaultOrder: tindexdef; anular;
fin;
{TbDeclientDataSet}
TbDeclientDataSet = class (tcustomCachedDataset)
privado
FCommandText: String;
FcurrentCommand: string;
FDATASET: tbDequery;
FDATABASE: TDATABASE;
Flocalparams: tparams;
Fstreamedactive: booleano;
procedimiento checkmasterstersourCeactive (Mastersource: TDataSource);
procedimiento setDetailSactive (valor: booleano);
función getConnection: tDatabase;
función getDataSet: tdataset;
función getMasterSource: TDataSource;
función getMasterfields: string;
procedimiento setConnection (valor: tdatabase);
procedimiento setDataSource (valor: tDataSource);
procedimiento setLocalParams;
procedimiento setMasterfields (valor const: cadena);
procedimiento setParamsFromsql (valor const: string);
procedimiento setSql (valor const: string);
protegido
función getCommandText: String; anular;
procedimiento cargado; anular;
Notificación del procedimiento (cáculos: TComponente; operación: topación); anular;
procedimiento setActive (valor: boolean); anular;
procedimiento setCommandText (valor: cadena); anular;
público
constructor create (Awner: tComponent); anular;
destructor destruir; anular;
procedimiento clonecursor (fuente: tcustomclientdataset; reinicio: booleano;
Keepsettings: boolean = false); anular;
Procedimiento GetFieldNames (Lista: TStrings); anular;
función getQuotechar: string;
DataSet de propiedades: TDataset Read GetDataSet;
publicado
propiedad activa;
Propiedad ComandoText: cadena Leer getCommandText Write setCommandText;
propiedad dbconnection: tdatabase read getConnection Write setConnection;
Propiedad MasterFields Leer getMasterfields escribe setMasterfields;
Property MasterterSource: TDataSource Read getMastersource Write setDataSource;
fin;
registro de procedimientos;
implementación
usa bdeconst, midconst;
tipo
{TBDecdsParams}
Tbdecdsparams = class (tparams)
privado
Ffieldname: tstrings;
protegido
procedimiento parseselect (sql: string);
público
constructor create (propietario: tpersistent);
Destructor destruir; anular;
fin;
constructor tbdecdsparams.create (propietario: tpersistent);
comenzar
heredado;
FfieldName: = tStringList.create;
fin;
destructor tbdecdsparams.destroy;
comenzar
Freeandnil (ffieldname);
heredado;
fin;
procedimiento TBDecdsParams.ParSeSelect (SQL: String);
estúpido
Sselect = 'select';
varilla
Fwherefound: booleano;
Inicio: PCHAR;
Fname, valor: cadena;
SqlToken, Cursection, LastToken: TSQLToken;
Params: Integer;
comenzar
Si pos ('' + sselect + '', minúscula (string (pchar (sql) +8)))> 1 luego salga; // No se puede analizar las consultas
Inicio: = pChar (parsesql (pchar (sql), true));
Cursección: = Stunknown;
LastToken: = Stunknown;
FwhereFound: = false;
Parámetros: = 0;
repetir
repetir
SqlToken: = nextSqlToken (inicio, fname, cursección);
Si sqltoken en [stwhere] entonces
comenzar
FwhereFound: = verdadero;
LastToken: = stwhere;
Finalice más si sqltoken en [sttableName] entonces entonces
comenzar
{Verifique el nombre de la tabla calificado del propietario}
Si comienza^ = '.' entonces
NextSqlToken (inicio, fname, cursección);
fin
if (sqltoken = stvalue) y (lasttoken = st a lo largo) entonces
Sqltoken: = stfieldname;
Si SQLToken en SQLSections, entonces cursección: = sqlToken;
hasta SQLToken en [stfieldName, Stend];
Si fwherefound y (sqltoken en [stfieldname]) entonces entonces
repetir
Sqltoken: = nextSqlToken (inicio, valor, cursección);
Si SQLToken en SQLSections, entonces cursección: = sqlToken;
hasta SQLToken en [Stend, Stvalue, Stisnull, Stisnotnull, stfieldName];
si valor = '?' entonces
comenzar
Ffieldname.add (fname);
Inc (parámetros);
fin;
hasta que (params = count) o (sqlToken en [Stend]);
fin;
{TbDequery}
función tbDequery.psgetDefaultOrder: tindexdef;
comenzar
Si fkeyfields = '' entonces
Resultado: = heredado psgetdefaultorder
demás
begins // Detalle Tabla orden predeterminado
Resultado: = tindexdef.create (nil);
Result.options: = [ixunique]; // keyfield es único
Result.name: = stringReplace (fkeyfields, ';', '_', [rfreplaceAll]);
Result.fields: = fkeyfields;
fin;
fin;
{TbDeclientDataSet}
constructor tbDeclientDataSet.Create (Awner: TComponent);
comenzar
creación hereditaria (un downer);
Fdataset: = tbDequery.create (nil);
Fdataset.name: = self.name + 'dataSet1';
Provider.dataSet: = fDataSet;
Sqldbtype: = typeBde;
Flocalparams: = tParams.create;
fin;
destructor tbdeclientdataset.destroy;
comenzar
Freeandnil (Flocalparams);
Fdataset.close;
Freeandnil (fdataset);
destrucción hereditaria;
fin;
procedimiento tbDeclientDataSet.getFieldNames (Lista: Tstrings);
varilla
Abierto: booleano;
comenzar
Abierto: = (activo = falso);
intentar
Si se abre entonces
Abierto;
GetFieldNames heredado (lista);
finalmente
Si se abre, entonces cierre;
fin;
fin;
función tbDeclientDataSet.getCommandText: String;
comenzar
Resultado: = fcommandText;
fin;
función tbDeclientDataSet.getDataSet: tdataset;
comenzar
Resultado: = fdataset como tdataset;
fin;
Procedimiento tbDeclientDataset.CheckmasterSourCeactive (MasterSource: TDataSource);
comenzar
si se asigna (mastersource) y asignado (mastersource.dataset) entonces
si no mastersource.dataset.active entonces
DatabaseError (SMASTERNOTOPEN);
fin;
procedimiento tbDeclientDataSet.SetParamsFromsql (valor const: string);
varilla
DataSet: TQuery;
TableName, TempQuery, P: String;
Lista: TBDecdsParams;
I: entero;
Campo: tfield;
comenzar
TableName: = getTableNameFromsql (valor);
Si TableName <> '' entonces
comenzar
TempQuery: = valor;
Lista: = TBDecdsParams.Create (self);
intentar
List.ParSeSelect (tempQuery);
List.AssignValues (Params);
para i: = 0 to list.count - 1 do
List [i] .ParamType: = PtInput;
Conjunto de datos: = tQuery.create (nil);
intentar
DataSet.databasename: = fdataset.databasename;
P: = GetQuotechar;
DataSet.sql.add ('Seleccionar * de' + Q + TableName + Q + 'Where 0 = 1'); {No localizar}
intentar
DataSet.open;
para i: = 0 to list.count - 1 do
comenzar
if list.ffieldname.count> I entonces
comenzar
intentar
Campo: = dataSet.fieldByName (list.ffieldName [i]);
excepto
Campo: = nil;
fin;
fin
Campo: = nil;
si se asigna (campo) entonces
comenzar
if field.datatype <> ftString entonces
Lista [i] .datatype: = field.datatype
más si tstringfield (campo) .fixedchar entonces entonces
Lista [i] .datatype: = ftfixedchar
demás
Lista [i] .datatype: = ftString;
fin;
fin;
excepto
// ignora todas las excepciones
fin;
finalmente
DataSet.Free;
fin;
finalmente
if list.count> 0 entonces
Params.assign (lista);
List.Free;
fin;
fin;
fin;
procedimiento tbDeclientDataSet.setsql (valor const: string);
comenzar
si se asigna (proveedor.dataSet) entonces
comenzar
TQuery (proveedor.dataset) .sql.clear;
Si el valor <> '' entonces
TQuery (proveedor.dataset) .sql.add (valor);
SetCommandText heredado (valor);
fin
DatabaseError (snodataprovider);
fin;
procedimiento tbDeclientDataSet.Loaded;
comenzar
Heredado cargado;
Si fstreamedactive entonces
comenzar
SetActive (verdadero);
Fstreamedactive: = false;
fin;
fin;
función tbDeclientDataSet.getMasterfields: String;
comenzar
Resultado: = MasterFields hereditarios;
fin;
procedimiento tbDeclientDataSet.setMasterfields (valor const: string);
comenzar
MasterFields heredados: = valor;
Si el valor <> '' entonces
IndexFieldNames: = valor;
Fdataset.fkeyfields: = '';
fin;
procedimiento tbDeclientDataSet.setCommandText (valor: string);
comenzar
SetCommandText heredado (valor);
FCommandText: = valor;
Si no (csloading en ComponentState) entonces
comenzar
Fdataset.fkeyfields: = '';
IndexFieldNames: = '';
MasterFields: = '';
IndexName: = '';
Indexdefs.clear;
Params.clear;
if (csdesigning in componentState) y (valor <> '') entonces
SetParamsFromsql (valor);
fin;
fin;
función tbDeclientDataSet.getConnection: tDatabase;
comenzar
Resultado: = fdatabase;
fin;
procedimiento tbDeclientDataSet.SetConnection (valor: tDatabase);
comenzar
if value = fdatabase entonces salga;
Checkinactive;
si se asigna (valor) entonces
comenzar
Si no (csloading en ComponentState) y (value.databasename = '') entonces
DatabaseError (sdatabasenamemissing);
Fdataset.databasename: = value.databasename;
fin
Fdataset.databasename: = '';
Fdatabase: = valor;
fin;
función tbDeclientDataSet.getQuoteChar: string;
comenzar
Resultado: = '';
si se asigna (fdataSet) entonces
Resultado: = fdataset.psgetQuotechar;
fin;
procedimiento tbDeclientDataset.Clonecursor (fuente: tcustomclientDataset; reinicio: boolean;
Keepsettings: boolean = false);
comenzar
Si no (la fuente es TBDeclientDataSet) entonces
DatabaseError (sinvalidclone);
Provider.dataset: = tbDeclientDataSet (fuente) .provider.dataset;
Dbconnection: = tbDeClientDataSet (fuente) .dbconnection;
CommandText: = tbDeclientDataSet (fuente) .CommandText;
clonecursor heredado (fuente, reinicio, guardias);
fin;
Procedimiento tbDeclientDataSet.notificación (cáponente: tcomponent; operación: topación);
comenzar
Notificación hereditaria (cájaro, operación);
Si Operation = Opremove entonces
si cacuponent = fdatabase entonces
comenzar
Fdatabase: = nil;
SetActive (falso);
fin;
fin;
procedimiento tbDeclientDataSet.setLocalParams;
procedimiento createParamsFromMasterfields (Crear: boolean);
varilla
I: entero;
Lista: Tstrings;
comenzar
Lista: = tStringList.create;
intentar
Si crea entonces
Flocalparams.Clar;
Fdataset.fkeyfields: = MasterFields;
List.commatext: = MasterFields;
para i: = 0 to list.count -1 do
comenzar
Si crea entonces
Flocalparams.createparam (ftunknown, mastersource.dataset.fieldbyname (lista [i]). FieldName,
ptinput);
Flocalparams [i] .assignfield (mastersource.dataset.fieldbyname (list [i]));
fin;
finalmente
List.Free;
fin;
fin;
comenzar
if (masterfields <> '') y asignado (mastersource) y asignado (mastersource.dataset) entonces
comenzar
CreateParamsFromMasterFields (verdadero);
FcurrentCommand: = addParAMSQLFordetail (FlocalParams, CommandText, True, GetQuotechar);
fin;
fin;
procedimiento tbDeclientDataSet.setDataSource (valor: tdataSource);
comenzar
Mastersource heredado: = valor;
si se asigna (valor) entonces
comenzar
si PackETRecords = -1 entonces PackETRecords: = 0;
fin
comenzar
if PackETRecords = 0 entonces PackETRecords: = -1;
fin;
fin;
función tbDeclientDataSet.getMasterSource: tDatasource;
comenzar
Resultado: = maestro heredado;
fin;
procedimiento tbDeclientDataSet.SetDetailSactive (valor: booleano);
varilla
Detailist: tlist;
I: entero;
comenzar
Detailist: = tlist.create;
intentar
GetDetaildataSets (Detailist);
para i: = 0 a detaillist.count -1 do
Si Tdataset (Detailist [i]) es tbdeclientdataSet entonces
TbDeclientDataSet (tDataset (detaillist [i])). Active: = Value;
finalmente
DetAillist.Free;
fin;
fin;
procedimiento tbDeclientDataSet.SetActive (valor: booleano);
comenzar
Si el valor entonces
comenzar
Si la carga cs en ComponentState entonces
comenzar
Fstreamedactive: = true;
salida;
fin;
Si Masterfields <> '' entonces
comenzar
Si no (csloading en ComponentState) entonces
CheckMasterSourCeactive (Mastersource);
SetLocalParams;
SetSql (fcurrentCommand);
Parámetros: = flocalParams;
Fetchparams;
fin
comenzar
SetSql (fcommandText);
if params.count> 0 entonces
comenzar
Fdataset.Params: = params;
Fetchparams;
fin;
fin;
fin;
if value y (fdataset.objectView <> objectView) luego
FdataSet.ObjectView: = ObjectView;
SetActive heredado (valor);
SetDetailSactive (valor);
fin;
registro de procedimientos;
comenzar
RegisterComponents ('bde', [tbDeclientDataSet]);
fin;
fin.
// 以上经 dblocalb.pas 改装而成, 可存为任意文件名, 当然扩展名是 Pas
// 然后安装此控件即可