TClientDataSet的 fastscript封装

2023-10-21 07:48
文章标签 封装 tclientdataset fastscript

本文主要是介绍TClientDataSet的 fastscript封装，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！

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;

这篇关于TClientDataSet的 fastscript封装的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！


http://www.chinasem.cn/article/252957。

相关文章

JavaSE——封装、继承和多态

JavaSE——封装、继承和多态

1. 封装 1.1 概念      面向对象程序三大特性：封装、继承、多态 。而类和对象阶段，主要研究的就是封装特性。何为封装呢？简单来说就是套壳屏蔽细节 。     比如：对于电脑这样一个复杂的设备，提供给用户的就只是：开关机、通过键盘输入，显示器， USB 插孔等，让用户来和计算机进行交互，完成日常事务。但实际上：电脑真正工作的却是CPU 、显卡、内存等一些硬件元件。
阅读更多...
哈希表的封装和位图

哈希表的封装和位图

文章目录 2 封装2.1 基础框架2.2 迭代器(1)2.3 迭代器(2) 3. 位图3.1 问题引入3.2 左移和右移？3.3 位图的实现3.4 位图的题目3.5 位图的应用 2 封装 2.1 基础框架 文章 有了前面map和set封装的经验，容易写出下面的代码 // UnorderedSet.h#pragma once#include "HashTable.h"
阅读更多...
封装MySQL操作时Where条件语句的组织

封装MySQL操作时Where条件语句的组织

在对数据库进行封装的过程中，条件语句应该是相对难以处理的，毕竟条件语句太过于多样性。 条件语句大致分为以下几种： 1、单一条件，比如：where id = 1; 2、多个条件，相互间关系统一。比如：where id > 10 and age > 20 and score < 60; 3、多个条件，相互间关系不统一。比如：where (id > 10 OR age > 20) AND sco
阅读更多...
Java封装构造方法

Java封装构造方法

private/public的分装 被public修饰的成员变量或者是成员方法，可以被类的调用对象直接使用 而private修饰的成员变量和方法，不能被类的调用对象使用 例如： 可以看到我们是不能在main方法中直接调用被private修饰的变量 当然我们可以在我们定义的TestMode类中可以定一个方法show，然后在调用show方法实现 这里我们可以清楚了解 private 不光可以修
阅读更多...
C++数据结构重要知识点（5）（哈希表、unordered_map和unordered_set封装）

C++数据结构重要知识点（5）（哈希表、unordered_map和unordered_set封装）

1.哈希思想和哈希表 （1）哈希思想和哈希表的区别 哈希（散列、hash）是一种映射思想，本质上是值和值建立映射关系，key-value就使用了这种思想。哈希表（散列表，数据结构），主要功能是值和存储位置建立映射关系，它通过key-value模型中的key来定位数组的下标，将value存进该位置。 哈希思想和哈希表数据结构这两个概念要分清，哈希是哈希表的核心思想。 （2）unordered
阅读更多...
OOP三个基本特征：封装、继承、多态

OOP三个基本特征：封装、继承、多态

OOP三个基本特征：封装、继承、多态 C++编程之—面向对象的三个基本特征 默认分类 2008-06-28 21:17:04 阅读12 评论1字号：大中小     面向对象的三个基本特征是：封装、继承、多态。     封装 封装最好理解了。封装是面向对象的特征之一，是对象和类概念的主要特性。   封装，也就是把客观事物封装成抽象的类，并且类可以把自己的数据和方法只让可信
阅读更多...
Android 优雅封装Glide

Android 优雅封装Glide

文章目录 Android 优雅封装Glide核心思想定义策略接口定义图片选项实现Glide策略图片管理类使用 Android 优雅封装Glide 核心思想 使用策略模式实现不同图片加载框架的切换，使用建造者设计模式处理不同参数，最后通过 ImageLoader 进行管理。 定义策略接口 interface ILoaderStrategy {fun loadImage(co
阅读更多...
JS 封装方式

JS 封装方式

引言：本人是后台服务端开发的，前端的 js 都是在 html 中的 script 标签中写的，处理下数据啥，如果要有需要公共使用的方法啥的都是把方法直接丢在一个 js 文件里，然后 html 引入使用，没有关注过 js 的封装。这天突然对 js 的封装有了兴趣所以有了本文，一下是本人的一些见解。不深见谅。 素材使用的是若依框架中的 ry-ui.js 以及 vue.js ，这里只说封装，不说功能。
阅读更多...
el-table 封装表格（完整代码-实时更新）

el-table 封装表格（完整代码-实时更新）

最新更新时间： 2024年9月6号 1. 添加行内编辑、表头搜索 <template><!-- 简单表格、多层表头、页码、没有合并列行 --><div class="maintenPublictable"element-loading-background="rgba(255,255,255,0.5)"><!--cell-style 改变某一列行的背景色 --><!-- tree-props
阅读更多...
async-http-android框架的介绍和二次封装

async-http-android框架的介绍和二次封装

1。先谈谈框架吧 相信大家一看，就应该想到是一款异步请求的框架了，也就是说他的网络请求是在非UI线程中执行的，而callback在创建他的线程中，应用了Handler的机制。 项目本生的官方网址：http://loopj.com/android-async-http/， 对应的github地址： https://github.com/loopj/android-async-http
阅读更多...

Copyright China编程 23002807@qq.com

沪ICP备2023033072号-2