DCNF for Delphi 多层应用开发套件(0分)

DCNF 采用RSOMC(Remote Service Object Method Call)远程服务对象方法调用机制,分层结构实现.
1.网络通信适配层
2.服务对象管理层
3.应用业务层(For Delphi VCL 组件)

容易学习,灵活的扩展机制.兼容原有的应用开发环境(譬如:VCL DB 控件),
利于旧系统迁移(大部分成熟的应用软件都是C/S结构,其业务功能非常完善,
为了能在互联网上直接使用,技术解决方案大部分为VPN,远程桌面等,
采用第三方支持技术实现,加重用户使用运维成本,并没有直接提升产品本身价值)
所以采用一种平滑的迁移技术方案,从而提高产品的竞争优势,延长产品生命周期.

传统Win32客户端应用模式
Win32 GUI Client->Application Server->Service Object Adapter->Service Object Pool(Stateless)->DBMS(Oracle,DB2,MS-SQL..)
浏览器客户端模式
Web Browser(IE/Firefox)->Web Server(IIS)->Application Server->Service Object Adapter->Service Object Pool(Stateless)->DBMS(Oracle,DB2,MS-SQL...)

3.1.基于记录行级的提交(Insert,Delete,Modify)前后事件触发机制
在成熟的C/S结构中,大部分的业务逻辑都是在数据库端以储存过程或者触发器等机制实现.
而作为面向Internet的多层结构应用,严格来说,业务逻辑应该在应用层实现,而不是数据库
端.譬如:销售订单审核,业务实现是将表头某个标记字段值改变同时触发执行其他业务逻辑.
如果应用层直接提供触发机制,那么在应用层封装业务逻辑非常容易,相反,那就得在数据库中
实现了.
3.2.自动记录分页
为什么要将记录分页?在大部分的C/S结构应用软件中,几乎是没有这种机制,因为基本上C/S
结构应用软件的测试/生产环境都是在本地局域网中,通信质量是可以保证的(但是我们经常会
听到用户说,系统越用越慢,可想而知,数据可是每天都在增加,而带宽可不是.这时候软件产商
大部分都是建议用户做硬件升级来解决).那么在Internet环境中,通信质量就更重要,就如Google
一样,如果10000个用户同时都键入"中国"来搜索,然后将所有查询结果全部一次性下载到本地,
估计Google的服务器得趴窝.
3.3.多表一次性提交和自动事务管理
我们都知道Midas中的TClientDataSet提供ApplyUpdates方法用于将变动过的记录集提交保存.
但是并不支持多表关联一次性提交.譬如:销售订单有表头和订单明细组成,在提交张订单的时候,
如果表头提交成功而订单明细提交失败那就麻烦了.
3.4.无状态自动数据代理
一说用Midas实现多层结构应用,我就想到TRemoteDataMoudle中一堆的
TClientDataSet/TDataSetProvider/TDataSet控件,导致无论开发还是维护都费时费力.
采用无状态数据代理模式,简化应用层的服务实现.提高产品的开发与维护质量.

下载:http://www.fs2you.com/files/30953ae8-2c5c-11dd-99e9-0014221f3995/

增加对Delphi 7的支持,欢迎各位到www.2ccc.com下载使用

思路不错，期待源码共同学习 ;>

能有新的产品推出，帮你顶
不过你推出的时间是否太晚
市面上现在已有很多成熟的类似产品
估计会用你的产品做应用的很少

就不知道效率如何,能并发的客户端有多少

呵呵,当时我也考虑比较市面的其他产品,有什么不一样.
最后发现最大的特点就是简便,DCNF不光考虑了原有Midas
的几点不足,同时也为整个开发过程(调试这项工作在开发过程很重要)
和后期部署维护(升级)考虑.
一个好的面向互联网应用的多层应用开发技术首要问题就是网络通信质量.
zhaodelin兄问的好,
其实DCNF中的dcnf_win32.dll 就是DCNF中的网络通信和服务对象管理库.
也就是DCNF中的基础库.如果不使用For VCL组件包,完全是一个高性能的
通信组件库.我的测试环境是:3 台普通PC,每台模式100个客户访问,每隔
一秒向服务器请求一次信息,应用服务器为:1G 内存, CPU为1.6的双核.
网络环境为LAN 100MB.呵呵,服务器可是应付自如.

{************************************************************************}
{ }
{ Network Commication Of Distributed Framwork Library }
{ }
{ Copyright (C) 2007,2008 hulong.zeng@hotmail.com }
{ }
{************************************************************************}
unit dcnf_NetSvc;
interface
{$I dcnf.inc}
uses Windows, SysUtils, Classes, Forms, Controls, ComObj, ActiveX,
dcnf_win32_TLB,dcnf_ObjectPool;
type
TNetEvent = procedure(const SockHandle: LongWord) of object;
TNetErrorEvent = procedure(const SockHandle: LongWord;
const ErrorCode:LongWord) of object;
//for application server
TNetRequest = procedure(const req: IRequestPacket;
var resp: IResponsePacket) of object;
TNetNotice = procedure(const strMsg: WideString) of object;
//for client
TRequestHandler = procedure(const req: IRequestPacket;
var isOk: WordBool) of object;
TNetSvcServer = class;
TNetSvcClient = class;
TSvcWorkerStatus = (swsIdle, swsWaitForData, swsProcessing, swsInvalid);
// for internal callback used,let it along
TNetServerEvent = class(TInterfacedObject, INetServerEvent)
protected
FOwner: TNetSvcServer;
public
function onNetConnect(SockHandle: SYSUINT): HResult;
stdcall;
function onNetDisConnect(SockHandle: SYSUINT): HResult;
stdcall;
function onNetException(SockHandle: SYSUINT;
ErrorCode: SYSUINT): HResult;
stdcall;
function onRequest(const req: IRequestPacket;
out resp: IResponsePacket):
HResult;
stdcall;
function onNotice(const strMsg: WideString): HResult;
stdcall;
procedure SetOwner(const AOwner: TNetSvcServer);
function GetOwner: TNetSvcServer;
end;

TNetClientEvent = class(TInterfacedObject, INetClientEvent)
protected
FOwner: TNetSvcClient;
public
function onNetConnect(SockHandle: SYSUINT): HResult;
stdcall;
function onNetDisConnect(SockHandle: SYSUINT): HResult;
stdcall;
function onNetException(SockHandle: SYSUINT;
ErrorCode: SYSUINT): HResult;stdcall;
function beforeRequest(const req: IRequestPacket;
out isOk: WordBool):HResult;
stdcall;
function onWaitFetchEventInterrupt: HResult;
stdcall;
procedure SetOwner(const AOwner: TNetSvcClient);
function GetOwner: TNetSvcClient;
end;
//========%% end of %%===========================================
TSvcObjectBroker=class(TInterfacedObject,ISvcObjectBroker)
private
FSvcObjPools:TList;
FDBConnPool:IObjectPool;
//// add by hulong.zeng 2008-05-02
FdbConnMgrCB: TObjMgrCBEvent;
procedure SetdbConnMgrCB(const Value: TObjMgrCBEvent);
////
function indexOfSvcObject(const classGUID:WideString):integer;
protected
function lockSvcObject(const classGUID: WideString;
out Value: ISvcObject): HResult;
stdcall;
function unlockSvcObject(const classGUID: WideString;
const svcObject: ISvcObject): HResult;
stdcall;
public
function registerSvcObjPooler(
const classGUID: WideString;
maxCount: Word;
timeOut: Word;
const decription: WideString;
const libFile: WideString;
const objMgrCBProc:string): Longint;
procedure registerDBConnPooler(
const maxCount:Word;
const timeOut:Word);
constructor Create;
destructor Destroy;
override;
//// add by hulong.zeng 2008-05-02
property dbConnMgrCB:TObjMgrCBEvent read FdbConnMgrCB write SetdbConnMgrCB;
////
end;

TNetSvcServer = class(TComponent) //for application server
private
FonNetDisConnect: TNetEvent;
FonNotice: TNetNotice;
FonRequest: TNetRequest;
FonNetException: TNetErrorEvent;
FonNetConnect: TNetEvent;
function Getactive: Boolean;
function GetbackLog: LongWord;
function GetcheckPeriod: LongWord;
function GetconnectionPoolTimeout: LongWord;
function GetdisableNagle: Boolean;
function GetkeepAlive: Boolean;
function GetlistenerPeriod: LongWord;
function GetmaxConnections: LongWord;
function GetsvcAddress: WideString;
function GetsvcPort: LongWord;
procedure Setactive(const Value: Boolean);
procedure SetbackLog(const Value: LongWord);
procedure SetcheckPeriod(const Value: LongWord);
procedure SetconnectionPoolTimeout(const Value: LongWord);
procedure SetdisableNagle(const Value: Boolean);
procedure SetkeepAlive(const Value: Boolean);
procedure SetlistenerPeriod(const Value: LongWord);
procedure SetmaxConnections(const Value: LongWord);
procedure SetsvcAddress(const Value: WideString);
procedure SetsvcPort(const Value: LongWord);
procedure SetonNetConnect(const Value: TNetEvent);
procedure SetonNetDisConnect(const Value: TNetEvent);
procedure SetonNetException(const Value: TNetErrorEvent);
procedure SetonNotice(const Value: TNetNotice);
procedure SetonRequest(const Value: TNetRequest);
protected
FNetServerEvent: TNetServerEvent;
FNetServer: INetServer;
FSvcObjectBroker:TSvcObjectBroker;
function _IsOk: Boolean;
procedure Loaded;
override;
procedure Notification(
AComponent: TComponent;
Operation: TOperation);
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure registerSvcObject(
const classGUID: WideString;
const maxCount: LongWord;
const timeOut: LongWord;
const decription: WideString;
const libFile: WideString;
const objMgrCBProc:string);
procedure registerDBConnPooler(
const maxCount:Word;
const timeOut:Word;
const dbConnMgrCB:TObjMgrCBEvent);
//ext method
function getIdleConnectionsCount: LongWord;
function getBusyConnectionsCount: LongWord;
function getCurrentConnectionsCount: LongWord;
procedure releaseConnection(Index: LongWord);
function getConnectionHandle(Index: LongWord): LongWord;
function getConnectionRemotePort(Index: LongWord): LongWord;
function getConnectionRemoteAddress(Index: LongWord): WideString;
function getConnectionStatus(Index: LongWord): TSvcWorkerStatus;
//ext event interface
property onRequest: TNetRequest read FonRequest write SetonRequest;
property onNetConnect: TNetEvent read FonNetConnect write SetonNetConnect;
property onNetDisConnect: TNetEvent read FonNetDisConnect write
SetonNetDisConnect;
property onNetException: TNetErrorEvent read FonNetException write
SetonNetException;
property onNotice: TNetNotice read FonNotice write SetonNotice;
//property
property active: Boolean read Getactive write Setactive;
property svcAddress: WideString read GetsvcAddress write SetsvcAddress;
property svcPort: LongWord read GetsvcPort write SetsvcPort;
property keepAlive: Boolean read GetkeepAlive write SetkeepAlive;
property listenerPeriod: LongWord read GetlistenerPeriod write
SetlistenerPeriod;
property disableNagle: Boolean read GetdisableNagle write SetdisableNagle;
property checkPeriod: LongWord read GetcheckPeriod write SetcheckPeriod;
property backLog: LongWord read GetbackLog write SetbackLog;
property connectionPoolTimeout: LongWord read GetconnectionPoolTimeout write
SetconnectionPoolTimeout;
property maxConnections: LongWord read GetmaxConnections write
SetmaxConnections;
end;

TNetSvcClient = class(TComponent) //for client
private
FonNetDisConnect: TNetEvent;
FbeforeRequest: TRequestHandler;
FonNetException: TNetErrorEvent;
FonNetConnect: TNetEvent;
procedure SetbeforeRequest(const Value: TRequestHandler);
procedure SetonDisConnect(const Value: TNetEvent);
procedure SetonNetConnect(const Value: TNetEvent);
procedure SetonNetException(const Value: TNetErrorEvent);
function Getactive: Boolean;
function GetcheckPeriod: LongWord;
function GetdisableNagle: Boolean;
function GetkeepAlive: Boolean;
function GetsvrAddress: WideString;
function GetsvrPort: LongWord;
function GettimeOut: LongWord;
procedure Setactive(const Value: Boolean);
procedure SetcheckPeriod(const Value: LongWord);
procedure SetdisableNagle(const Value: Boolean);
procedure SetkeepAlive(const Value: Boolean);
procedure SetsvrAddress(const Value: WideString);
procedure SetsvrPort(const Value: LongWord);
procedure SettimeOut(const Value: LongWord);
protected
FNetClient: INetClient;
FNetClientEvent: TNetClientEvent;
procedure Loaded;
override;
procedure Notification(
AComponent: TComponent;
Operation: TOperation);
override;
functiondo
Request(const req: IRequestPacket): IResponsePacket;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
//ext method
function getNetProxy: INetProxy;
//ext event interface
property onNetConnect: TNetEvent read FonNetConnect write SetonNetConnect;
property onNetDisConnect: TNetEvent read FonNetDisConnect write
SetonDisConnect;
property onNetException: TNetErrorEvent read FonNetException write
SetonNetException;
property beforeRequest: TRequestHandler read FbeforeRequest write
SetbeforeRequest;
//property
property active: Boolean read Getactive write Setactive;
property svrAddress: WideString read GetsvrAddress write SetsvrAddress;
property svrPort: LongWord read GetsvrPort write SetsvrPort;
property keepAlive: Boolean read GetkeepAlive write SetkeepAlive;
property checkPeriod: LongWord read GetcheckPeriod write SetcheckPeriod;
property disableNagle: Boolean read GetdisableNagle write SetdisableNagle;
property timeOut: LongWord read GettimeOut write SettimeOut;
end;

//提供对本地COM对象调用封装
TLocalSvcServer = class
private
FSvcObjBroker: TSvcObjectBroker;
protected
procedure registerSvcObject(
const classGUID: WideString;
const maxCount: Word;
const timeOut: Word;
const decription: WideString;
const libFile: WideString;
const objMgrCBProc:string);
procedure registerDBConnPooler(
const maxCount:Word;
const timeOut:Word;
const dbConnMgrCB:TObjMgrCBEvent);
functiondo
Request(
const classGUID: WideString;
const dbScheme:string;
const svcMethod: WideString;
const req: IRequestPacket): IResponsePacket;
public
constructor Create;
virtual;
destructor Destroy;
override;
end;

TSvcProvider = class(TComponent)
private
FclassGUID: string;
FnetSvcClient: TNetSvcClient;
FdbScheme: string;
procedure SetdbScheme(const Value: string);
{$IFDEF WAN}
procedure SetnetSvcClient(const Value: TNetSvcClient);
{$ENDIF}
procedure SetclassGUID(const Value: string);
protected
FlocalSvc: Boolean;
procedure Loaded;
override;
procedure Notification(
AComponent: TComponent;
Operation: TOperation);
override;
function hasValidSvc: Boolean;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
functiondo
Request(
const svcMethod: WideString;
const req: IRequestPacket): IResponsePacket;
{$IFNDEF WAN}
procedure registerLocalSvcObject(
const maxCount: LongWord;
const timeOut: LongWord;
const decription: WideString;
const libFile: WideString;
const objMgrCBProc:string);
procedure registerDBConnPooler(
const maxCount:Word;
const timeOut:Word;
const dbConnMgrCB:TObjMgrCBEvent);
{$ENDIF}
{$IFDEF WAN}
property netSvcClient: TNetSvcClient read FnetSvcClient write
SetnetSvcClient;
{$ENDIF}
published
property classGUID: string read FclassGUID write SetclassGUID;
property dbScheme:string read FdbScheme write SetdbScheme;
end;

function NewRequestPacket: IRequestPacket;
procedure ReleaseRequestPacket(var req: IRequestPacket);
function NewResponsePacket: IResponsePacket;
procedure ReleaseResponsePacket(var resp: IResponsePacket);
procedure Register;
implementation
{$IFNDEF WAN}
var
LocalSvcServer: TLocalSvcServer;
//only one instance!!!
{$ENDIF}
procedure Register;
begin
RegisterComponents('DCNF', [TNetSvcServer, TSvcProvider, TNetSvcClient]);
end;

{$IFNDEF WAN}
function getLocalSvcServer: TLocalSvcServer;
begin
if LocalSvcServer = nil then
LocalSvcServer := TLocalSvcServer.Create;
Result := LocalSvcServer;
end;
{$ENDIF}
function NewRequestPacket: IRequestPacket;
begin
Result := nil;
Result := CoRequestPacket.Create;
end;

procedure ReleaseRequestPacket(var req: IRequestPacket);
begin
if req <> nil then
req := nil;
end;

function NewResponsePacket: IResponsePacket;
begin
Result := nil;
Result := CoResponsePacket.Create;
end;

procedure ReleaseResponsePacket(var resp: IResponsePacket);
begin
if resp <> nil then
resp := nil;
end;

{ TNetServerEvent }
function TNetServerEvent.GetOwner: TNetSvcServer;
begin
Result := FOwner;
end;

function TNetServerEvent.onNetConnect(SockHandle: SYSUINT): HResult;
begin
Result := S_OK;
if Assigned(FOwner.onNetConnect) then
FOwner.onNetConnect(SockHandle);
end;

function TNetServerEvent.onNetDisConnect(SockHandle: SYSUINT): HResult;
begin
Result := S_OK;
if Assigned(FOwner.onNetDisConnect) then
FOwner.onNetDisConnect(SockHandle);
end;

function TNetServerEvent.onNetException(SockHandle,
ErrorCode: SYSUINT): HResult;
begin
Result := S_OK;
if Assigned(FOwner.onNetException) then
FOwner.onNetException(SockHandle, ErrorCode);
end;

function TNetServerEvent.onNotice(const strMsg: WideString): HResult;
begin
Result := S_OK;
if Assigned(FOwner.onNotice) then
FOwner.onNotice(strMsg);
end;

function TNetServerEvent.onRequest(
const req: IRequestPacket;
out resp: IResponsePacket): HResult;
begin
if Assigned(FOwner.onRequest) then
FOwner.onRequest(req, resp);
Result := S_OK;
end;

procedure TNetServerEvent.SetOwner(const AOwner: TNetSvcServer);
begin
FOwner := AOwner;
end;

{ TNetClientEvent }
function TNetClientEvent.beforeRequest(const req: IRequestPacket;
out isOk: WordBool): HResult;
begin
Result := S_OK;
if Assigned(FOwner.beforeRequest) then
FOwner.beforeRequest(req, isOk);
end;

function TNetClientEvent.GetOwner: TNetSvcClient;
begin
Result := FOwner;
end;

function TNetClientEvent.onNetConnect(SockHandle: SYSUINT): HResult;
begin
Result := S_OK;
if Assigned(FOwner.onNetConnect) then
FOwner.onNetConnect(SockHandle);
end;

function TNetClientEvent.onNetDisConnect(SockHandle: SYSUINT): HResult;
begin
Result := S_OK;
if Assigned(FOwner.onNetDisConnect) then
FOwner.onNetDisConnect(SockHandle);
end;

function TNetClientEvent.onNetException(SockHandle,
ErrorCode: SYSUINT): HResult;
begin
Result := S_OK;
if Assigned(FOwner.onNetException) then
FOwner.onNetException(SockHandle, ErrorCode);
end;

function TNetClientEvent.onWaitFetchEventInterrupt: HResult;
begin
Application.ProcessMessages;
Result := S_OK;
end;

procedure TNetClientEvent.SetOwner(const AOwner: TNetSvcClient);
begin
FOwner := AOwner;
end;

{ TNetSvcServer }
constructor TNetSvcServer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FNetServerEvent := TNetServerEvent.Create;
FNetServer := (CreateComObject(CLASS_NetServer) as INetServer);
FNetServer.netInit;
FNetServer.setNetServerEvent(FNetServerEvent as INetServerEvent);
FNetServerEvent.SetOwner(Self);
FonNetDisConnect := nil;
FonNotice := nil;
FonRequest := nil;
FonNetException := nil;
FonNetConnect := nil;
end;

destructor TNetSvcServer.Destroy;
begin
if FNetServerEvent <> nil then
FNetServerEvent := nil;
if FNetServer <> nil then
FNetServer := nil;
if FSvcObjectBroker <> nil then
FSvcObjectBroker := nil;
inherited Destroy;
end;

function TNetSvcServer.Getactive: Boolean;
begin
Result := FNetServer.active;
end;

function TNetSvcServer.GetbackLog: LongWord;
begin
Result := FNetServer.backLog;
end;

function TNetSvcServer.getBusyConnectionsCount: LongWord;
begin
Result := 0;
if not _IsOk then
Exit;
Result := FNetServer.getBusyConnectionsCount;
end;

function TNetSvcServer.GetcheckPeriod: LongWord;
begin
Result := FNetServer.checkPeriod;
end;

function TNetSvcServer.getConnectionHandle(Index: LongWord): LongWord;
begin
Result := 0;
if not _IsOk then
Exit;
Result := FNetServer.getConnectionHandle(Index);
end;

function TNetSvcServer.GetconnectionPoolTimeout: LongWord;
begin
Result := FNetServer.connectionPoolTimeout;
end;

function TNetSvcServer.getConnectionRemoteAddress(Index: LongWord): WideString;
begin
Result := '';
if not _IsOk then
Exit;
Result := FNetServer.getConnectionRemoteAddress(Index);
end;

function TNetSvcServer.getConnectionRemotePort(Index: LongWord): LongWord;
begin
Result := 0;
if not _IsOk then
Exit;
Result := FNetServer.getConnectionRemotePort(Index);
end;

function TNetSvcServer.getConnectionStatus(Index: LongWord): TSvcWorkerStatus;
begin
Result := swsInvalid;
if not _IsOk then
Exit;
case FNetServer.getConnectionStatus(Index) of
wtsIdle: Result := swsIdle;
wtsWaitForData: Result := swsWaitForData;
wtsProcessing: Result := swsProcessing;
wtsInvalid: Result := swsInvalid;
else
Result := swsInvalid;
end;
end;

function TNetSvcServer.getCurrentConnectionsCount: LongWord;
begin
Result := 0;
if not _IsOk then
Exit;
Result := FNetServer.getCurrentConnectionsCount;
end;

function TNetSvcServer.GetdisableNagle: Boolean;
begin
Result := FNetServer.disableNagle;
end;

function TNetSvcServer.getIdleConnectionsCount: LongWord;
begin
Result := 0;
if not _IsOk then
Exit;
Result := FNetServer.getIdleConnectionsCount;
end;

function TNetSvcServer.GetkeepAlive: Boolean;
begin
Result := FNetServer.keepAlive;
end;

function TNetSvcServer.GetlistenerPeriod: LongWord;
begin
Result := listenerPeriod;
end;

function TNetSvcServer.GetmaxConnections: LongWord;
begin
Result := FNetServer.maxConnections;
end;

function TNetSvcServer.GetsvcAddress: WideString;
begin
Result := FNetServer.svcAddress;
end;

function TNetSvcServer.GetsvcPort: LongWord;
begin
Result := FNetServer.svcPort;
end;

procedure TNetSvcServer.Loaded;
begin
inherited Loaded;
end;

procedure TNetSvcServer.Notification(
AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
end;

procedure TNetSvcServer.registerDBConnPooler(
const maxCount:Word;
const timeOut:Word;
const dbConnMgrCB:TObjMgrCBEvent);
begin
if not _IsOk then
Exit;
//// add by hulong.zeng 2008-05-02
if not Assigned(dbConnMgrCB) then
Exit;
////
if FSvcObjectBroker = nil then
begin
FSvcObjectBroker := TSvcObjectBroker.Create;
FNetServer.setSvcObjectBroker(FSvcObjectBroker as ISvcObjectBroker);
end;
////add by hulong.zeng 2008-05-02
FSvcObjectBroker.dbConnMgrCB := dbConnMgrCB;
////
FSvcObjectBroker.registerDBConnPooler(maxCount,timeOut);
end;

procedure TNetSvcServer.registerSvcObject(
const classGUID: WideString;
const maxCount: LongWord;
const timeOut: LongWord;
const decription: WideString;
const libFile: WideString;
const objMgrCBProc:string);
begin
if not _IsOk then
Exit;
if FSvcObjectBroker = nil then
begin
FSvcObjectBroker := TSvcObjectBroker.Create;
FNetServer.setSvcObjectBroker(FSvcObjectBroker as ISvcObjectBroker);
end;
FSvcObjectBroker.registerSvcObjPooler(classGUID, maxCount,
timeOut, decription, libFile,objMgrCBProc);
end;

procedure TNetSvcServer.releaseConnection(Index: LongWord);
begin
if not _IsOk then
Exit;
FNetServer.releaseConnection(Index);
end;

procedure TNetSvcServer.Setactive(const Value: Boolean);
begin
if not Assigned(FonRequest) then
Exit;
FNetServer.active := Value;
end;

procedure TNetSvcServer.SetbackLog(const Value: LongWord);
begin
FNetServer.backLog := Value;
end;

procedure TNetSvcServer.SetcheckPeriod(const Value: LongWord);
begin
FNetServer.checkPeriod := Value;
end;

procedure TNetSvcServer.SetconnectionPoolTimeout(const Value: LongWord);
begin
FNetServer.connectionPoolTimeout := Value;
end;

procedure TNetSvcServer.SetdisableNagle(const Value: Boolean);
begin
FNetServer.disableNagle := Value;
end;

procedure TNetSvcServer.SetkeepAlive(const Value: Boolean);
begin
FNetServer.keepAlive := Value;
end;

procedure TNetSvcServer.SetlistenerPeriod(const Value: LongWord);
begin
FNetServer.listenerPeriod := Value;
end;

procedure TNetSvcServer.SetmaxConnections(const Value: LongWord);
begin
FNetServer.maxConnections := Value;
end;

procedure TNetSvcServer.SetonNetConnect(const Value: TNetEvent);
begin
FonNetConnect := Value;
end;

procedure TNetSvcServer.SetonNetDisConnect(const Value: TNetEvent);
begin
FonNetDisConnect := Value;
end;

procedure TNetSvcServer.SetonNetException(const Value: TNetErrorEvent);
begin
FonNetException := Value;
end;

procedure TNetSvcServer.SetonNotice(const Value: TNetNotice);
begin
FonNotice := Value;
end;

procedure TNetSvcServer.SetonRequest(const Value: TNetRequest);
begin
FonRequest := Value;
end;

procedure TNetSvcServer.SetsvcAddress(const Value: WideString);
begin
FNetServer.svcAddress := Value;
end;

procedure TNetSvcServer.SetsvcPort(const Value: LongWord);
begin
FNetServer.svcPort := Value;
end;

function TNetSvcServer._IsOk: Boolean;
begin
Result := FNetServer.active;
end;

{ TNetSvcClient }
constructor TNetSvcClient.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FNetClientEvent := TNetClientEvent.Create;
FNetClient := (CreateComObject(CLASS_NetClient) as INetClient);
FNetClient.netInit;
FNetClient.setNetClientEvent(FNetClientEvent as INetClientEvent);
FNetClientEvent.SetOwner(Self);
FonNetDisConnect := nil;
FonNetConnect := nil;
FonNetException := nil;
FbeforeRequest := nil;
end;

destructor TNetSvcClient.Destroy;
begin
if FNetClient <> nil then
FNetClient := nil;
if FNetClientEvent <> nil then
FNetClientEvent := nil;
inherited Destroy;
end;

function TNetSvcClient.doRequest(const req: IRequestPacket): IResponsePacket;
begin
Result := nil;
if (req = nil) or (not FNetClient.active) then
Exit;
Result := FNetClient.doRequest(req);
end;

function TNetSvcClient.Getactive: Boolean;
begin
Result := FNetClient.active;
end;

function TNetSvcClient.GetcheckPeriod: LongWord;
begin
Result := FNetClient.checkPeriod;
end;

function TNetSvcClient.GetdisableNagle: Boolean;
begin
Result := FNetClient.disableNagle;
end;

function TNetSvcClient.GetkeepAlive: Boolean;
begin
Result := FNetClient.keepAlive;
end;

function TNetSvcClient.getNetProxy: INetProxy;
begin
Result := FNetClient.getNetProxy;
end;

function TNetSvcClient.GetsvrAddress: WideString;
begin
Result := FNetClient.svrAddress;
end;

function TNetSvcClient.GetsvrPort: LongWord;
begin
Result := FNetClient.svrPort;
end;

function TNetSvcClient.GettimeOut: LongWord;
begin
Result := FNetClient.timeOut;
end;

procedure TNetSvcClient.Loaded;
begin
inherited Loaded;
end;

procedure TNetSvcClient.Notification(
AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
end;

procedure TNetSvcClient.Setactive(const Value: Boolean);
begin
FNetClient.active := Value;
end;

procedure TNetSvcClient.SetbeforeRequest(const Value: TRequestHandler);
begin
FbeforeRequest := Value;
end;

procedure TNetSvcClient.SetcheckPeriod(const Value: LongWord);
begin
FNetClient.checkPeriod := Value;
end;

procedure TNetSvcClient.SetdisableNagle(const Value: Boolean);
begin
FNetClient.disableNagle := Value;
end;

procedure TNetSvcClient.SetkeepAlive(const Value: Boolean);
begin
FNetClient.keepAlive := Value;
end;

procedure TNetSvcClient.SetonDisConnect(const Value: TNetEvent);
begin
FonNetDisConnect := Value;
end;

procedure TNetSvcClient.SetonNetConnect(const Value: TNetEvent);
begin
FonNetConnect := Value;
end;

procedure TNetSvcClient.SetonNetException(const Value: TNetErrorEvent);
begin
FonNetException := Value;
end;

procedure TNetSvcClient.SetsvrAddress(const Value: WideString);
begin
FNetClient.svrAddress := Value;
end;

procedure TNetSvcClient.SetsvrPort(const Value: LongWord);
begin
FNetClient.svrPort := Value;
end;

procedure TNetSvcClient.SettimeOut(const Value: LongWord);
begin
FNetClient.timeOut := Value;
end;

{ TSvcProvider }
constructor TSvcProvider.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FclassGUID := '';
FdbScheme := '';
{$IFDEF WAN}
FlocalSvc := false;
{$else
}
FlocalSvc := true;
{$ENDIF}
FnetSvcClient := nil;
end;

destructor TSvcProvider.Destroy;
begin
inherited;
end;

function TSvcProvider.doRequest(
const svcMethod: WideString;
const req: IRequestPacket): IResponsePacket;
var
SaveCursor:TCursor;
begin
Result := nil;
if (trim(SvcMethod) = '') or
(req = nil) or
not hasValidSvc then
Exit;
SaveCursor := Screen.Cursor;
try
Screen.Cursor := crSQLWait;
{$IFDEF WAN}
req.addHeader('Method', trim(SvcMethod));
req.addHeader('classGUID', trim(classGUID));
req.dbScheme := trim(dbScheme);
Result := NetSvcClient.doRequest(req);
{$else
}
Result :=
getLocalSvcServer.doRequest(trim(classGUID),trim(dbScheme),trim(svcMethod), req);
{$ENDIF}
finally
Screen.Cursor := SaveCursor;
end;
end;

function TSvcProvider.hasValidSvc: Boolean;
begin
{$IFDEF WAN}
Result := (NetSvcClient <> nil) and (NetSvcClient.active);
{$else
}
Result := true;
{$ENDIF}
end;

procedure TSvcProvider.Loaded;
begin
inherited Loaded;
end;

procedure TSvcProvider.Notification(
AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
end;

{$IFNDEF WAN}
procedure TSvcProvider.registerDBConnPooler(
const maxCount:Word;
const timeOut:Word;
const dbConnMgrCB:TObjMgrCBEvent);
begin
with getLocalSvcServerdo
registerDBConnPooler(maxCount,timeOut,dbConnMgrCB);
end;

procedure TSvcProvider.registerLocalSvcObject(
const maxCount: LongWord;
const timeOut: LongWord;
const decription: WideString;
const libFile: WideString;
const objMgrCBProc:string);
begin
if (trim(classGUID) = '') then
Exit;
with getLocalSvcServerdo
registerSvcObject(classGUID, maxCount, timeOut, decription, libFile,objMgrCBProc);
end;
{$ENDIF}
{$IFDEF WAN}
procedure TSvcProvider.SetnetSvcClient(const Value: TNetSvcClient);
begin
FnetSvcClient := Value;
end;
{$ENDIF}
procedure TSvcProvider.SetclassGUID(const Value: string);
begin
FclassGUID := Value;
end;

procedure TSvcProvider.SetdbScheme(const Value: string);
begin
FdbScheme := Value;
end;

{ TLocalSvcServer }
constructor TLocalSvcServer.Create;
begin
inherited Create;
FSvcObjBroker := TSvcObjectBroker.Create;
end;

destructor TLocalSvcServer.Destroy;
begin
if FSvcObjBroker <> nil then
FSvcObjBroker := nil;
inherited;
end;

function TLocalSvcServer.doRequest(
const classGUID: WideString;
const dbScheme:string;
const svcMethod: WideString;
const req: IRequestPacket): IResponsePacket;
var
svcObj: ISvcObject;
begin
Result := nil;
svcObj := nil;
if (trim(classGUID) = '') or
(trim(svcMethod) = '') or (req = nil) then
Exit;
req.addHeader('Method', trim(svcMethod));
if trim(dbScheme)<>'' then
req.dbScheme := trim(dbScheme);
FSvcObjBroker.lockSvcObject(classGUID,svcObj);
try
if svcObj <> nil then
begin
svcObj.doInit(req);
svcObj.doRequest(req, Result);
end
else
begin
Result := NewResponsePacket;
Result.addError(99999, 'LocalObjectNotExists',
Format('local service object [%s] not exists!', [classGUID]),
'please get support from :hulong.zeng@hotmail.com');
end;
finally
if svcObj <> nil then
FSvcObjBroker.unlockSvcObject(classGUID, svcObj);
end;
end;

procedure TLocalSvcServer.registerDBConnPooler(
const maxCount:Word;
const timeOut:Word;
const dbConnMgrCB:TObjMgrCBEvent);
begin
////add by hulong.zeng 2008-05-02
if not Assigned(dbConnMgrCB) then
Exit;
FSvcObjBroker.dbConnMgrCB := dbConnMgrCB;
////
FSvcObjBroker.registerDBConnPooler(maxCount,timeOut);
end;

procedure TLocalSvcServer.registerSvcObject(
const classGUID: WideString;
const maxCount: Word;
const timeOut: Word;
const decription: WideString;
const libFile: WideString;
const objMgrCBProc:string);
begin
FSvcObjBroker.registerSvcObjPooler(classGUID, maxCount,
timeOut, decription, libFile,objMgrCBProc);
end;

{ TSvcObjectBroker }
constructor TSvcObjectBroker.Create;
begin
inherited Create;
FSvcObjPools := TList.Create;
//// add by hulong.zeng 2008-05-02
FdbConnMgrCB := nil;
////
end;

destructor TSvcObjectBroker.Destroy;
var
i:integer;
begin
for i := FSvcObjPools.Count - 1do
wnto 0do
begin
TSvcObjPool(FSvcObjPools.Items).Free;
FSvcObjPools.Items := nil;
end;
FSvcObjPools.Free;
if FDBConnPool <> nil then
FDBConnPool := nil;
inherited Destroy;
end;

function TSvcObjectBroker.indexOfSvcObject(
const classGUID: WideString): integer;
var
i:integer;
begin
Result := -1;
if trim(classGUID)='' then
Exit;
for i := 0 to FSvcObjPools.Count - 1do
if trim(TSvcObjPool(FSvcObjPools.Items).classGUID)=trim(classGUID) then
begin
Result := i;
Break;
end;
end;

procedure TSvcObjectBroker.registerDBConnPooler(
const maxCount:Word;
const timeOut:Word);
begin
//// add by hulong.zeng 2008-05-02
if not Assigned(FdbConnMgrCB) then
Exit;
////
if FDBConnPool <> nil then
Exit;
getObjPool(FDBConnPool);
if FDBConnPool <> nil then
begin
////changed by hulong.zeng 2008-05-02
//FDBConnPool.registerObjMgrCBProc(@getAdoConnMgrObjMgrCB);
FDBConnPool.registerObjMgrCBProc(@dbConnMgrCB);
////
{$IFDEF WAN}
FDBConnPool.setMaxCount(maxCount);
{$else
}
FDBConnPool.setMaxCount(1);
{$ENDIF}
FDBConnPool.setTimeOut(timeOut);
FDBConnPool.setActive(true);
end;
end;

function TSvcObjectBroker.lockSvcObject(
const classGUID: WideString;
out Value: ISvcObject): HResult;
var
idx:integer;
ASvcObjPool:TSvcObjPool;
svcObj:IDBSvcObject;
begin
idx := indexOfSvcObject(classGUID);
if idx = -1 then
begin
Result := S_FALSE;
Exit;
end
else
begin
ASvcObjPool := TSvcObjPool(FSvcObjPools.Items[idx]);
svcObj := ASvcObjPool.lockSvcObj;
if (FDBConnPool<>nil) and (FDBConnPool.getActive) and
(svcObj.getDBConnPool=nil) then
svcObj.setDBConnPool(FDBConnPool);
Value := svcObj;
Result := S_OK;
end;
end;

function TSvcObjectBroker.registerSvcObjPooler(
const classGUID: WideString;
maxCount, timeOut:Word;
const decription,libFile: WideString;
const objMgrCBProc:string): Longint;
var
ASvcObjPool:TSvcObjPool;

begin
Result := S_FALSE;
if (trim(classGUID)='') or
(maxCount=0) or (timeOut=0) then
Exit;
if not FileExists(libFile) then
Exit;
if indexOfSvcObject(classGUID) <> -1 then
Exit;
if trim(objMgrCBProc)='' then
Exit;
ASvcObjPool := TSvcObjPool.Create(libFile,objMgrCBProc);
ASvcObjPool.classGUID := trim(classGUID);
ASvcObjPool.ObjPool.setMaxCount(maxCount);
ASvcObjPool.ObjPool.setTimeOut(timeOut);
FSvcObjPools.Add(ASvcObjPool);
ASvcObjPool.ObjPool.setActive(true);
Result := S_OK;
end;

procedure TSvcObjectBroker.SetdbConnMgrCB(const Value: TObjMgrCBEvent);
begin
FdbConnMgrCB := Value;
end;

function TSvcObjectBroker.unlockSvcObject(
const classGUID: WideString;
const svcObject: ISvcObject): HResult;
var
idx:integer;
ASvcObjPool:TSvcObjPool;
begin
idx := indexOfSvcObject(classGUID);
if idx = -1 then
begin
Result := S_FALSE;
Exit;
end
else
begin
ASvcObjPool := TSvcObjPool(FSvcObjPools.Items[idx]);
ASvcObjPool.unlockSvcObj(IDBSvcObject(svcObject));
Result := S_OK;
end;
end;

initialization
finalization
{$IFNDEF WAN}
if LocalSvcServer <> nil then
FreeAndNil(LocalSvcServer);
{$ENDIF}
end.

以上代码是网络和服务对象管理For VCL 封装.
如果怀疑DCNF的网络性能,兄弟们可以参考以上
代码来直接调用DCNF的网络功能来测试

老大,下载运行问题如下
1:打开服务器,启动服务,打开客户端,点连接
2:再点"打开"按钮,可连接MSSQL2000数据库,但没有数据显示,后再点击"重加载"方显示数据
具体没看DEMO原码,为什么要这样?
谢谢....

默认第一此Open是下载数据表结构(在Internet上,
尽可能下载数据前提条件要有查询条件),呵.
重加载也就是Reload,下载完数据表结构后,如果不提供任何的查询条件参数,
那么就默认为下载全部数据.