基于Midas 技术的多层应用开发包！(0分)

部分原碼(三)
unit dmBaseModuleImp;
interface
uses
Classes, SysUtils, Variants, dmBaseModule,
hmSqlStoreProc, hmOleVariant, hmStrTools, hmSqlTools,
hmOleDataSet;
type
TSqlLoadType = (slSql, slProc);
type
THMSqlEx = class(THMSQL)
private
FModule: integer;
Service: IBaseService;
function GetSqlLanguage: WideString;
public
procedure LoadFromStore(index: integer);
procedure LoadParamV(index: string);
procedure LoadParamF(index: string);
property Module: integer read FModule write FModule;
property BaseService: IBaseService read Service write Service;
property SqlLanguage: WideString read GetSqlLanguage;
end;

THMSqlStoreProcEx = class(THMSqlStoreProc)
private
FModule: integer;
Service: IBaseService;
function GetSqlLanguage: WideString;
public
procedure LoadFromStore(index: integer);
procedure LoadOleParam(index: string);
procedure LoadOleFunc(index: string);
property Module: integer read FModule write FModule;
property BaseService: IBaseService read Service write Service;
property SqlLanguage: WideString read GetSqlLanguage;
end;

type
TBaseDataModule = class(TInterfacedObject, IBaseDataModule)
private
FModule: integer;
function GetOle: IHMOleVariant;
protected
Sql: THMSqlEx;
StoreProc: THMSqlStoreProcEx;
MsgList: TStringList;
Service: IBaseService;
protected
function ActionList(CmdIndex: integer;
var Data, Msg: OleVariant): WordBool;
virtual;
procedure ShowDebug(Msg: string);
procedure ApplyUpdates(Delta: OleVariant;
TableName, KeyField: string);
function GetInnerModuleInfo: WideString;
virtual;
procedure CheckTranstion;
procedure CallServiceReceiveDataV;
procedure CallServiceReceiveDataT;
procedure LoadFromStore(Index: integer;
LoadType: TSqlLoadType);
property Ole: IHMOleVariant read GetOle;
public
constructor Create(const BaseService: IBaseService);
destructor Destroy;
override;
function GetModuleInfo: WideString;
stdcall;
function GetBaseService: IBaseService;
stdcall;
procedure SetBaseService(const Value: IBaseService);
stdcall;
function GetModule(): integer;
stdcall;
procedure SetModule(const value: integer);
stdcall;
function Operation(var Data, Msg: OleVariant): WordBool;
stdcall;
procedure LoadOleParam(const Param: OleVariant);
stdcall;
end;

TBaseDataModuleInfo = class(TInterfacedObject, IDataModuleInfo)
public
function GetModuleName: WideString;
virtual;
stdcall;
function GetVersion: Widestring;
virtual;
stdcall;
function GetDesignner: Widestring;
virtual;
stdcall;
function GetMemo: Widestring;
virtual;
stdcall;
function GetLastUpdate: WideString;
virtual;
stdcall;
function GetModuleIndex: Integer;
virtual;
stdcall;
end;

type
ErrSystemBusy = class(Exception)
public
constructor Create;
end;

implementation
uses swModuleIndex;
{ TBaseDataModule }
constructor TBaseDataModule.Create(const BaseService: IBaseService);
begin
inherited Create;
Service := BaseService;
Sql := THMSqlEx.Create;
StoreProc := THMSqlStoreProcEx.Create;
MsgList := TStringList.Create;
Sql.BaseService := BaseService;
StoreProc.BaseService := BaseService;
end;

destructor TBaseDataModule.Destroy;
begin
Sql.Free;
StoreProc.Free;
MsgList.Free;
inherited Destroy;
end;

(* Operation : 通用執行函數,DataServer將通過它來執行 *)
(* ActionList: 內部重載執行函數,通它重載分析Action來執行 *)
(* Param : 執行參數,須通過Ole.LoadfromOle來讀取參數 *)
(* Data : 返回表格數據 *)
(* Msg : 返回執行信息,或是錯誤信息,或是執行完畢信息*)
function TBaseDataModule.Operation(var Data, Msg: OleVariant): WordBool;
var
CmdIndex: integer;
begin
try
CmdIndex := Service.Params.Action;
Result := ActionList(CmdIndex, Data, Msg);
StoreProc.Clear;
SQL.Params.Clear;
except
on E: Exceptiondo
begin
Msg := E.Message;
Result := False;
end;
end;
end;

function TBaseDataModule.ActionList(CmdIndex: integer;
var Data, Msg: OleVariant): WordBool;
begin
Msg := format('沒有可以執行的命令(%d)', [CmdIndex]);
Result := False;
end;

procedure TBaseDataModule.ShowDebug(Msg: string);
begin
Service.ShowMessage(Msg);
end;

procedure TBaseDataModule.ApplyUpdates(Delta: OleVariant;
TableName, KeyField: string);
begin
Service.ApplyUpdates(Delta, TableName, KeyField);
end;

procedure TBaseDataModule.SetModule(const Value: integer);
begin
FModule := Value;
Sql.Module := Value;
StoreProc.Module := Value;
end;

function TBaseDataModule.GetModule: integer;
begin
Result := FModule;
end;

function TBaseDataModule.GetModuleInfo: WideString;
begin
Result := GetInnerModuleInfo;
end;

function TBaseDataModule.GetInnerModuleInfo: WideString;
begin
Result := 'This is System Default Module(' + ClassName + ')';
end;

function TBaseDataModule.GetBaseService: IBaseService;
begin
Result := Service;
end;

procedure TBaseDataModule.SetBaseService(const Value: IBaseService);
begin
Service := Value;
end;

procedure TBaseDataModule.LoadOleParam(const Param: OleVariant);
begin
//FOle.LoadFromOle(Param);
end;

procedure TBaseDataModule.CallServiceReceiveDataT;
begin
Service.OpenQuery(StoreProc.StoreProc.Text);
Service.ReceiveDataWithDefault;
end;

procedure TBaseDataModule.CallServiceReceiveDataV;
begin
Service.OpenQuery(Sql.OutLines.Text);
Service.ReceiveDataWithDefault;
end;

procedure TBaseDataModule.CheckTranstion;
begin
if Service.InTranstion then
raise ErrSystemBusy.Create;
end;

procedure TBaseDataModule.LoadFromStore(Index: integer;
LoadType: TSqlLoadType);
var
i: integer;
Params, Body: WideString;
begin
if index < 1000 then
i := index + FModule * 1000 + 1
else
i := index;
if Service.GetSqlLanguage(i, Params, Body) then
begin
case LoadType of //
slSql:
begin
Sql.InLines.Text := Body;
end;
slProc:
begin
StoreProc.LoadStoreProc(Body);
StoreProc.LoadParams(Params);
end;
end;
// case
end
else
raise Exception.Create('Stored Sql not found(index:' + inttostr(index));
end;

function TBaseDataModule.GetOle: IHMOleVariant;
begin
Result := Service.Params;
end;

{ THMSqlEx }
function THMSqlEx.GetSqlLanguage: WideString;
begin
Result := OutLines.Text;
end;

procedure THMSqlEx.LoadFromStore(index: integer);
var
i: integer;
Params, Body: WideString;
begin
if index < 1000 then
i := index + FModule * 1000 + 1
else
i := index;
if Service.GetSqlLanguage(i, Params, Body) then
begin
InLines.Text := Body;
end
else
raise Exception.Create('Stored Sql not found(index:' + inttostr(index));
end;

procedure THMSqlEx.LoadParamF(index: string);
begin
Params.ParamValue[index] := '@F ' + Service.Params[index];
end;

procedure THMSqlEx.LoadParamV(index: string);
begin
Params.ParamValue[index] := Service.Params[index];
end;

{ THMSqlStoreProcEx }
procedure THMSqlStoreProcEx.LoadFromStore(index: integer);
var
i: integer;
Params, Body: WideString;
begin
if index < 1000 then
i := index + FModule * 1000 + 1
else
i := index;
if Service.GetSqlLanguage(i, Params, Body) then
begin
LoadStoreProc(Body);
LoadParams(Params);
end
else
raise Exception.Create('Stored Sql not found(index:' + inttostr(index));
end;

procedure THMSqlStoreProcEx.LoadOleParam(index: string);
begin
Self.Value[index] := Service.Params[index];
end;

procedure THMSqlStoreProcEx.LoadOleFunc(index: string);
begin
Self.Value[index] := Service.Params[index];
end;

function THMSqlStoreProcEx.GetSqlLanguage: WideString;
begin
Result := Self.StoreProc.Text;
end;

{ ErrSystemBusy }
constructor ErrSystemBusy.Create;
begin
inherited Create('系統忙:ADO IS Busy');
end;

{ TBaseDataModuleInfo }
function TBaseDataModuleInfo.GetDesignner: Widestring;
begin
Result := 'Aleyn.wu';
end;

function TBaseDataModuleInfo.GetLastUpdate: WideString;
begin
Result := '2003-09-25';
end;

function TBaseDataModuleInfo.GetMemo: Widestring;
begin
Result := 'This is BaseDataModule';
end;

function TBaseDataModuleInfo.GetModuleIndex: Integer;
begin
Result := -1;
end;

function TBaseDataModuleInfo.GetModuleName: WideString;
begin
Result := 'BaseDataModule';
end;

function TBaseDataModuleInfo.GetVersion: Widestring;
begin
Result := '0.0.0.0';
end;

end.

呵呵，我采用自己的协议数据包，也就是在Tcp/Ip 之上，
ClientDataSet 与 Provider 是没有直接連接的！

那不是要写协议规则，出说明书？这怎么行？使用者会不会放弃使用?回到自己写接口？呵呵

自写用协议我觉的有点麻烦,我倒是用了另外一种数据流方式,这么使用者就不会觉得烦琐了.我们要为最终用户着想,同样也要为写规则的同事着想啊.

谢谢！能否发一个研究研究！！
Shrewd_nry@163.com

为什么web service和XML变的很流行, 是因为他们是自描述的协议, 接口实现容易, 方便调试.
Tcp/Ip 协议规约什么的不适合用于商业数据库程序

有空要好好研究一下，好好学习！

to vinson_zeng
看过你的大作了，不过很想看，unit下的code，呵呵
能不发表部分代码研究、研究！只要是人都很贪！。。哈哈
‘是人不是佛’恒等于true。

好像处理的吞吐量不高，三个客户端同时执行demo，延时就会出现，一秒钟快速点击3次open就会出现忙提示，我用多线程压力测试三客户端，每客户端定时一秒取数一次5分钟
就会报错，小弟迂腐只是提一下看法[]

各位老大：
UA SDK 是一种多层应用开发框架，我本人是希望它能
适用于更多的实际开发应用，对于 Source Code ，我会整理部分
出来发布，对于 UA SDK 的压力测试，我本人也不是很严谨！
但我在现在这个 Project 中，客户端有23 个，还没发现
如 lyjnew 兄 所说的情况！

压力测试有很多具体条件才能说明问题。比如：
打开一50个字段的表和打开一个含字段表当然不同，再者根操作系统底层的进程管理也很有关系。unix>windows,跟数据组织形式也有关系xml/dat/db/mdb/mdf/txt，还有很多。。
说多了。。。呵呵
题外：不过每个具体软件我都希望能跟在连帝国游戏那么方便和稳定

谢谢！能否发一个给我学习学习！！感激不尽

To 88jian:
你可以在 www.2ccc.com 下载，文件名称为 UA-Demo！

我有个疑问实在忍不住了,这里请问一下楼主,您说的"我们单位现在为广东电信开发的系统 是 3600万"用的中间架构就是您现在的这套东西吗?我所在的公司也是搞电信开发的,也知道服务器的连接压力有多么大,如果真是的话,您的作品真算的上非常牛B了,看来昂贵Tuxedo也没什么市场了.关注一下.

To Hels：
呵呵，可能你误解我的意思了，我是想说我们公司现在
开发的系统在成本和技术含量对比问题，UA SDK 是为中小型
应用设计开发的；它和Tuxedo根本就是两回事。通常大型系统
都很依赖硬件和操作系统，这相信你很清楚。如果还有别的
问题，还请指点一下！！！

呵呵,正在写一个三层的东西,楼主高人,UP一下

看来楼主对多层开发很有一套！
发给我一套，多谢！
mailto:zhao-zhenhua@163.net

上百万的大项目为什么不用b/s呢？一直以来的疑问。。。

不知道来没来晚。本人也做个三层开发。对BORLAND的三层也比较熟悉。能否发一套给我研究研究
fuby@petrochina.com.cn
或 support@bytem.com

To 各为兄弟：
UA SDK 现在开始进行第二版的结构修改工作，希望能得到各位
的建议。完成后会第一时间在 Delphibbs上发布！
vinson zeng