unit bdeclientdataset;
antarmuka
Menggunakan Windows, Sysutils, Varian, Kelas, DB, DBCommon, Midas,
Sqltimst, dbClient, dblocal, penyedia, dbTables;
jenis
{Tbdequery}
Tbdequery = class (tquery)
pribadi
FKeyFields: String;
terlindung
fungsi psgetDefaultOrder: tindexdef; mengesampingkan;
akhir;
{TbdeClientDataSet}
TbdeClientDataSet = class (tcustomcacheddataset)
pribadi
FCommandText: String;
FcurrentCommand: string;
Fdataset: tbdequery;
Fdatabase: tdatabase;
Flocalparams: TParams;
Fstreamedactive: boolean;
prosedur checkmastersourceactive (mastersource: tdataSource);
Prosedur SetDetailSactive (Nilai: Boolean);
fungsi getConnection: tdatabase;
fungsi getDataset: tdataset;
fungsi getMasterSource: tdataSource;
fungsi getMasterfields: string;
prosedur setConnection (nilai: tdatabase);
Prosedur SetDataSource (Nilai: TDataSource);
Prosedur Setlocalparams;
Prosedur SetMasterFields (Nilai Const: String);
Prosedur SetParamsFromsQL (Const Value: String);
Prosedur SetSQL (Nilai Const: String);
terlindung
fungsi getCommandText: string; mengesampingkan;
prosedur dimuat; mengesampingkan;
Pemberitahuan Prosedur (Acomponent: TComponent; Operasi: Toperasi); mengesampingkan;
prosedur setaktif (nilai: boolean); mengesampingkan;
Prosedur setCommandText (nilai: string); mengesampingkan;
publik
constructor create (aowner: tComponent); mengesampingkan;
Destructor menghancurkan; mengesampingkan;
Klonecursor Prosedur (Sumber: TCustomClientDataSet; Reset: Boolean;
Keepsettings: boolean = false); mengesampingkan;
Prosedur GetFieldNames (Daftar: TStrings); mengesampingkan;
function getquotechar: string;
dataset properti: tdataset baca getDataset;
diterbitkan
properti aktif;
Property CommandText: String Baca GetCommandText Tulis SetCommandText;
Properti DBConnection: tdatabase baca getConnection menulis setConnection;
Masterfields Properti Baca GetMasterfields Tulis SetMasterfields;
Mastersource properti: tdataSource baca getmastersource menulis setDataSource;
akhir;
register prosedur;
pelaksanaan
menggunakan bdeconst, midconst;
jenis
{Tbdecdsparams}
Tbdecdsparams = class (tparams)
pribadi
Ffieldname: tstrings;
terlindung
PROSEDUR PARSESELECT (SQL: String);
publik
konstruktor buat (pemilik: tpersistent);
Destructor menghancurkan; mengesampingkan;
akhir;
konstruktor tbdecdsparams.create (pemilik: tpersistent);
mulai
diwariskan;
FFieldName: = tStringList.create;
akhir;
Destructor tbdecdsparams.destroy;
mulai
Freeandnil (fieldname);
diwariskan;
akhir;
Prosedur tbdecdsparams.parseselect (sql: string);
const
Sselect = 'select';
var
FhereFound: boolean;
Mulai: PCHAR;
Fname, nilai: string;
Sqltoken, cursection, lasttoken: tsqltoken;
Params: integer;
mulai
jika pos ('' + sselect + '', huruf kecil (string (pchar (sql) +8)))> 1 lalu keluar; // tidak bisa menguraikan sub kueri
Mulai: = PCHAR (ParSESQL (PCHAR (SQL), TRUE));
Cursection: = Stunknown;
LastToken: = Stunknown;
FhereFound: = false;
Params: = 0;
mengulang
mengulang
Sqltoken: = nextsqltoken (start, fname, cursection);
Jika sqltoken di [stage] maka
mulai
FhereFound: = true;
LastToken: = Stherwhere;
Akhiri lain jika sqltoken di [sttableName] lalu
mulai
{Periksa nama tabel yang memenuhi syarat pemilik}
Jika Mulai^ = '.' Kemudian
Nextsqltoken (start, fname, Cursection);
akhir yang lain
if (sqltoken = stvalue) dan (lasttoken = stwhere) kemudian
Sqltoken: = stfieldname;
Jika sqltoken dalam sqlsections maka kurseksi: = sqltoken;
sampai sqltoken di [stfieldname, stend];
Jika fhere -found dan (sqltoken di [stfieldname])
mengulang
Sqltoken: = nextsqltoken (start, value, cursection);
Jika sqltoken dalam sqlsections maka kurseksi: = sqltoken;
sampai sqltoken di [stend, stvalue, stisnull, stisnotnull, stfieldname];
Jika nilai = '?' Kemudian
mulai
Ffieldname.add (fname);
Inc (params);
akhir;
sampai (params = count) atau (sqltoken di [stend]);
akhir;
{Tbdequery}
fungsi tbdequery.psgetDefaultOrder: tindexdef;
mulai
Jika fKeyFields = '' lalu
Hasil: = psgetDefaultOrder yang diwariskan
kalau tidak
Mulai // Pesanan Default Tabel Detail
Hasil: = tindexdef.create (nil);
Result.options: = [ixunique]; // Keyfield itu unik
Result.name: = stringreplace (fkeyfields, ';', '_', [rfreplaceall]);
Result.fields: = fkeyfields;
akhir;
akhir;
{TbdeClientDataSet}
constructor tbdeclientdataset.create (aowner: tcomponent);
mulai
warisan create (aowner);
Fdataset: = tbdequery.create (nil);
Fdataset.name: = self.name + 'dataset1';
Provider.dataset: = fdataset;
SQLDBType: = TypeBDe;
Flocalparams: = tparams.create;
akhir;
destructor tbdeclientdataset.destroy;
mulai
Freeandnil (flocalparams);
Fdataset.close;
Freeandnil (fdataset);
warisan warisan;
akhir;
Prosedur tbdeclientdataset.getFieldNames (daftar: tstrings);
var
Dibuka: Boolean;
mulai
Dibuka: = (aktif = false);
mencoba
Jika dibuka lalu
Membuka;
diwarisi getFieldNames (daftar);
Akhirnya
jika dibuka lalu tutup;
akhir;
akhir;
fungsi tbdeClientDataSet.getCommandText: string;
mulai
Hasil: = FCommandText;
akhir;
fungsi tbdeClientDataset.getDataSet: tdataset;
mulai
Hasil: = fdataset sebagai tdataset;
akhir;
Prosedur tbdeclientdataset.CheckMastersourceactive (mastersource: tdataSource);
mulai
jika ditugaskan (mastersource) dan ditugaskan (mastersource.dataset)
Jika bukan mastersource.dataset.active maka
DatabaseError (SmasterNotopen);
akhir;
Prosedur tbdeClientDataset.setParamsFromsql (nilai const: string);
var
Dataset: tquery;
Tablename, Tempquery, Q: String;
DAFTAR: TBDECDSPARAMS;
I: Integer;
Lapangan: Tfield;
mulai
Tablename: = getTablenamefromsql (value);
Jika Tablename <> '' lalu
mulai
Tempquery: = nilai;
Daftar: = tbdecdsparams.create (self);
mencoba
List.parseselect (Tempquery);
List.assignValues (params);
untuk i: = 0 to list.count - 1 do
Daftar [i] .paramType: = ptinput;
Dataset: = tquery.create (nil);
mencoba
Dataset.databasename: = fdataSet.databasename;
T: = GetQuotechar;
Dataset.sql.add ('pilih * dari' + q + tableName + q + 'di mana 0 = 1'); {Jangan melokalisasi}
mencoba
Dataset.open;
untuk i: = 0 to list.count - 1 do
mulai
Jika list.ffieldname.count> saya kemudian
mulai
mencoba
Bidang: = Dataset.FieldByName (list.ffieldName [i]);
kecuali
Bidang: = nil;
akhir;
akhir yang lain
Bidang: = nil;
Jika ditetapkan (bidang) lalu
mulai
Jika field.dataType <> ftstring maka
Daftar [i] .datatype: = field.datatype
lain jika tstringfield (bidang) .fixedchar lalu
Daftar [i] .datatype: = ftfixedchar
kalau tidak
Daftar [i] .datatype: = ftString;
akhir;
akhir;
kecuali
// abaikan semua pengecualian
akhir;
Akhirnya
Dataset.free;
akhir;
Akhirnya
Jika list.count> 0 lalu
Params.assign (daftar);
Daftar. Gratis;
akhir;
akhir;
akhir;
Prosedur tbdeClientDataset.setsql (nilai const: string);
mulai
Jika ditugaskan (provider.dataset) lalu
mulai
Tquery (provider.dataset) .sql.clear;
Jika nilai <> '' maka
Tquery (provider.dataset) .sql.add (nilai);
diwarisi setCommandText (nilai);
akhir yang lain
DatabaseError (SnodataProvider);
akhir;
Prosedur tbdeclientDataset.Loaded;
mulai
diwariskan dimuat;
Jika fstreamedactive maka
mulai
SetActive (true);
Fstreamedactive: = false;
akhir;
akhir;
fungsi tbdeclientDataset.getMasterfields: string;
mulai
Hasil: = Masterfields yang diwariskan;
akhir;
Prosedur TBDeClientDataSet.SetMasterFields (Nilai Const: String);
mulai
Masterfields yang diwariskan: = nilai;
Jika nilai <> '' maka
IndexFieldNames: = nilai;
Fdataset.fkeyfields: = '';
akhir;
Prosedur TBDeClientDataSet.SetCommandText (nilai: String);
mulai
diwarisi setCommandText (nilai);
FCommandText: = nilai;
Jika tidak (csloading di ComponentState) maka
mulai
Fdataset.fkeyfields: = '';
IndexFieldNames: = '';
MasterFields: = '';
IndexName: = '';
IndexDefs.clear;
Params.clear;
if (csdesigning in componentstate) dan (value <> '') kemudian
Setparamsfromsql (nilai);
akhir;
akhir;
fungsi tbdeClientDataSet.getConnection: tdatabase;
mulai
Hasil: = fdatabase;
akhir;
Prosedur tbdeclientDataSet.setConnection (nilai: tdatabase);
mulai
Jika nilai = fdatabase maka keluar;
Checkinactive;
Jika ditetapkan (nilai) lalu
mulai
Jika tidak (csloading di ComponentState) dan (value.databasename = '') lalu
DatabaseError (sdatabasenamemissing);
FdataSet.databasename: = value.databasename;
akhir yang lain
Fdataset.databasename: = '';
Fdatabase: = nilai;
akhir;
fungsi tbdeclientdataset.getquotechar: string;
mulai
Hasil: = '';
jika ditugaskan (fdataset) lalu
Hasil: = fdataset.psgetquotechar;
akhir;
Prosedur tbdeclientdataset.clonecursor (sumber: tcustomclientDataset; reset: boolean;
Keepsettings: boolean = false);
mulai
Jika tidak (sumbernya tbdeclientdataset)
DatabaseError (SinValidClone);
Provider.dataset: = tbdeClientDataset (sumber) .provider.dataset;
DBConnection: = TBDeClientDataSet (Sumber) .DBConnection;
CommandText: = TBDeClientDataSet (Source) .CommandText;
klonecursor yang diwariskan (sumber, reset, pemeliharaan);
akhir;
Prosedur tbdeclientDataSet.notification (Acomponent: TComponent; Operasi: Toperasi);
mulai
pemberitahuan yang diwariskan (Acomponent, Operation);
Jika operasi = opremove maka
Jika Acomponent = fdatabase maka
mulai
Fdatabase: = nil;
SetActive (false);
akhir;
akhir;
Prosedur tbdeclientdataset.setlocalparams;
Prosedur CreateParamsFommasterfields (Buat: Boolean);
var
I: Integer;
DAFTAR: TSTRING;
mulai
Daftar: = TStringList.Create;
mencoba
Jika buat itu
Flocalparams.clear;
Fdataset.fkeyfields: = MasterFields;
List.Commatext: = MasterFields;
untuk i: = 0 to list.count -1 lakukan
mulai
Jika buat itu
Flocalparams.createParam (ftunknown, mastersource.dataset.fieldbyname (daftar [i]). FieldName,
ptinput);
Flocalparams [i] .assignfield (mastersource.dataset.fieldbyname (daftar [i]));
akhir;
Akhirnya
Daftar. Gratis;
akhir;
akhir;
mulai
if (masterfields <> '') dan ditugaskan (mastersource) dan ditugaskan (mastersource.dataset) kemudian
mulai
CreateParamsFommasterfields (true);
FcurrentCommand: = addParamsqlfordetail (flocalparams, commandtext, true, getquotechar);
akhir;
akhir;
Prosedur tbdeclientDataset.setDataSource (nilai: tdataSource);
mulai
Warisan Mastersource: = Nilai;
Jika ditetapkan (nilai) lalu
mulai
jika packetrecords = -1 maka packetrecords: = 0;
akhir yang lain
mulai
Jika PacketRecords = 0 maka PacketRecords: = -1;
akhir;
akhir;
fungsi tbdeclientdataset.getMastersource: tdataSource;
mulai
Hasil: = Sumber MASTERSET yang diwariskan;
akhir;
Prosedur tbdeclientdataset.setDetailSactive (nilai: boolean);
var
Detaillist: tlist;
I: Integer;
mulai
Detaillist: = tlist.create;
mencoba
GetDetailDataSets (Detaillist);
untuk i: = 0 untuk detaillist.count -1 lakukan
Jika tdataset (detaillist [i]) adalah tbdeclientdataset
TbdeClientDataSet (tdataset (detaillist [i])). Aktif: = nilai;
Akhirnya
Detaillist. Bebas;
akhir;
akhir;
Prosedur tbdeClientDataset.setActive (nilai: boolean);
mulai
Jika nilai itu
mulai
Jika csloading di ComponentState maka
mulai
Fstreamedactive: = true;
KELUAR;
akhir;
Jika Masterfields <> '' lalu
mulai
Jika tidak (csloading di ComponentState) maka
Checkmastersourceactive (mastersource);
Setlocalparams;
SetSQL (fcurrentCommand);
Params: = flocalparams;
Fetchparams;
akhir yang lain
mulai
SetSQL (fCommandText);
Jika params.count> 0 lalu
mulai
Fdataset.params: = params;
Fetchparams;
akhir;
akhir;
akhir;
Jika nilai dan (fdataset.ObjectView <> ObjectView)
Fdataset.ObjectView: = ObjectView;
diwarisi setActive (nilai);
SetDetailSactive (nilai);
akhir;
register prosedur;
mulai
RegisterComponents ('bde', [tbdeclientDataSet]);
akhir;
akhir.
// 以上经 dblocalb.pas 改装而成, 可存为任意文件名, 当然扩展名是 pas
// 然后安装此控件即可