sdwtao进来看

Question

//组织对象transactionDM
object order_update_data: Torder_update_data
  OldCreateOrder = False
  Pooled = True
  Left = 310
  Top = 341
  Height = 150
  Width = 215
  object dc_product: TDCOMConnection
    ServerGUID = '{4D79E91E-F573-46C2-A36B-269F1B378B71}'
    ServerName = 'products.pro_products'
    Left = 24
    Top = 8
  end
end//组织对象代码
unit Unit1;{$WARN SYMBOL_PLATFORM OFF}interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
  MtsRdm, Mtx, Pro_update_data_TLB, DB, MConnect;type
  Torder_update_data = class(TMtsDataModule, Iorder_update_data)
    dc_product: TDCOMConnection;
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure update_product(var datas: OleVariant); safecall;
  public
    { Public declarations }
  end;var
  order_update_data: Torder_update_data;implementation{$R *.DFM}class procedure Torder_update_data.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;procedure Torder_update_data.update_product(var datas: OleVariant);
begin
  try
    dc_product.Connected:=true;
    try
      dc_product.AppServer.set_product(datas);
      setcomplete;
    except
      setabort;
      raise;
    end;
  finally
    dc_product.Connected:=false;
  end;end;initialization
  TComponentFactory.Create(ComServer, Torder_update_data,
    Class_order_update_data, ciMultiInstance, tmBoth);
end.//产品对象transactionDM
object pro_products: Tpro_products
  OldCreateOrder = False
  OnActivate = MtsDataModuleActivate
  OnDeactivate = MtsDataModuleDeactivate
  Pooled = True
  Left = 355
  Top = 230
  Height = 239
  Width = 324
  object ADOConnection1: TADOConnection
    ConnectionString = 
      'Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Initia' +
      'l Catalog=Northwind;Data Source=WXW'
    LoginPrompt = False
    Provider = 'SQLOLEDB.1'
    Left = 40
    Top = 16
  end
  object ADODataSet1: TADODataSet
    CacheSize = 1000
    Connection = ADOConnection1
    CursorType = ctStatic
    CommandText = 'select * from products'
    Parameters = <>
    Left = 144
    Top = 16
  end
  object DataSetProvider1: TDataSetProvider
    DataSet = ADODataSet1
    OnUpdateError = DataSetProvider1UpdateError
    BeforeUpdateRecord = DataSetProvider1BeforeUpdateRecord
    Left = 248
    Top = 96
  end
  object ClientDataSet1: TClientDataSet
    Aggregates = <>
    Params = <>
    ProviderName = 'DataSetProvider1'
    Left = 144
    Top = 96
  end
end//产品对象代码
unit Unit1;{$WARN SYMBOL_PLATFORM OFF}interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
  MtsRdm, Mtx, products_TLB, Provider, DB, ADODB;type
  Tpro_products = class(TMtsDataModule, Ipro_products)
    ADOConnection1: TADOConnection;
    ADODataSet1: TADODataSet;
    DataSetProvider1: TDataSetProvider;
    ClientDataSet1: TClientDataSet;
    procedure MtsDataModuleActivate(Sender: TObject);
    procedure MtsDataModuleDeactivate(Sender: TObject);
    procedure DataSetProvider1BeforeUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
      UpdateKind: TUpdateKind; var Applied: Boolean);
    procedure DataSetProvider1UpdateError(Sender: TObject;
      DataSet: TCustomClientDataSet; E: EUpdateError;
      UpdateKind: TUpdateKind; var Response: TResolverResponse);
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure get_product_all(var datas: OleVariant); safecall;
    procedure set_product(var datas: OleVariant); safecall;
  public
    { Public declarations }
  end;var
  pro_products: Tpro_products;implementation{$R *.DFM}class procedure Tpro_products.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;//取得所有数据的接口
procedure Tpro_products.get_product_all(var datas: OleVariant);
begin
  try
    clientdataset1.close;
    clientdataset1.Open;
    datas:=clientdataset1.Data;
    setcomplete;
  except
    setabort;
    raise;
  end;
end;//更新数据的接口
procedure Tpro_products.set_product(var datas: OleVariant);
var li_errorcount:integer;
lv_ownerdatas:olevariant;
begin
  try
    as_applyupdates('datasetprovider1',datas,0,li_errorcount,lv_ownerdatas);
    setcomplete;
  except
    setabort;
    raise;
  end;
end;procedure Tpro_products.MtsDataModuleActivate(Sender: TObject);
begin
adoconnection1.Connected:=true;
end;procedure Tpro_products.MtsDataModuleDeactivate(Sender: TObject);
begin
adoconnection1.Connected:=false;
end;procedure Tpro_products.DataSetProvider1BeforeUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
  UpdateKind: TUpdateKind; var Applied: Boolean);
begin
raise exception.Create('wxwx');
end;procedure Tpro_products.DataSetProvider1UpdateError(Sender: TObject;
  DataSet: TCustomClientDataSet; E: EUpdateError; UpdateKind: TUpdateKind;
  var Response: TResolverResponse);
begin
raise exception.Create(E.Message);
end;initialization
  TComponentFactory.Create(ComServer, Tpro_products,
    Class_pro_products, ciMultiInstance, tmBoth);
end.

Answer 1

谢谢你 呵呵 还不知道兄台贵姓大号呢？？不过 我是采用的另外一种结构 我觉得这种结构徒增烦琐 唉 按照李维的书上写的做的
大体结构是这样的，我用创建了一个简单的只包含TransactionDatamodule(估计也就是MtsDatamodule)的组件，datamodule中只有 adoconnection,dataset 和一个datasetprovider
连接在一起后，写了这么些个代码，如下
procedure TmtsCustomers.adoqCustomersAfterOpen(DataSet: TDataSet);
var i:integer;
lab:WideString;
width:Longint;
align:TAlignment;
iAlign:Longint;
ty:OLEVARIANT;
getLabel:ImtsQueryDD;
ServerName:WideString;
config:IcoEnvConfig;
begin
config:=CocoEnvConfig.Create;
config.GetServerName(ServerName);
getlabel:=ComtsQueryDD.CreateRemote(ServerName);
for  i:=0  to dataset.FieldCount -1  do
begin
  with dataset.Fields[i] do
  begin
    getlabel.GetInfByName(FieldName,lab,width,ialign,ty);
    if (lab<>'') then
      DisplayLabel:=lab;
      case ialign of
        1: Alignment:=taLeftJustify;
        2: Alignment:=taCenter;
        3: Alignment:=taRightJustify;
      end;
      DisplayWidth:=width;
    end;
  end;
end;procedure TmtsCustomers.MtsDataModuleCreate(Sender: TObject);
//var config:IcoEnvConfig;
//connectstring :widestring;
begin
//Pooled:=true;
//config:=CocoEnvConfig.Create;
//config.GetConnectString(connectstring);
//adocKM.ConnectionString:=connectstring;
//adocKM.Connected:=true;
end;procedure TmtsCustomers.MtsDataModuleDestroy(Sender: TObject);
begin
adocKM.Connected:=false;
end;procedure TmtsCustomers.MtsDataModuleActivate(Sender: TObject);
var config:IcoEnvConfig;
connectstring :widestring;
begin
config:=CocoEnvConfig.Create;
config.GetConnectString(connectstring);
adocKM.ConnectionString:=connectstring;
adocKM.Connected:=true;end;procedure TmtsCustomers.MtsDataModuleDeactivate(Sender: TObject);
begin
if IsInTransaction then
SetComplete;
adocKM.Connected:=false;
end;procedure TmtsCustomers.dspCustomersUpdateError(Sender: TObject;
  DataSet: TCustomClientDataSet; E: EUpdateError; UpdateKind: TUpdateKind;
  var Response: TResolverResponse);
begin
Response:=rrAbort;
SetAbort;
end;procedure TmtsCustomers.dspCustomersAfterApplyUpdates(Sender: TObject;
  var OwnerData: OleVariant);
begin
SetComplete;
end;
虽然setcomplete的次数给我感觉似乎多了些，但是这样确实就能够正常的完成多级事务了
然后我写了一个专门管理查询的组件Transactional object
其中添了个Datamodule然后里面有dcomconnection + clientdataset
然后我就在这里添了查询的接口函数 
procedure TmtsQueryCoor.GetCustomers(UserID: Integer;
  var vDatas: OleVariant; var vAllow: Integer);
var
FSecurity:ImtsSecuriity;
ServerName:WideString;
begin
Fconfig.GetServerName(ServerName);
FSecurity:=ComtsSecuriity.CreateRemote(serverName);
FSecurity.VerifyByUserIDOp(UserID,'GetCustomers',vAllow);
if vAllow=1 then
begin
try
  try
    FDM.cdsCustomers.Active:=true;
    vDatas:=FDM.cdsCustomers.Data;
    SetComplete;
  except
    SetAbort;
  end;
finally
  FDM.cdsCustomers.Active:=false;
end;
end;
end;
又写了一个专门用于管理修改数据的Transactional object
procedure TmtsSimpleUpdateCoor.ApplyCustomersUpdateSimple(UserID: Integer;
  vDatas: OleVariant; iMaxErrCount: Integer; var iErrCount,
  vAllow: Integer; var vFailed: OleVariant);
var Security:ImtsSecuriity;
    config:IcoEnvConfig;
    ServerName:WideString;
    server:IappServer;
    ownerData:OleVariant;
begin
config:=CocoEnvConfig.Create;
config.GetServerName(Servername);
Security:=ComtsSecuriity.CreateRemote(ServerName);
Security.VerifyByUserIDOp(UserID,'ApplyCustomersUpdateSimple',vAllow);
if vAllow=1 then
begin
try
  FDM.dcomcCustomers.Connected:=true;
  //FDM.dcomcCustomers.AppServer.UpdateDatas(vDatas,iMaxErrCount,iErrCount);
  server:=FDM.dcomcCustomers.GetServer as IAppServer;
  vFailed:=server.AS_ApplyUpdates('dspCustomers',vDatas,iMaxErrCount,iErrCount,ownerData);
  SetComplete;
  FDM.dcomcCustomers.Connected:=false;
except
  SetAbort;
end;
end;
我就是采用的这种结构，但是我觉得这不太符合面向对象的思想
因为我这样得到一个客户的档案都是针对一个客户档案表的 不是针对客户对象的
每个客户档案表有一些lookup的字段，和别的表关联，而这种结构取得的只是单纯的客户表的内容，要想显示其他需要lookup的字段的lookup内容的话 好要在客户端再去查找相关的表，不太爽，将来表一改，或者其他什么结构一改的话 我就得跟着从客户端改到服务器
真不知道有什么好点的法子没有，让我的组件彻底成为一个个的对象 呵呵 不知兄台有无良策？ ：）

Answer 2

上面的代码似乎在我启用objectpooling的时候 会事务失常 具体体现在 如果我修改的一批数据中，有错有对，那么它会将对的提交了，错的回滚掉 呵呵 也是个麻烦

Answer 3

事务失常：错的回滚是数据库给你回滚的，不是COM+的事务控制的，如果要POOLING的话，就要在ACTIVE事件中将数据库连接初始化LOOKUP字段问题：这个我也在研究，基本上可以通过将LOOKUP信息保存到数据库中来实现，建立一个专门的组件来管理我觉得COM+组件不能够实现真正的面向对象思想，只能够达到封装对于继承不好实现。
最主要的是组件重用。

Answer 4

象下面这种情况
我发现通过clientdataset 和provider 传递自定义的字段好像不行吗？？我采用了两种方法：
1、在adoquery中定义一个lookup的字段，通过provider传递给clientdataset，这时呵呵我在客户组件中连provider都找不到了
2、我在客户组件中的clientdatset中定义lookup字段，然后在客户端就根本就取不到该字段的资料真是怪着呢 不过似乎也可以理解，但是我确实有这么个需求，真不知道怎么办好了

Answer 5

lookup字段如果定义在clientdataset应该是可以的不过如果建立在com+基础上的分布式客户端好象不应该保存或者说写死字段信息,而应该是动态设定，哦？
这样的话如果只是建立lookup字段好象不太可行，我打算用field的gettext事件，至于付值还是要通过第三方组件比如ip3000来实现

Answer 6

1、在adoquery中定义一个lookup的字段，通过provider传递给clientdataset，这时呵呵我在客户组件中连provider都找不到了这个问题 是我代码写的不对 呵呵 已经解决了完全的动态设定字段信息还有点麻烦，功力还没到呢，只能做到局部的

Answer 7

“如果要POOLING的话，就要在ACTIVE事件中将数据库连接初始化”
我不在OnActive和OnDeActive时间中将数据库连接初始化，也照样可以正确启动事务和实现Object Pooling啊。当然使用到的COM+组件还是释放了的。

Answer 8

如果用pooling的话那么你每次释放对象是触发的就是ondeactive事件
所以相关释放的动作旧一定要再这里处理而初始化的动作自然不用说就要在onactive中处理了主要看你永不用pooling