有DNA经验者请进(高分）(200分)

有时，调用COM+组件时可能出现“分布式事务已完成，请将此会话登记到新事物
或NULL事物中”错误。
请问，这一般是什么时候发生？怎样解决？什么是NULL事务？

這是什麼DNA問題，我還以為你的DNA真的有問題呢？

不知你用什么来现实M$的DNA？VC还是Delphi?
我学三层也不是一两天了。这条错误没见过。
不过我猜想你用的是VC之类，在Delphi中这条错误消息应该是
“根事务要提交，但事务已终止。”
VC我不懂。所以没有办法帮你了。

如果你的COM+对象用了Object Pooling而且在Deactive时没有
释放数据库连接(Connection)对象时可能会出现这个错误。
这种情况下你需要手工将你的Connection对象Enlist到事物中去。
因为同一个COM+ Object的事务Context是不一定一样的。

to Hongjiang:
我哪个模块没有用Object Pooling，不过，如果把事务时间设置长一些，则在事务时间内不会出现上述问题

gz

如果可以的话，可不可以把相关代码贴出来看看？

服务器代码：（作用：返回并更新最大的单号）
unit _CMUpdate_;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
MtsRdm, Mtx, CMCommenPrj_TLB, DB, ADODB, _GLAppCommon_, Provider;
type
TCMUpdate = class(TMtsDataModule, ICMUpdate)
ADOConnection1: TADOConnection;
Query: TADOQuery;
procedure MtsDataModuleCreate(Sender: TObject);
private
{ Private declarations }

protected
class procedure UpdateRegistry(Register: Boolean;
const ClassID, ProgID: string);
override;
procedure GetNewVoucherNo(Type_: OleVariant;
out No_: OleVariant);
safecall;

public
{ Public declarations }
end;

var
CMUpdate: TCMUpdate;
implementation
{$R *.DFM}
class procedure TCMUpdate.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 TCMUpdate.GetNewVoucherNo(Type_: OleVariant;
out No_: OleVariant);
var
S_Type: string;
begin
Query.SQL.Text := 'select S_Type, S_Last_No from Last_No where S_Type = ''' + string(Type_) +
''' ';
Query.Open;
S_Type := Query.FieldByName('S_Type').AsString;
No_ := Query.FieldByName('S_Last_No').AsInteger;
No_ := No_ + 1;
Query.Close;
if S_Type = '' then
begin
No_ := 1;
Query.SQL.Text :=
' insert into Last_No ' +
' ( S_Type, S_Last_No ) ' +
' values ( ''' + string(Type_) + ''' , 1 ) ';
Query.ExecSQL;
end
else
begin
Query.SQL.Text :=
' update Last_No ' +
' set S_Last_No = S_Last_No + 1 ' +
' where S_Type = ''' + string(Type_) + '''';
Query.ExecSQL;
end;
SetComplete;
end;

procedure TCMUpdate.MtsDataModuleCreate(Sender: TObject);
begin
Set_ADOConnection(ADOConnection1);
//这行只是设置数据库
end;

initialization
TComponentFactory.Create(ComServer, TCMUpdate,
Class_CMUpdate, ciMultiInstance, tmApartment);
end.


------------------------
客户端代码：（UpdateSocket指向上一组件）
function TdmCommon.GetNewVoucherNo(Type_: string): Integer;
var
No_: OleVariant;
begin
UpdateSocket.AppServer.GetNewVoucherNo(OleVariant(Type_), No_);
//当过了COM+设定的事务处理时间时出错
Result := Integer(No_);
end;

>>

会不会是配置上的问题或是你在Set_ADOConnection()里有什么特殊动作？
我根据你的代码写了一个，在我的Win2000Pro上没有问题。
//Server
unit _CMUpdate_;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
MtsRdm, Mtx, CMUSvr_TLB, DB, ADODB;
type
TCMUpdate = class(TMtsDataModule, ICMUpdate)
ADOConnection1: TADOConnection;
Query: TADOQuery;
procedure MtsDataModuleCreate(Sender: TObject);
procedure MtsDataModuleDestroy(Sender: TObject);
private
{ Private 宣言 }
protected
class procedure UpdateRegistry(Register: Boolean;
const ClassID, ProgID: string);
override;
procedure GetNewVoucherNo(Type_: OleVariant;
out No_: OleVariant);
safecall;
public
{ Public 宣言 }
end;

var
CMUpdate: TCMUpdate;
implementation
{$R *.DFM}
class procedure TCMUpdate.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 TCMUpdate.GetNewVoucherNo(Type_: OleVariant;
out No_: OleVariant);
var
Exists: Boolean;
begin
try
Query.SQL.Text := 'SELECT S_Type, S_Last_No FROM Last_No WHERE S_Type ='''+Type_+'''';
Query.Open;
Exists:=(Query.RecordCount > 0);
if Exists then
begin
No_ := Query.FieldByName('S_Last_No').AsInteger;
No_:=No_+1;
end;
Query.Close;
if not Exists then
begin
No_ := 1;
Query.SQL.Text := 'INSERT INTO Last_No (S_Type,S_Last_No) VALUES ('''+Type_+''',1)';
Query.ExecSQL;
end
else
begin
Query.SQL.Text := 'UPDATE Last_No SET S_Last_No=S_Last_No+1 WHERE S_Type ='''+Type_+'''';
Query.ExecSQL;
end;
SetComplete;
except
SetAbort;
end;
end;

procedure TCMUpdate.MtsDataModuleCreate(Sender: TObject);
begin
ADOConnection1.Connected:=True;
end;

procedure TCMUpdate.MtsDataModuleDestroy(Sender: TObject);
begin
ADOConnection1.Connected:=False;
end;

initialization
TComponentFactory.Create(ComServer, TCMUpdate,
Class_CMUpdate, ciMultiInstance, tmApartment);
end.

//Client，用的是DCOM连接
procedure TForm1.Button1Click(Sender: TObject);
var
No_: OleVariant;
Type_: String;
begin
Type_:=Trim(Edit1.Text);
DCOMConn.AppServer.GetNewVoucherNo(OleVariant(Type_), No_);
Edit2.Text:=VarToStr(No_);
end;

to Hongjiang:
我用DCOM连接，还是一样，会是Win2000版本不同吗？我用的是Advance Server.
我的情况是：
（1）
procedure TForm1.FormCreate(Sender: TObject);
begin
DCOMConnection1.Connected := True;
end;

（2）
等待60秒
（3）
procedure TForm1.Button1Click(Sender: TObject);
var
No_: OleVariant;
Type_: String;
begin
DCOMConnection1.AppServer.GetNewVoucherNo(OleVariant('JH'), No_);
end;

（4）
出错

但是，如果：
（1）
procedure TForm1.FormCreate(Sender: TObject);
begin
DCOMConnection1.Connected := True;
end;

（2）
等待59秒 ********************Com+构件默认事务处理时间为60秒
（3）
procedure TForm1.Button1Click(Sender: TObject);
var
No_: OleVariant;
Type_: String;
begin
DCOMConnection1.AppServer.GetNewVoucherNo(OleVariant('JH'), No_);
end;

（4）
不会出错

另外，
procedure Set_ADOConnection(ADOConnection: TADOConnection);
begin
if ADOConnection.Connected = True then
begin
Application.MessageBox('ADO open!', '', MB_OK);
ADOConnection.Connected := False;
end;
ADOConnection.ConnectionString :=
ReadStrFromFile(ExtractFileDir(Application.ExeName) + '/DBSetting.txt');
ADOConnection.Connected := True;
end;
这只是设置ConnectionString，应该不会有问题。

哦，我终于明白你说的是什么问题了。好吧，根据你上面的代码，问题
出在不能在MtsDataModuleCreate里设定ADOConnection.Connected:= True
应该在MtsDataModuleActivate里设定。

谢谢！