TClientDataSet的 fastscript封装

// 陈新光 2017-2-10
// TClientDataSet‘s fastscript

unit fs_ClientDataSet;

interface

{$i fs.inc}

uses
SysUtils, Classes, fs_iinterpreter, fs_itools, fs_ievents,
DB, fs_iclassesrtti, Variants, DBClient
{$IFDEF Delphi16}
, System.Types, Controls
{$ENDIF}
;

type
TCDSRTTI = class(TClientDataSet);

TCDSNotifyEvent = class(TfsCustomEvent)
public
procedure DoEvent(Dataset: TClientDataSet);
function GetMethod: Pointer; override;
end;

TCDSErrorEvent = class(TfsCustomEvent)
public
procedure DoEvent(DataSet: TDataSet; E: EDatabaseError;var Action: TDataAction);
function GetMethod: Pointer; override;
end;

TCDSFilterRecordEvent = class(TfsCustomEvent)
public
procedure DoEvent(DataSet: TClientDataSet; var Accept: Boolean);
function GetMethod: Pointer; override;
end;

TCDSFieldGetTextEvent = class(TfsCustomEvent)
public
procedure DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
function GetMethod: Pointer; override;
end;

type
TFunctions = class(TfsRTTIModule)
private
function CallMethod(Instance: TObject; ClassType: TClass;
const MethodName: String; Caller: TfsMethodHelper): Variant;
function GetProp(Instance: TObject; ClassType: TClass;
const PropName: String): Variant;
procedure SetProp(Instance: TObject; ClassType: TClass;
const PropName: String; Value: Variant);
public
constructor Create(AScript: TfsScript); override;
end;
//VAR CDSFunctions: TFunctions;
implementation

type
TByteSet = set of 0..7;
PByteSet = ^TByteSet;

procedure TCDSNotifyEvent.DoEvent(Dataset: TClientDataSet);
begin
CallHandler([Dataset]);
end;

function TCDSNotifyEvent.GetMethod: Pointer;
begin
Result := @TCDSNotifyEvent.DoEvent;
end;

procedure TCDSErrorEvent.DoEvent(DataSet: TDataSet; E: EDatabaseError;var Action: TDataAction);
begin
CallHandler([Dataset,@E,@Action]);
Action := Handler.Params[2].Value;
end;

function TCDSErrorEvent.GetMethod: Pointer;
begin
Result := @TCDSErrorEvent.DoEvent;
end;

procedure TCDSFilterRecordEvent.DoEvent(DataSet: Tclientdataset; var Accept: Boolean);
begin
CallHandler([DataSet, Accept]);
Accept := Handler.Params[1].Value;
end;

function TCDSFilterRecordEvent.GetMethod: Pointer;
begin
Result := @TCDSFilterRecordEvent.DoEvent;
end;

procedure TCDSFieldGetTextEvent.DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
begin
CallHandler([Sender, Text, DisplayText]);
Text := Handler.Params[1].Value;
end;

function TCDSFieldGetTextEvent.GetMethod: Pointer;
begin
Result := @TCDSFieldGetTextEvent.DoEvent;
end;

constructor TFunctions.Create(AScript: TfsScript);
begin
inherited Create(AScript);
with AScript do
begin
with AddClass(TClientDataSet, ‘TDataSet‘) do
begin
AddMethod(‘procedure Open‘, CallMethod);
AddMethod(‘procedure Close‘, CallMethod);
AddMethod(‘procedure First‘, CallMethod);
AddMethod(‘procedure Last‘, CallMethod);
AddMethod(‘procedure Next‘, CallMethod);
AddMethod(‘procedure Prior‘, CallMethod);
AddMethod(‘procedure Cancel‘, CallMethod);
AddMethod(‘procedure Delete‘, CallMethod);
AddMethod(‘procedure Post‘, CallMethod);
AddMethod(‘procedure Append‘, CallMethod);
AddMethod(‘procedure Insert‘, CallMethod);
AddMethod(‘procedure Edit‘, CallMethod);
AddConstructor(‘constructor Create(AOwner: TComponent)‘,CallMethod);

AddMethod(‘function FieldByName(const FieldName: string): TField‘, CallMethod);
AddMethod(‘procedure GetFieldNames(List: TStrings)‘, CallMethod);
AddMethod(‘function FindFirst: Boolean‘, CallMethod);
AddMethod(‘function FindLast: Boolean‘, CallMethod);
AddMethod(‘function FindNext: Boolean‘, CallMethod);
AddMethod(‘function FindPrior: Boolean‘, CallMethod);
AddMethod(‘procedure FreeBookmark(Bookmark: TBookmark)‘, CallMethod);
AddMethod(‘function GetBookmark: TBookmark‘, CallMethod);
AddMethod(‘procedure GotoBookmark(Bookmark: TBookmark)‘, CallMethod);
AddMethod(‘function Locate(const KeyFields: string; const KeyValues: Variant;‘ +
‘Options: TLocateOptions): Boolean‘, CallMethod);
AddMethod(‘function IsEmpty: Boolean‘, CallMethod);
AddMethod(‘procedure EnableControls‘, CallMethod);
AddMethod(‘procedure DisableControls‘, CallMethod);
AddMethod(‘procedure AddIndex(const Name, Fields: string;Options: TIndexOptions)‘,CallMethod);

AddProperty(‘Bof‘, ‘Boolean‘, GetProp, nil);
AddProperty(‘Eof‘, ‘Boolean‘, GetProp, nil);
AddProperty(‘FieldCount‘, ‘Integer‘, GetProp, nil);
AddProperty(‘FieldDefs‘, ‘TFieldDefs‘, GetProp, nil);
AddProperty(‘Fields‘, ‘TFields‘, GetProp, nil);
AddProperty(‘Filter‘, ‘string‘, GetProp, SetProp);
AddProperty(‘Filtered‘, ‘Boolean‘, GetProp, SetProp);
AddProperty(‘FilterOptions‘, ‘TFilterOptions‘, GetProp, SetProp);
AddProperty(‘Active‘, ‘Boolean‘, GetProp, SetProp);
AddProperty(‘Data‘,‘OleVariant‘,GetProp,SetProp);
AddProperty(‘Params‘,‘TParams‘,GetProp,NIL);
AddProperty(‘IndexDefs‘,‘TIndexDefs‘,GetProp,nil);
AddProperty(‘FilterCode‘,‘string‘,GetProp,SetProp);
AddProperty(‘FilterLineListText‘,‘string‘,GetProp,SetProp);
AddProperty(‘FilterLineSQL‘,‘string‘,GetProp,SetProp);
AddProperty(‘FbMustFilter‘,‘Boolean‘,GetProp,SetProp);
AddProperty(‘FbPost‘,‘Boolean‘,GetProp,SetProp);
AddProperty(‘FbMultTable‘,‘Boolean‘,GetProp,SetProp);
AddProperty(‘RecordCount‘,‘Integer‘,GetProp,nil);
AddProperty(‘QFDataSetOpenSQL‘,‘string‘,GetProp,SetProp);

AddEvent(‘BeforeOpen‘, TCDSNotifyEvent);
AddEvent(‘AfterOpen‘, TCDSNotifyEvent);
AddEvent(‘BeforeClose‘, TCDSNotifyEvent);
AddEvent(‘AfterClose‘, TCDSNotifyEvent);
AddEvent(‘BeforeInsert‘, TCDSNotifyEvent);
AddEvent(‘AfterInsert‘, TCDSNotifyEvent);
AddEvent(‘BeforeEdit‘, TCDSNotifyEvent);
AddEvent(‘AfterEdit‘, TCDSNotifyEvent);
AddEvent(‘BeforePost‘, TCDSNotifyEvent);
AddEvent(‘AfterPost‘, TCDSNotifyEvent);
AddEvent(‘BeforeCancel‘, TCDSNotifyEvent);
AddEvent(‘AfterCancel‘, TCDSNotifyEvent);
AddEvent(‘BeforeDelete‘, TCDSNotifyEvent);
AddEvent(‘AfterDelete‘, TCDSNotifyEvent);
AddEvent(‘BeforeScroll‘, TCDSNotifyEvent);
AddEvent(‘AfterScroll‘, TCDSNotifyEvent);
AddEvent(‘OnCalcFields‘, TCDSNotifyEvent);
AddEvent(‘OnFilterRecord‘, TCDSFilterRecordEvent);
AddEvent(‘OnNewRecord‘, TCDSNotifyEvent);
AddEvent(‘OnPostError‘, TCDSErrorEvent);
end;
end;
end;

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
const MethodName: String; Caller: TfsMethodHelper): Variant;
var
_TDataSet: TClientDataSet;
_TIndexDefs:TIndexDefs;

function IntToLocateOptions(i: Integer): TLocateOptions;
begin
Result := [];
if (i and 1) <> 0 then
Result := Result + [loCaseInsensitive];
if (i and 2) <> 0 then
Result := Result + [loPartialKey];
end;

function IntToIndexOptions(i: Integer): TIndexOptions;
begin
Result := [];
if (i = 1) then
Result := Result + [ixPrimary];
if (i = 2) then
Result := Result + [ixUnique];
if (i = 3) then
Result := Result + [ixDescending];
if (i = 4) then
Result := Result + [ixCaseInsensitive];
if (i = 5) then
Result := Result + [ixExpression];
if (i = 6) then
Result := Result + [ixNonMaintained];
end;
procedure IndexDefsAdd(QName, QFields: string;QArgs:Variant);
var ar:TIndexOptions;
i,n:Integer;
begin
n := VarArrayHighBound(QArgs, 1) + 1;
for i := 0 to n - 1 do
begin
ar :=ar+ IntToIndexOptions(QArgs[i]);
end;
_TIndexDefs.Add(QName,QFields,ar);
end;

procedure BsAddIndex(QName, QFields: string;QArgs:Variant);
var ar:TIndexOptions;
i,n:Integer;
begin
n := VarArrayHighBound(QArgs, 1) + 1;
for i := 0 to n - 1 do
begin
ar :=ar+ IntToIndexOptions(QArgs[i]);
end;
_TDataSet.AddIndex(QName,QFields,ar);
end;

begin
Result := 0;
if ClassType = TClientDataSet then
begin
_TDataSet := TClientDataSet(Instance);
if MethodName = ‘OPEN‘ then
_TDataSet.Open
else if MethodName = ‘CLOSE‘ then
_TDataSet.Close
else if MethodName = ‘FIRST‘ then
_TDataSet.First
else if MethodName = ‘LAST‘ then
_TDataSet.Last
else if MethodName = ‘NEXT‘ then
_TDataSet.Next
else if MethodName = ‘PRIOR‘ then
_TDataSet.Prior
else if MethodName = ‘CANCEL‘ then
_TDataSet.Cancel
else if MethodName = ‘DELETE‘ then
_TDataSet.Delete
else if MethodName = ‘POST‘ then
_TDataSet.Post
else if MethodName = ‘APPEND‘ then
_TDataSet.Append
else if MethodName = ‘INSERT‘ then
_TDataSet.Insert
else if MethodName = ‘EDIT‘ then
_TDataSet.Edit
else if MethodName = ‘FIELDBYNAME‘ then
Result := frxInteger(_TDataSet.FieldByName(Caller.Params[0]))
else if MethodName = ‘GETFIELDNAMES‘ then
_TDataSet.GetFieldNames(TStrings(frxInteger(Caller.Params[0])))
else if MethodName = ‘FINDFIRST‘ then
Result := _TDataSet.FindFirst
else if MethodName = ‘FINDLAST‘ then
Result := _TDataSet.FindLast
else if MethodName = ‘FINDNEXT‘ then
Result := _TDataSet.FindNext
else if MethodName = ‘FINDPRIOR‘ then
Result := _TDataSet.FindPrior
else if MethodName = ‘FREEBOOKMARK‘ then
_TDataSet.FreeBookmark(TBookMark(frxInteger(Caller.Params[0])))
{$IFNDEF WIN64}
else if MethodName = ‘GETBOOKMARK‘ then
Result := frxInteger(_TDataSet.GetBookmark)
{$ENDIF}
else if MethodName = ‘GOTOBOOKMARK‘ then
_TDataSet.GotoBookmark(TBookMark(frxInteger(Caller.Params[0])))
else if MethodName = ‘LOCATE‘ then
Result := _TDataSet.Locate(Caller.Params[0], Caller.Params[1], IntToLocateOptions(Caller.Params[2]))
else if MethodName = ‘ISEMPTY‘ then
Result := _TDataSet.IsEmpty
else if MethodName = ‘ENABLECONTROLS‘ then
_TDataSet.EnableControls
else if MethodName = ‘DISABLECONTROLS‘ then
_TDataSet.DisableControls
else if MethodName=‘CREATE‘ then
Result := frxInteger(TComponent(Instance).Create(TComponent(frxInteger(Caller.Params[0]))))
else if MethodName=‘ADDINDEX‘ then
BsAddIndex(Caller.Params[0], Caller.Params[1],Caller.Params[2])
end
else
if ClassType = TIndexDefs then
begin
_TIndexDefs := TIndexDefs(Instance);
if MethodName=‘ADD‘ then
IndexDefsAdd(Caller.Params[0],Caller.Params[1],Caller.Params[2])
end;
end;

function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
const PropName: String): Variant;
var
_TDataSet: TClientDataSet;

function FilterOptionsToInt(f: TFilterOptions): Integer;
begin
Result := 0;
if foCaseInsensitive in f then
Result := Result or 1;
if foNoPartialCompare in f then
Result := Result or 2;
end;

begin
Result := 0;
if ClassType = TClientDataSet then
begin
_TDataSet := TClientDataSet(Instance);
if PropName = ‘BOF‘ then
Result := _TDataSet.Bof
else if PropName = ‘EOF‘ then
Result := _TDataSet.Eof
else if PropName = ‘FIELDCOUNT‘ then
Result := _TDataSet.FieldCount
else if PropName = ‘FIELDDEFS‘ then
Result := frxInteger(_TDataSet.FieldDefs)
else if PropName = ‘FIELDS‘ then
Result := frxInteger(_TDataSet.Fields)
else if PropName = ‘FILTER‘ then
Result := _TDataSet.Filter
else if PropName = ‘FILTERED‘ then
Result := _TDataSet.Filtered
else if PropName = ‘FILTEROPTIONS‘ then
Result := FilterOptionsToInt(_TDataSet.FilterOptions)
else if PropName = ‘ACTIVE‘ then
Result := _TDataSet.Active
else if PropName = ‘DATA‘ then
Result := _TDataSet.Data
else if PropName = ‘PARAMS‘ then
Result := frxInteger(_TDataSet.Params)
else if PropName = ‘INDEXDEFS‘ then
Result := frxInteger(_TDataSet.IndexDefs)
else if PropName = ‘RECORDCOUNT‘ then
Result := _TDataSet.RecordCount;
end
end;

procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
const PropName: String; Value: Variant);
var
_TDataSet: TClientDataSet;

function IntToFilterOptions(i: Integer): TFilterOptions;
begin
Result := [];
if (i and 1) <> 0 then
Result := Result + [foCaseInsensitive];
if (i and 2) <> 0 then
Result := Result + [foNoPartialCompare];
end;

begin
if ClassType = TClientDataSet then
begin
_TDataSet := TClientDataSet(Instance);
if PropName = ‘FILTER‘ then
_TDataSet.Filter := Value
else if PropName = ‘FILTERED‘ then
_TDataSet.Filtered := Value
else if PropName = ‘FILTEROPTIONS‘ then
_TDataSet.FilterOptions := IntToFilterOptions(Value)
else if PropName = ‘ACTIVE‘ then
_TDataSet.Active := Value
ELSE if PropName = ‘DATA‘ then
_TDataSet.Data := Value;
end
end;

initialization
fsRTTIModules.Add(TFunctions);
finalization
fsRTTIModules.Remove(TFunctions);

end.

调用：

procedure TForm1.Button1Click(Sender: TObject);
var
test: TClientDataSet;
begin
test := TClientDataSet.Create(self);
fsScript1.Clear;
fsScript1.AddRTTI;
fsScript1.AddClass(TClientDataSet, ‘TDataSet‘);
fsScript1.AddObject(‘test‘, Test);

//代码开始
fsScript1.Lines.Add(‘begin‘);
fsScript1.Lines.Add(‘test.close;‘);
fsScript1.Lines.Add(‘test.commandtext:=‘‘‘‘‘);
fsScript1.Lines.Add(‘end.‘);

if fsScript1.run then
begin
ShowMessage(‘编译正常‘);
end
else
ShowMessage(‘发现错误:‘ + fsScript1.ErrorMsg + ‘ 位置在:‘ + fsScript1.ErrorPos);
end;

时间： 2024-08-03 21:34:02

TClientDataSet的 fastscript封装的相关文章

TClientDataSet使用要点

TClientDataSet控件继承自TDataSet,其数据存储文件格式扩展名为 .cds,是基于文件型数据存储和操作的控件.该控件封装了对数据进行操作处理的接口和功能,而本身并不依赖上述几种数据库驱动程序,基本上能满足单机"瘦"数据库应用程序的需要. 一.TClientDataSet的基本属性和方法介绍 1)．FieldDefs: 字段定义列表属性 开发者可通过单击属性编辑器中该属性编辑按钮,或在该控件上单击右键选择弹出菜单中的"Fields Editor"菜单

Delphi 中的DLL 封装和调用对象技术（刘艺，有截图）

Delphi 中的DLL 封装和调用对象技术本文刊登2003 年10 月份出版的Dr.Dobb's 软件研发第3 期刘 艺摘 要DLL 是一种应用最为广泛的动态链接技术但是由于在DLL 中封装和调用对象受到对象动态绑定机制的限制使得DLL 在封装对象方面有一定的技术难度导致有些Delphi 程序员误以为DLL 只支持封装函数不支持封装对象本文着重介绍了DLL 中封装和调用对象的原理和思路并结合实例给出了多种不同的实现方法关键字动态链接库DLL 对象接口虚方法动态绑定类引用面向对象1 物理封装与动

TClientDataSet的基本属性和方法介绍

原文来自:http://www.delphitop.com/html/kongjian/2079.html TClientDataSet控件继承自TDataSet,其数据存储文件格式扩展名为 .cds,是基于文件型数据存储和操作的控件.该控件封装了对数据进行操作处理的接口和功能,而本身并不依赖上述几种数据库驱动程序,基本上能满足单机"瘦"数据库应用程序的需要. 1．TClientDataSet的基本属性和方法介绍 1)．FieldDefs: 字段定义列表属性 开发者可通过单击属性编辑器

delphi开发学习四：TClientDataSet与TDataSetProvider控件使用实例

1.TClientDataSet控件 通过TClientDataSet控件可以建立瘦客户端的应用程序,且数据执行效率较高,但它不能和数据库自动连接,程序中必须制定它如何获取数据.一般情况下,TClientDataSet 控件获取数据的方式主要有 3 种:从本地文件中获取.从本地的另外一个数据集对象中获取以及通过 IAppServer 接口来获取. 2．TDataSetProvider 控件TDataSetProvider 控件基于数据集为应用程序中的其他控件提供数据, 并将对数据的更新传回数据集

mormot接口封装

mormot基于http.sys通讯,支持海量并发,用mormot开发的服务端,长时间运行非常稳定. 经常有人说mormot晦涩难懂,但经过封装以后的MORMOT接口,调用异常简单.支持DELPHI7及以上版本调用哦! procedure TForm1.DownFile(filename: string); // 下载文件 var url: SockString; i: integer; serial: TynSerial; ms: TMemoryStream; begin serial :=

python学习 面向对象封装

from collectoins import namedtuplePoint=namedtuple('point',['x','y'])t1=Point(1,2)print(t1.x)print(t1.y)没有方法的类属性不会发生变化    定义简单 不能改变面向对象封装私有属性!!!私有方法!!!用装饰器描述的几个方法@property !!!@classmethod!!@staticmethod! 封装:class Teacher:     def __init__(self,name,p

python—面向对象的封装

封装 私有属性 class Teacher: __identifier = 'Teacher' #私有静态属性 def __init__(self,name,pwd) self.name = name self.__pwd = pwd #私有属性 内部使用,外部不能使用 def pwd(self): print(self.__pwd) alex = Teacher('alex','3714') alex.pwd() class Teacher: __identifier = 'Teacher'

dbutils封装对象，单列，一行一列(用)

基本用法:查找并封装对象与对象集合 public User findUserByNamePassword(String name,String password){ QueryRunner runner = new QueryRunner(DataSourceUtils.getDataSource()); String sql = "select * from user where name='"+name+"' and password = '"+password

python基础--接口与归一化设计、封装、异常、网络编程

1 接口与归一化设计 1.1 归一化概念: 归一化的好处: 1.归一化让使用者无需关心对象的类是什么,只需要知道这些对象都具备某些功能就可以了,这极大降低了使用者的使用难度. 2.归一化使得高层的外部使用者可以不加区分的处理所有接口兼容的对象集合 继承的两种用途 一:继承基类的方法,并且做出自己改变或者扩展(代码重用):实践中,继承的这种用途意义并不很大,甚至常常是有害的.因为它使得子类与基类出现强耦合. 二:声明某个子类兼容于某基类,定义一个接口类(模仿java的Interface),接口类中