Einheit BdeclientDataset;
Schnittstelle
Verwendet Windows, Sysutils, Varianten, Klassen, DB, DBCommon, Midas,
SQLTIMST, DBCLIENT, DBLOCAL, Anbieter, DBTables;
Typ
{TbDequery}
TbDequery = Klasse (TQuery)
Privat
FkeyFields: String;
geschützt
Funktion PSGetDefaultOrder: tindexdef; überschreiben;
Ende;
{TbdeclientDataset}
TbdeclientDataset = Klasse (tcustomcachedDataset)
Privat
FCommandtext: String;
FcurrentCommand: String;
Fdataset: tbDdequery;
Fdatabase: tdatabase;
FlocalParams: TPARAMS;
FStreamedActive: boolean;
Verfahrensprüfungen (Mastersource: tdataSource);
Prozedur SetDetailsActive (Wert: boolean);
Funktion getConnection: tdatabase;
Funktion getDataset: tdataset;
Funktion GetmasterSource: tdataSource;
Funktion getMasterFields: String;
Prozedur setConnection (Wert: tdatabase);
Prozedur setDataSource (Wert: tdataSource);
Prozedur SetLocalParams;
Prozedur SetMasterFields (const value: String);
Prozedur setParamsfromsql (const value: String);
Prozedur setSQL (const value: String);
geschützt
Funktion getCommandText: String; überschreiben;
Verfahren geladen; überschreiben;
Verfahrensbenachrichtigung (Akomponent: tcomponent; Operation: Toperation); überschreiben;
Verfahren setActActActActAct (Wert: boolean); überschreiben;
Prozedur setCommandText (Wert: String); überschreiben;
öffentlich
Konstruktor create (aowner: tcomponent); überschreiben;
Zerstörer zerstören; überschreiben;
Verfahrensklonecursor (Quelle: tcustomclientDataset; Reset: Boolean;
SteTeTings: boolean = false); überschreiben;
Prozedur GetfieldNames (Liste: TStrings); überschreiben;
Funktion getQuotechar: String;
Eigenschaftsdatensatz: tdataset read getDataset;
veröffentlicht
Eigentum aktiv;
Eigenschaftsbefehlsbefehl: String Lesen Sie GetCommandText Write setCommandText;
Eigenschaft dbConnection: tdatabase read getConnection write setConnection;
Immobilien -Masterfields gelesen GetMasterFields Write setMasterfields;
Immobilienmasturce: TdataSource Read GetmasterSource schreiben SetDataSource;
Ende;
Verfahrensregister;
Durchführung
Verwendet Bdeconst, MidConst;
Typ
{TbdecdSparams}
TbdecdSparams = Klasse (tParams)
Privat
Ffieldname: tstrings;
geschützt
PROCECING PARSESELECT (SQL: String);
öffentlich
Konstruktor erstellen (Eigentümer: tpersistent);
Zerstörer zerstören; überschreiben;
Ende;
Konstruktor tbdecdSparams.create (Eigentümer: tpersistent);
beginnen
geerbt;
Ffieldname: = tstringlist.create;
Ende;
destructor tbdecdSparams.destroy;
beginnen
Freeandnil (ffieldname);
geerbt;
Ende;
Prozedur TBDECDSPARAMS.PARSESELECT (SQL: String);
Const
SSELECT = 'SELECT';
var
FWherefound: boolean;
Start: pchar;
Fname, Wert: String;
Sqltoken, cursection, lastToken: tsqltoken;
Parameter: Ganzzahl;
beginnen
Wenn POS ('' + sselect + '', Kleinbuchstaben (String (pChar (SQL) +8)))> 1, dann beenden; // Unterabfragen können nicht analysiert werden
Start: = pChar (Parseql (pChar (SQL), TRUE));
Cursection: = Stumpfown;
LastToken: = stumpfown;
FWherefound: = false;
Parameter: = 0;
wiederholen
wiederholen
SQLTOKE: = NEXTSQLTOKE (START, FNAME, CRUSSECTION);
Wenn Sie in [Sthere] sqltoken haben
beginnen
FWherefound: = wahr;
LastToken: = sther;
Ende sonst, wenn sqltoken in [sttableName] dann
beginnen
{Überprüfen Sie, ob der Besitzer qualifizierte Tabelle Name}}
wenn start^ = '.' Dann
NextSQLToken (Start, Fname, Cursection);
Ende sonst
if (sqltoken = stvalue) und (lastToken = sther) dann
SQLTOKE: = StfieldName;
Wenn SQLTOKE in SQLSECTIONS ist, dann Cursection: = SqlToken;
bis Sqltoken in [Stfieldname, Stend];
Wenn fWherefound und (sqltoken in [Stfieldname]) dann)
wiederholen
SQLTOKE: = NEXTSQLTOKE (START, VALUE, CRUSSECTION);
Wenn SQLTOKE in SQLSECTIONS ist, dann Cursection: = SqlToken;
Bis in [Stend, Stvalue, Stisnull, Stisnotnull, Stfieldname];
wenn value = '?' Dann
beginnen
Ffieldname.add (fname);
Inc (Params);
Ende;
bis (params = count) oder (sqlToken in [stend]);
Ende;
{TbDequery}
Funktion tbDequery.pgetDefaultOrder: tindexdef;
beginnen
Wenn fkeyfields = '' dann
Ergebnis: = erbter PSGetDefaultOrder
anders
Beginnen Sie // Detailtabelle Standardbestellung
Ergebnis: = tindexdef.create (nil);
Result.options: = [ixunique]; // Keyfield ist einzigartig
Result.name: = stringReplace (fkeyfields, ';', '_', [rfreplaceall]);
Result.Fields: = fKefields;
Ende;
Ende;
{TbdeclientDataset}
Konstruktor tbdeclientDataset.create (aowner: tcomponent);
beginnen
ererbte erstellen (aowner);
Fdataset: = tbDequery.create (nil);
Fdataset.name: = self.name + 'dataset1';
Provider.dataset: = fdataset;
SQLDBTYPE: = Typebde;
Flocalparams: = tParams.create;
Ende;
Destructor tbdeclientDataset.Destroy;
beginnen
Freeandnil (Flocalparams);
Fdataset.close;
Freeandnil (fdataset);
erbte Zerstörung;
Ende;
Prozedur TBDeClientDataset.getFieldnames (Liste: TStrings);
var
Geöffnet: boolean;
beginnen
Geöffnet: = (aktiv = false);
versuchen
Wenn geöffnet, dann
Offen;
ererbte Getfieldnames (Liste);
Endlich
Wenn geöffnet, dann schließen Sie;
Ende;
Ende;
Funktion tbDeClientDataset.getCommandText: String;
beginnen
Ergebnis: = fCommandtext;
Ende;
Funktion tbdeclientDataset.getDataset: tdataset;
beginnen
Ergebnis: = fdataset als tdataset;
Ende;
Verfahren tbdeclientDataset.CheckmasterSourceactive (Mastersource: tdataSource);
beginnen
Wenn zugewiesen (Mastersource) und zugewiesen (Mastersource.Dataset), dann dann
Wenn nicht mastSource.dataset.active dann
DataBaseError (smasternotopen);
Ende;
Prozedur TBDeClientDataset.SetParamsfromsql (const value: String);
var
Datensatz: TQuery;
TableName, TempQuery, q: String;
Liste: tbdecdSparams;
I: Ganzzahl;
Feld: tfield;
beginnen
TableName: = GetTableNameFromsql (Wert);
Wenn tableName <> '' dann
beginnen
TempQuery: = Wert;
Liste: = tbdecdSparams.create (self);
versuchen
List.ParSeSelect (tempQuery);
List.SignValues (Params);
für i: = 0 aufliste.count - 1 do
Liste [i] .ParamType: = ptinput;
Datensatz: = TQuery.create (nil);
versuchen
DataSeT.DatabaseName: = fdataset.databaseName;
F: = GetQuotechar;
DataSet.sql.add ('SELECT * aus' + q + tableName + q + 'wobei 0 = 1'); {Lokalisieren Sie nicht}
versuchen
Dataset.open;
für i: = 0 aufliste.count - 1 do
beginnen
Wenn list.ffieldname.count> i dann
beginnen
versuchen
Feld: = DataSet.FieldByName (list.ffieldname [i]);
außer
Feld: = nil;
Ende;
Ende sonst
Feld: = nil;
Wenn zugewiesen (Feld) dann
beginnen
Wenn field.Datatype <> ftstring dann
Liste [i] .Datatype: = field.datatype
sonst wenn Tstringfield (Feld) .FixedChar dann dann
Liste [i] .Datatype: = ftfixedChar
anders
Liste [i] .Datatype: = ftstring;
Ende;
Ende;
außer
// alle Ausnahmen ignorieren
Ende;
Endlich
Dataset.Free;
Ende;
Endlich
wenn list.count> 0 dann
Params.ssign (list);
List.free;
Ende;
Ende;
Ende;
Prozedur TBDECLIENTDATASET.SETSQL (const Value: String);
beginnen
Wenn zugewiesen (Provider.Dataset) dann
beginnen
TQuery (Provider.Dataset) .SQL.Clear;
Wenn Wert <> '' dann
TQuery (Provider.Dataset) .sql.Add (Wert);
ererbter setCommandtext (Wert);
Ende sonst
DatabaseError (Snodataprovider);
Ende;
Prozedur tbDeClientDataset.LOAD;
beginnen
ererbter geladener;
Wenn fStreamedActive dann
beginnen
SetActive (wahr);
FStreamedActive: = falsch;
Ende;
Ende;
Funktion tbDeClientDataset.getMasterFields: String;
beginnen
Ergebnis: = erbte Masterfields;
Ende;
Prozedur TBDeClientDataset.SetMasterFields (const value: String);
beginnen
ererbte Masterfields: = Wert;
Wenn Wert <> '' dann
IndexFieldNames: = Wert;
Fdataset.fkeyfields: = '';
Ende;
procedure tbDeclientDataset.setCommandText (Wert: String);
beginnen
ererbter setCommandtext (Wert);
FCommandText: = Wert;
wenn nicht
beginnen
Fdataset.fkeyfields: = '';
IndexFieldNames: = '';
Masterfields: = '';
Indexname: = '';
Indexdefs.clear;
Params.clear;
if (csDesigning in componentState) und (Wert <> '') dann
SetParamsfromsql (Wert);
Ende;
Ende;
Funktion tbdeclientDataset.getConnection: tdatabase;
beginnen
Ergebnis: = fdatabase;
Ende;
Prozedur TBDeClientDataset.setConnection (Wert: tDatabase);
beginnen
wenn value = fdatabase dann beenden;
CheckinActive;
Wenn zugewiesen (Wert) dann
beginnen
wenn nicht
DatabaseError (sdatabasenamemissing);
Fdataset.databaseName: = value.databaseName;
Ende sonst
Fdataset.databasename: = '';
Fdatabase: = Wert;
Ende;
Funktion tbdeclientDataset.getQuotechar: String;
beginnen
Ergebnis: = '';
Wenn zugewiesen (fdataset) dann
Ergebnis: = fdataset.pgetquotechar;
Ende;
Prozedur TBDECLIENTDATASET.CLONECURSOR (Quelle: tcustomclientDataset; Reset: boolean;
SteTeTings: boolean = false);
beginnen
Wenn nicht (Quelle ist tbDeclientDataset) dann
DatabaseError (sinvalidclone);
Provider.dataset: = tbdeclientDataset (Quelle) .Provider.Dataset;
DbConnection: = tbdeclientDataset (Quelle) .dbConnection;
CommandText: = tbdeclientDataset (Quelle) .CommandText;
ererbter Klonecursor (Quelle, Reset, Stectings);
Ende;
Verfahren tbdeclientDataset.Notification (Akomponent: tcomponent; Operation: Toperation);
beginnen
ererbte Benachrichtigung (Akomponent, Operation);
Wenn Operation = opremove dann
Wenn acomponent = fdatabase dann
beginnen
Fdatabase: = nil;
SetActive (false);
Ende;
Ende;
Prozedur TbDeClientDataset.SetLocalParams;
Verfahren CreateParamsfrommasterfields (erstellen: boolean);
var
I: Ganzzahl;
Liste: tstrings;
beginnen
Liste: = tstringlist.create;
versuchen
Wenn er erstellen, dann
Flocalparams.clear;
Fdataset.fkeyfields: = masterfields;
List.commatext: = masterfields;
für i: = 0 bis list.count -1 do
beginnen
Wenn er erstellen, dann
Flocalparams.createparam (ftunknown, maststersource.dataset.fieldbyName (Liste [i]). Fieldname,
ptinput);
Flocalparams [i] .Signfield (Mastersource.Dataset.FieldbyName (Liste [i]));
Ende;
Endlich
List.free;
Ende;
Ende;
beginnen
if (masterfields <> '') und zugewiesen (Mastersource) und zugewiesen (Mastersource.dataset) dann
beginnen
CreateParamsfrommasterfields (true);
FcurrentCommand: = addparamsqlfordetail (flocalparams, commandText, true, getQuotechar);
Ende;
Ende;
Prozedur TbDeClientDataset.SetDataSource (Wert: tdataSource);
beginnen
ererbte Mastersource: = Wert;
Wenn zugewiesen (Wert) dann
beginnen
wenn packetrecords = -1 dann packetrecords: = 0;
Ende sonst
beginnen
wenn packetrecords = 0 dann packetrecords: = -1;
Ende;
Ende;
Funktion tbdeclientDataset.getmasterSource: tdataSource;
beginnen
Ergebnis: = erbte Mastersource;
Ende;
Prozedur TBDeClientDataset.SetDetailsActive (Wert: boolean);
var
Detaillist: Tlist;
I: Ganzzahl;
beginnen
Detaillist: = tlist.create;
versuchen
GetDetaildatasets (Detaillist);
für i: = 0 bis detaillist.count -1 do
Wenn tdataset (detaillist [i]) tbdeclientDataset ist, dann ist es
TbdeclientDataset (tdataset (Detaillist [i])). Aktiv: = Wert;
Endlich
Detaillist.Free;
Ende;
Ende;
Prozedur TBDeClientDataset.setActive (Wert: boolean);
beginnen
Wenn Wert dann
beginnen
Wenn CSLOADING IN COMPONENTSTATE dann
beginnen
FStreamedActive: = wahr;
Ausfahrt;
Ende;
Wenn Masterfields <> '' dann
beginnen
wenn nicht
CheckmasterSourceactive (Mastersource);
SetLocalParams;
SetSQL (fcurrentCommand);
Parameter: = flocalparams;
Fetchparams;
Ende sonst
beginnen
SetSQL (fCommandtext);
Wenn params.count> 0 dann
beginnen
Fdataset.params: = params;
Fetchparams;
Ende;
Ende;
Ende;
Wenn Wert und (fdataset.ObjectView <> ObjectView) dann)
Fdataset.ObjectView: = ObjectView;
ererbter setActive (Wert);
SetDetailsActive (Wert);
Ende;
Verfahrensregister;
beginnen
RegisterComponents ('Bde', [tbdeclientDataset]);
Ende;
Ende.
// 以上经 dblocalb.pas 改装而成, 可存为任意文件名, 当然扩展名是 pas
// 然后安装此控件即可