unidade bdeclientDataSet;
interface
usa janelas, sysutils, variantes, aulas, db, dbCommon, midas,
Sqltimst, dbclient, dblocal, provedor, dbtables;
tipo
{Tbdequiery}
TbDequiery = classe (Tquey)
privado
Fkeyfields: string;
protegido
função psgetDefaultOrder: tindexdef; substituir;
fim;
{TbdeclientDataSet}
TbdeclientDataSet = classe (tcustomcachedDataSet)
privado
FCommandText: string;
FcurrentCommand: string;
Fdataset: tbdequiery;
Fdatabase: tdatabase;
Flocalparams: tparams;
FStreamedActive: booleano;
Procedimento CheckMasterSourCetive (MasterSource: TDataSource);
Procedimento setDetailSactive (valor: booleano);
função getConnection: tdatabase;
função getDataset: tdataset;
função getmasterSource: tdataSource;
função getMasterfields: string;
procedimento setConnection (valor: tdatabase);
Procedimento setDataSource (valor: tdataSource);
procedimento setLocalparams;
Procedimento setMasterFields (const valor: string);
Procedimento setParamsFromSQL (Valor const: String);
Procedimento SetSql (Valor const: String);
protegido
função getCommandText: string; substituir;
procedimento carregado; substituir;
Notificação do procedimento (Acomponente: TComponent; operação: toqueração); substituir;
Procedimento setActive (valor: booleano); substituir;
procedimento setCommandText (valor: string); substituir;
público
Construtor Create (Anowner: TComponent); substituir;
destruidor destruir; substituir;
Procedimento CLONECURSOR (fonte: tcustomClientDataSet; redefinir: booleano;
KeepSettings: boolean = false); substituir;
Procedimento getFieldNames (Lista: TStrings); substituir;
função getQuoteChar: string;
DataSet de propriedade: tdataset leia getDataset;
publicado
propriedade ativa;
Property CommandText: String leia getCommandText write setCommandText;
Propriedade dbConnection: tdatabase Read GetConnection Write setConnection;
Propriedade Masterfields Leia GetMasterFields Write SetMasterFields;
Propriedade MasterSource: tdataSource Read GetmasterSource Write SetDataSource;
fim;
registro de procedimentos;
implementação
usa BDECONST, MIDCONST;
tipo
{Tbdecdsparams}
Tbdecdsparams = classe (tparams)
privado
FieldName: TSTRINGS;
protegido
procedimento parseselect (sql: string);
público
Construtor Create (Proprietário: TpersSistent);
Destruidor destruir; substituir;
fim;
construtor tbdecdsparams.create (proprietário: tpersSistent);
começar
herdado;
FfieldName: = tStringList.create;
fim;
destruidor tbdecdsparams.destroy;
começar
FreeAndnil (FieldName);
herdado;
fim;
procedimento tbdecdsparams.parseselect (sql: string);
const
Sselect = 'select';
var
Feofado: booleano;
Iniciar: PChar;
Fname, valor: string;
SQLTOKen, Maldição, LastToken: TsqlToken;
Params: inteiro;
começar
se pos ('' + sselect + '', minúsculo (string (pchar (sql) +8)))> 1 então saia; // Não é possível analisar sublocontradas
Iniciar: = PChar (ParSesql (PChar (SQL), True));
Maldição: = Stunknown;
LastToken: = Stunknown;
Fweetfound: = false;
Params: = 0;
repita
repita
Sqltoken: = nextSqlToken (start, fname, maldição);
Se sqltoken em [stwhere] então
começar
Fweetfound: = true;
LastToken: = stwhere;
END mais se se Sqltoken em [STTABLENAME] então
começar
{Verifique o nome da tabela qualificada do proprietário}
se start^ = '.' então
NextSqlToken (Start, Fname, Maldição);
fim mais
if (sqltoken = stvalue) e (lastToken = stwhere) então
Sqltoken: = stfieldName;
se sqltoken nas sqlSections, então a maldição: = sqltoken;
até Sqltoken em [STFILDNAME, STEND];
se for acordado e (sqltoken em [sfieldname]) então
repita
SqlToken: = NextSqlToken (Iniciar, valor, maldição);
se sqltoken nas sqlSections, então a maldição: = sqltoken;
Até o SQLTOKen em [stend, Stvalue, StisNull, StisnotNull, StfieldName];
se valor = '?' então
começar
FfieldName.add (fname);
Inc (params);
fim;
até (params = count) ou (sqltoken em [spend]);
fim;
{Tbdequiery}
function tbdequiery.psgetDefaultOrder: tindexdef;
começar
Se fkeyfields = '' então
Resultado: = PsgetDefaultOrder herdado
outro
BEGIN // Tabela de detalhes Ordem padrão
Resultado: = tindexdef.create (nil);
Resultado.Options: = [ixunique]; // keyfield é único
Resultado.name: = stringRapplace (fkeyfields, ';', '_', [rfreplaceall]);
Resultado.fields: = fkeyfields;
fim;
fim;
{TbdeclientDataSet}
construtor tbdeclientDataSet.create (AOWNER: TComponent);
começar
Criar Herited (AOWNER);
FdataSet: = tbdequiery.create (nil);
FdataSet.name: = self.name + 'DataSet1';
Provider.dataSet: = fdataset;
Sqldbtype: = typebde;
Flocalparams: = tparams.create;
fim;
destruidor tbdeclientDataSet.Destroy;
começar
Freeandnil (flocalparams);
Fdataset.close;
Freeandnil (fdataset);
Destrução herdada;
fim;
procedimento tbdeclientDataSet.getFieldNames (Lista: TStrings);
var
Aberto: booleano;
começar
Aberto: = (ativo = false);
tentar
se aberto então
Abrir;
herdado getfieldNames (lista);
finalmente
Se aberto, feche;
fim;
fim;
função tbdeclientDataSet.getCommandText: string;
começar
Resultado: = fCommandText;
fim;
função tbdeclientDataset.getDataset: tdataset;
começar
Resultado: = fdataset como tdataset;
fim;
procedimento tbdeclientDataset.CHECKMASTERSOURCEACTive (MasterSource: tdataSource);
começar
Se atribuído (MasterSource) e designado (MasterSource.dataset), então
se não for masterSource.dataset.active então
DatabaseError (SMASTERNOTOPEN);
fim;
procedimento tbdeclientDataSet.setParamsFromSql (const valor: string);
var
Conjunto de dados: tquey;
TableName, Tempquery, Q: String;
Lista: tbdecdsparams;
I: Inteiro;
Campo: TFIELD;
começar
TableName: = gettableNamefromsql (valor);
Se tablename <> '' então
começar
TempQuery: = Value;
Lista: = tbdecdsparams.create (self);
tentar
List.Parseselect (Tempquery);
List.assignValues (params);
para i: = 0 para listar.count - 1 do
Lista [i] .ParamType: = ptInput;
DataSet: = tquey.create (nil);
tentar
DataSet.databasename: = fdataset.databasename;
Q: = getQuoteChar;
Dados {não localize}
tentar
DataSet.open;
para i: = 0 para listar.count - 1 do
começar
se list.ffieldname.count> eu então
começar
tentar
Campo: = DataSet.fieldbyName (list.ffieldName [i]);
exceto
Campo: = nil;
fim;
fim mais
Campo: = nil;
Se atribuído (campo), então
começar
Se Field.datatype <> ftstring então
Lista [i] .datatype: = field.datatype
caso contrário, se tstringfield (campo) .fixedchar então
Lista [i] .datatype: = ftfixedchar
outro
Lista [i] .datatype: = ftString;
fim;
fim;
exceto
// ignora todas as exceções
fim;
finalmente
DataSet.Free;
fim;
finalmente
se list.count> 0 então
Params.assign (list);
List.Free;
fim;
fim;
fim;
procedimento tbdeclientDataset.setsql (const valor: string);
começar
se atribuído (provider.dataset), então
começar
TQUERY (provider.dataSet) .SQL.clear;
Se valor <> '' então
TQuery (provider.dataSet) .sql.add (valor);
SetCommandText herdado (valor);
fim mais
DatabaseError (SnodataProvider);
fim;
procedimento tbdeclientDataSet.loaded;
começar
carregado herdado;
Se fStreamedActive, então
começar
SetActive (true);
FStreamedActive: = false;
fim;
fim;
função tbdeclientDataSet.getMasterFields: string;
começar
Resultado: = Masterfields herdados;
fim;
procedimento tbdeclientDataSet.setMasterFields (const valor: string);
começar
MasterFields herdados: = value;
Se valor <> '' então
IndexFieldNames: = value;
Fdataset.fkeyfields: = '';
fim;
procedimento tbdeclientDataSet.setCommandText (valor: string);
começar
SetCommandText herdado (valor);
FCommandText: = value;
se não (csloading no componentState) então
começar
Fdataset.fkeyfields: = '';
IndexFieldNames: = '';
MasterFields: = '';
IndexName: = '';
Indexdefs.clear;
Params.clear;
if (csDesigning no componentState) e (valor <> '') então
SetParamsFromSql (valor);
fim;
fim;
função tbdeclientDataSet.getConnection: tdatabase;
começar
Resultado: = fdatabase;
fim;
procedimento tbdeclientDataSet.setConnection (valor: tdatabase);
começar
se value = fdatabase, então saia;
Checkinative;
se atribuído (valor) então
começar
se não (csloading no componentState) e (value.databasename = '') então
DatabaseError (sdatabasenameMissing);
Fdataset.databasename: = value.databasename;
fim mais
Fdataset.databasename: = '';
Fdatabase: = value;
fim;
função tbdeclientDataSet.getQuoteChar: string;
começar
Resultado: = '';
Se atribuído (fdataset), então
Resultado: = fdataset.psgetQuoteChar;
fim;
procedimento tbdeclientDataSet.CloneCursor (fonte: tcustomClientDataSet; redefinir: booleano;
KeepSettings: boolean = false);
começar
Caso contrário (a fonte é tbdeclientDataSet) então
DatabaseError (sinValidClone);
Provider.dataSet: = tbdeclientDataSet (fonte) .Provider.dataset;
DbConnection: = tbdeclientDataSet (fonte) .dbConnection;
CommandText: = tbdeclientDataSet (fonte) .CommandText;
clonecursor herdado (fonte, redefinição, keepSettings);
fim;
procedimento tbdeclientDataSet.Notification (Acomponente: TComponent; operação: toqueração);
começar
notificação herdada (acomponente, operação);
Se operação = Opremove então
Se acomponente = fdatabase então
começar
Fdatabase: = nil;
SetActive (false);
fim;
fim;
procedimento tbdeclientDataSet.setLocalparams;
Procedimento CreateParamsFROMASTERFIELDS (CREATE: Boolean);
var
I: Inteiro;
Lista: TStrings;
começar
Lista: = tStringList.create;
tentar
se criar então
Flocalparams.clear;
Fdataset.fkeyfields: = masterfields;
List.Commatext: = MasterFields;
para i: = 0 para listar.count -1 do
começar
se criar então
Flocalparams.createparam (ftunknown, mastersource.dataset.fieldbyname (list [i]). FieldName,
ptinput);
Flocalparams [i] .assignfield (masterSource.dataset.fieldbyname (list [i]));
fim;
finalmente
List.Free;
fim;
fim;
começar
if (masterfields <> '') e designado (masterSource) e designado (masterSource.dataset) então
começar
CreateParamsFromMasterFields (true);
FcurrentCommand: = addParamsqlfordetail (flocalparams, commandtext, true, getQuoteChar);
fim;
fim;
procedimento tbdeclientDataSet.setDataSource (valor: tdataSource);
começar
masterSource herdado: = value;
se atribuído (valor) então
começar
Se packeTrecords = -1, então packeTrecords: = 0;
fim mais
começar
se packeTrecords = 0, então packeTrecords: = -1;
fim;
fim;
função tbdeclientDataSet.getMasterSource: tdataSource;
começar
Resultado: = MasterSource herdado;
fim;
procedimento tbdeclientDataSet.setDetailSactive (valor: booleano);
var
Detaillist: tlist;
I: Inteiro;
começar
Detestas: = tlist.create;
tentar
GetDetailDataSets (detestas);
para i: = 0 para detaillist.count -1 do
Se tdataset (detestas [i]) for tbdeclientDataSet, então
TbdeclientDataSet (tdataSet (detestas [i])). Ativo: = value;
finalmente
Detestaillist.Free;
fim;
fim;
procedimento tbdeclientDataSet.SetActive (valor: booleano);
começar
Se o valor então
começar
Se csloading no componentState então
começar
FStreamedActive: = true;
saída;
fim;
Se Masterfields <> '' então
começar
se não (csloading no componentState) então
CheckMasterSourCetive (MasterSource);
Setlocalparams;
SetSQL (fcurrentCommand);
Params: = flocalparams;
Fetchparams;
fim mais
começar
SetSQL (fCommandText);
se params.count> 0 então
começar
Fdataset.params: = params;
Fetchparams;
fim;
fim;
fim;
se valor e (fdataset.ObjectView <> ObjectView) Then Then
Fdataset.ObjectView: = ObjectView;
SetActive herdado (valor);
SetDetailSactive (valor);
fim;
registro de procedimentos;
começar
RegisterComponents ('BDE', [tbDeclientDataSet]);
fim;
fim.
// 以上经 dblocalb.pas 改装而成, 可存为任意文件名, 当然扩展名是 pas
// 然后安装此控件即可