unité bdeclientDataset;
interface
Utilise Windows, Sysutils, Variants, Classes, DB, DBCOMMON, MIDAS,
Sqltimst, dbclient, dblocal, fournisseur, dbtables;
taper
{TbDeQuery}
TbDeQuery = classe (tQuery)
privé
Fkeyfields: chaîne;
protégé
fonction psgetdefaultOrder: TindexDef; outrepasser;
fin;
{TbdeclientDataset}
TbdeclientDataset = class (tCustomCachedDataset)
privé
FCommandText: String;
FcurrentCommand: String;
Fdataset: tbDeQuery;
Fdatabase: tdatabase;
Flocalparams: TPARAMS;
Fstreamedactive: booléen;
Procédure CheckMastersourceactive (MasterSource: TDATASOURCE);
Procédure setDetailSactive (valeur: booléen);
fonction getConnection: tdatabase;
fonction getDataset: tdataset;
fonction getmastersource: tdatasource;
fonction getMasterFields: String;
Procédure setConnection (valeur: tdatabase);
Procédure setDataSource (valeur: tdataSource);
procédure setLocalParams;
Procédure setMasterFields (const Value: String);
Procédure setParamsFromsQl (constamment de valeur: chaîne);
Procédure setSQL (const Value: String);
protégé
fonction getCommandText: String; outrepasser;
procédure chargée; outrepasser;
Notification de procédure (Acomponent: TComponent; Opération: Topration); outrepasser;
Procédure setactive (valeur: booléen); outrepasser;
procédure setCommandText (valeur: chaîne); outrepasser;
publique
Constructor Create (Aowner: TComponent); outrepasser;
destructeur détruire; outrepasser;
procédure clonecursor (source: tCustomClientDataset; réinitialiser: booléen;
KeepSettings: boolean = false); outrepasser;
procédure getFieldNames (liste: tStrings); outrepasser;
fonction getQuoteChar: String;
Ensemble de données de propriétés: TDATASet Read GetDataset;
publié
propriété active;
propriété CommandText: String Read GetCommandText Write SetCommandText;
propriété dbConnection: TDATABase Read GetConnection Write SetConnection;
Property Masterfields Lire GetMasterfields Write setMasterfields;
Property Mastersource: TdataSource Read Getmastersource Write SetDataSource;
fin;
Registre de procédure;
mise en œuvre
Utilise Bdeconst, MidConst;
taper
{Tbdecdsparams}
Tbdecdsparams = classe (tparams)
privé
Ffieldname: tStrings;
protégé
Procédure PARSEselect (SQL: String);
publique
Concluteur Create (propriétaire: tPesistent);
Destructeur détruire; outrepasser;
fin;
constructeur tbdecdsparams.Create (propriétaire: tPesistent);
commencer
hérité;
FfieldName: = tStringList.Create;
fin;
destructor tbdecdsparams.destroy;
commencer
Freeandnil (ffieldname);
hérité;
fin;
Procédure tbDecdsparams.Parseselect (SQL: String);
const
Sselect = 'select';
var
Ferme-temps: booléen;
Démarrer: PCHA;
FName, valeur: chaîne;
Sqltoken, cursection, lasttoken: tsqltoken;
Params: entier;
commencer
Si pos ('' + sselect + '', minuscules (String (pChar (sql) +8)))> 1 puis sortir; // ne peut pas analyser les sous-requêtes
START: = PCHAL (PARSESQL (PCHAR (SQL), TRUE));
Cursection: = STUNKNOWN;
LastToken: = STUNKNOWN;
FIRWOWNFOUND: = FALSE;
Params: = 0;
répéter
répéter
Sqltoken: = nexTSQlToken (start, fname, cursection);
Si sqltoken dans [Stwhere] alors
commencer
FIRWOWNFOUND: = true;
LastToken: = Stwhere;
fin autre si sqltoken dans [sttableName] alors
commencer
{Vérifiez le nom de la table qualifié du propriétaire}
Si démarrer ^ = '.' alors
NIFTSQLTOKINE (START, FNAME, Cursection);
fin d'autre
if (sqltoken = stvalue) et (lastToken = stwhere) alors
Sqltoken: = stfieldname;
Si sqltoken dans SQLSections alors Cursection: = SqlToken;
Jusqu'à Sqltoken dans [Stfieldname, Stend];
Si fail
répéter
Sqltoken: = nexTSQlToken (démarrage, valeur, cursection);
Si sqltoken dans SQLSections alors Cursection: = SqlToken;
Jusqu'à Sqltoken dans [Stend, Stvalue, Stisnull, Stisnotnull, Stfieldname];
Si valeur = '?' alors
commencer
Ffieldname.add (fName);
Inc (params);
fin;
jusqu'à (params = count) ou (sqltoken dans [stend]);
fin;
{TbDeQuery}
fonction tbDealer.PSGetDefaultOrder: TindexDef;
commencer
Si fkeyfields = '' alors
Résultat: = PsgetDefaultOrder héréditaire
autre
Démarrer // Table de détail Commande par défaut
Résultat: = TindexDef.Create (nil);
Result.options: = [ixunique]; // Keyfield est unique
Result.name: = stringReplace (fkeyfields, ';', '_', [rfReplaceAll]);
Result.Fields: = fkeyFields;
fin;
fin;
{TbdeclientDataset}
constructeur tbdeclientdataset.create (aowner: tcomponent);
commencer
hérité de création (aowner);
FdataSet: = tbDeQuery.create (nil);
Fdataset.name: = self.name + 'dataset1';
Provider.dataset: = fdataset;
SQLDBTYPE: = TYPEBDE;
FlocalParams: = tParams.Create;
fin;
destructor tbdeclientdataset.destroy;
commencer
Freeandnil (flocalparams);
Fdataset.close;
Freeandnil (fdataset);
Hérité de détruire;
fin;
procédure tbdeclientdataset.getFieldNames (liste: tStrings);
var
Ouvert: booléen;
commencer
Ouvert: = (actif = false);
essayer
Si vous êtes ouvert alors
Ouvrir;
GetFieldNames hérités (liste);
enfin
S'il est ouvert, fermez-vous;
fin;
fin;
fonction tbdeclientdataset.getCommandText: String;
commencer
Résultat: = fCommandText;
fin;
fonction tbdeclientdataset.getDataset: tdataset;
commencer
Résultat: = fdataset comme tdataset;
fin;
procédure tbdeclientdataset.Checkmastersourceactive (MasterSource: tdataSource);
commencer
si elle est attribuée (Mastersource) et attribuée (Mastersource.Dataset)
Si pas Mastersource.Dataset.Active alors
DatabaseError (SmasterNotOpen);
fin;
procédure tbdeclientdataset.setParamsFromsQl (construct: string);
var
Ensemble de données: tQuery;
TableName, TempQuery, Q: String;
Liste: TBDecdsparams;
I: entier;
Champ: Tfield;
commencer
TableName: = getTableNameFromsQl (valeur);
Si TableName <> '' alors
commencer
TempQuery: = valeur;
Liste: = tbdecdsparams.Create (self);
essayer
List.Parseselect (tempQuery);
List.assignValues (params);
pour i: = 0 à list.Count - 1 do
List [i] .ParamType: = pTinput;
Ensemble de données: = tQuery.Create (nil);
essayer
DataSet.Databasename: = fdataset.databasename;
Q: = GetQuoteChar;
DataSet.sql.add ('select * from' + q + tableName + q + 'où 0 = 1'); {Ne localisez pas}
essayer
Dataset.open;
pour i: = 0 à list.Count - 1 do
commencer
si list.ffieldname.count> i alors
commencer
essayer
Champ: = dataSet.fieldByName (list.ffieldname [i]);
sauf
Champ: = nil;
fin;
fin d'autre
Champ: = nil;
si elle est affectée (champ) alors
commencer
Si field.datatype <> ftsstring alors
Liste [i] .datatype: = field.datatype
sinon si tStringfield (champ) .Fixedchar alors
Liste [i] .datatype: = ftfixedchar
autre
List [i] .datatype: = ftsstring;
fin;
fin;
sauf
// ignore toutes les exceptions
fin;
enfin
Dataset.free;
fin;
enfin
si list.Count> 0 alors
Params.Assign (list);
List.free;
fin;
fin;
fin;
Procédure tbdeclientDataSet.Setsql (constamment de constructeurs: chaîne);
commencer
si elle est affectée (fournisseur.dataset) alors
commencer
TQuery (provider.dataset) .sql.clear;
Si la valeur <> '' alors
TQuery (provider.dataset) .sql.add (valeur);
SetCommandText hérité (valeur);
fin d'autre
DatabaseError (snodataprovider);
fin;
procédure tbdeclientdataset.loaded;
commencer
hérité chargé;
Si fstreamedactive alors
commencer
Setactive (true);
FStreamEdActive: = false;
fin;
fin;
fonction tbdeclientdataset.getMasterFields: String;
commencer
Résultat: = MasterFields hérité;
fin;
Procédure tbdeclientDataSet.SetMasterFields (constamment de la valeur: String);
commencer
MasterFields hérité: = valeur;
Si la valeur <> '' alors
IndexFieldNames: = valeur;
Fdataset.fkeyfields: = '';
fin;
Procédure tbdeclientDataset.setCommandText (valeur: chaîne);
commencer
SetCommandText hérité (valeur);
FCommandText: = valeur;
Sinon (CSloading dans ComponentState)
commencer
Fdataset.fkeyfields: = '';
IndexFieldNames: = '';
MasterFields: = '';
IndexName: = '';
IndexDefs.Clear;
Params.Clear;
if (csdesigning dans composantState) et (valeur <> '') puis
SetParamsFromsQl (valeur);
fin;
fin;
fonction tbdeclientdataset.getConnection: tdatabase;
commencer
Résultat: = fdatabase;
fin;
Procédure tbdeclientDataset.setConnection (valeur: tdatabase);
commencer
Si valeur = fdatabase, puiste-t-il;
Vérification de vérification;
Si vous êtes attribué (valeur) alors
commencer
Sinon (csloading dans composantState) et (value.databasename = '') alors
DatabaseError (sdatabasenamemissing);
Fdataset.databasename: = value.databasename;
fin d'autre
Fdataset.databasename: = '';
Fdatabase: = valeur;
fin;
fonction tbdeclientdataset.getQuoteChar: String;
commencer
Résultat: = '';
si elle est affectée (fdataset) alors
Résultat: = fdataset.psgetquotechar;
fin;
Procédure tbdeclientDataset.clonecursor (Source: tCustomClientDataSet; réinitialisation: boolean;
KeepSettings: boolean = false);
commencer
Sinon (la source est tbdeclientDataset)
DatabaseError (SinvalidClone);
Provider.dataset: = tbdeclientdataset (source) .provider.dataset;
DbConnection: = tbdeclientDataSet (source) .DBConnection;
CommandText: = tbdeclientDataSet (source) .CommandText;
CloneCursor héréditaire (source, réinitialisation, KeepSettings);
fin;
Procédure tbdeclientDataset.Notification (acosant: tComponent; opération: topration);
commencer
notification héritée (acomponent, opération);
Si Opération = OpreMove alors
Si acomponent = fdatabase alors
commencer
Fdatabase: = nil;
Setactive (false);
fin;
fin;
procédure tbdeclientdataset.setLocalParams;
Procédure CreateParamsFrommasterfields (Create: Boolean);
var
I: entier;
Liste: TStrings;
commencer
Liste: = tStringList.Create;
essayer
Si créer alors
Flocalparams.Clear;
Fdataset.fkeyfields: = masterFields;
List.commatext: = MasterFields;
pour i: = 0 à list.Count -1 do
commencer
Si créer alors
Flocalparams.createparam (ftunknown, Mastersource.dataset.fieldByName (list [i]). Fieldname,
ptinput);
Flocalparams [i] .assignField (Mastersource.dataset.fieldByName (list [i]));
fin;
enfin
List.free;
fin;
fin;
commencer
if (MasterFields <> '') et attribué (Mastersource) et attribué (Mastersource.Dataset) puis
commencer
CreateParamsFrommasterfields (true);
FcurrentCommand: = addParamsqlfordTail (flocalParams, CommandText, true, getQuoteChar);
fin;
fin;
procédure tbdeclientdataset.setDataSource (valeur: tdatasource);
commencer
Mastersource hérité: = valeur;
Si vous êtes attribué (valeur) alors
commencer
Si packetRecords = -1 alors packetRecords: = 0;
fin d'autre
commencer
Si packetRecords = 0 alors packetRecords: = -1;
fin;
fin;
fonction tbdeclientdataset.getmastersource: tdatasource;
commencer
Résultat: = Mastersource héréditaire;
fin;
procédure tbdeclientdataset.setdetailsactive (valeur: boolean);
var
Détailliste: tlist;
I: entier;
commencer
Detaillist: = tlist.create;
essayer
GetDetailDatasets (détaillest);
pour i: = 0 à détaillest.Count -1 do
Si TDATASET (détaillest [i]) est tbdeclientdataset alors
TbdeclientDataSet (tdataset (détaillist [i])). Actif: = valeur;
enfin
Détailliste.free;
fin;
fin;
procédure tbdeclientdataset.setactive (valeur: booléen);
commencer
Si la valeur alors
commencer
Si CSloading dans ComponentState alors
commencer
FStreamEdActive: = true;
sortie;
fin;
Si Masterfields <> '' alors
commencer
Sinon (CSloading dans ComponentState)
CheckMastersourCeactive (MasterSource);
SetLocalParams;
SetSQL (fcurrentCommand);
Params: = FlocalParams;
FetchParams;
fin d'autre
commencer
SetSQL (fCommandText);
Si params.Count> 0 alors
commencer
Fdataset.params: = params;
FetchParams;
fin;
fin;
fin;
Si la valeur et (fdataset.objectview <> ObjectView)
Fdataset.objectView: = objectView;
SetActive (valeur) héritée;
SetDetailsActive (valeur);
fin;
Registre de procédure;
commencer
RegisterComponents ('BDE', [tbdeclientDataset]);
fin;
fin.
// 以上经 dblocalb.pas 改装而成, 可存为任意文件名, 当然扩展名是 pas
// 然后安装此控件即可