多用户同时访问的问题(三层c/s)：已头痛了二个月了，不胜感谢!!!
环境：
delphi2005+ClientSocket+Ado+Server
我应用demo下的用户池连接管理MIDAS\Pooler的例子
三层模式为ciInternal, tmApartment
我的源码如下
server:
--------------------------------------------
function TFun_Cms.GetLargeData(const Dbname, Cmdstr: WideString;
Rcount: Integer;const Uip: WideString): OleVariant;
var
CL:TRTLCriticalSection;
Q:Tadoquery;
CDS:Tclientdataset;
DSP:Tdatasetprovider;
begin
try
InitializeCriticalSection(CL);
EnterCriticalSection(CL);
Q:=GetNewAdoquery(Uip);
CDS:=GetNewClientdataset(Uip);
DSP:=GetNewDatasetProvider;
//
DSP.DataSet:=Q;
if Q.Active then
begin
Form1.Memo1.Lines.Add( 'TFun_Cms.exit ');
exit;
end;
CDS.SetProvider(DSP);
Q.Close;
Q.SQL.Clear;
Q.SQL.Text:=CmdStr;
Q.MaxRecords:=Rcount;
CDS.Active:=False;
CDS.FetchOnDemand:=False;
CDS.PacketRecords:=Rcount;
CDS.Active:=True;
Result:=CDs.Data;
finally
FreeExistClientDataset(CDS);
FreeExistDatasetProvider(DSP);
FreeExistAdoquery(Q);
LeaveCriticalSection(CL);
end;
end;
function GetnewCName:String;
var
AGuid:TGuid;
NewValue:String;
begin
OleCheck(CreateGuid(AGuid));
NewValue:=GuidToString(Aguid);
NewValue:=f_Replace(NewValue, '- ', '_ ');
Result:= 'C '+Copy(NewValue,2,Length(NewValue)-2);
end;
function GetNewAdoquery(kv:string):Tadoquery;
var
Q:Tadoquery;
begin
Q:=Tadoquery.Create(nil);
Q.Name:=GetnewCName;
Q.Connection:=dm.dbConn;
Q.CacheSize:=1000;
Q.CursorType:=ctStatic;
Q.LockType:=ltBatchOptimistic;
Form1.Memo1.Lines.Add( 'GetNewAdoquery '+q.name+ ', '+kv);
Result:=Q;
end;
procedure FreeExistAdoquery(Q:Tadoquery);
begin
Form1.Memo1.Lines.Add( 'FreeExistAdoquery '+q.name);
Q.Close;
Q.SQL.Clear;
Q.Free;
end;
function GetNewStoredProc:TADOStoredProc;
var
SP:TADOStoredProc;
begin
SP:=TADOStoredProc.Create(nil);
SP.Name:=GetnewCName;
SP.Connection:=dm.dbConn;
SP.CacheSize:=1000;
SP.CursorType:=ctStatic;
SP.LockType:=ltBatchOptimistic;
Result:=SP;
end;
procedure FreeExistStoredProc(SP:TADOStoredProc);
begin
if SP.Active then
SP.Close;
SP.Free;
end;
function GetNewClientDataset(kv:string):TClientDataset;
var
CDS:TClientDataset;
begin
CDS:=Tclientdataset.Create(nil);
CDS.Name:=GetnewCName;
Form1.Memo1.Lines.Add( 'GetNewClientDataset '+CDS.name+ ', '+kv);
CDS.FetchOnDemand:=False;
CDS.PacketRecords:=500;
Result:=CDS;
end;
procedure FreeExistClientDataset(CDS:TClientDataset);
begin
Form1.Memo1.Lines.Add( 'FreeExistClientDataset '+CDS.name);
if CDS.Active then
CDS.Close;
CDS.Free;
end;
function GetNewDatasetProVider:TDatasetProvider;
var
DSP:TDatasetProvider;
begin
DSP:=TdatasetProvider.Create(nil);
DSP.Name:=GetnewCName;
DSP.DataSet:=nil;
Result:=DSP;
end;
procedure FreeExistDatasetProvider(DSP:TDatasetProvider);
begin
DSP.DataSet:=nil;
DSP.Free;
end;
POOLER：（完全按MIDAS\Pooler的例子）
------------------------------------------------------
Client:(做一个for 1 to 200 访问GetLargeData)
--------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
j:integer;
begin
for j:=0 to 200 do
begin
getdxtest;
end;
end;
procedure TForm1.getdxtest;
var
i:integer;
Qy_Tmp:Tclientdataset;
Cmdstr:string;
begin
try
Qy_Tmp:=Tclientdataset.Create(nil);
CmdStr:= 'select top 12 * From EVENTLOG ORDER BY LOG_ID DESC ';
Qy_Tmp.Data:=adisp.GetLargeData( 'ggg ', Cmdstr,54,f_GetLocalIP);
with Qy_Tmp do
begin
first;
for i:=1 to RecordCount-1 do
begin
ListBox1.Items.Add(fieldbyname( 'LOG_USER ').AsString);
next;
end;
end;
finally
Qy_Tmp.Close;
Qy_Tmp.Free;
end;
end;
在二台client机上同时运行for程序,就出现
operation cannot be performed while executing asynchronously
多用户同时访问的问题(三层c/s)：已头痛了二个月了，不胜感谢!!!
[解决办法]
midas 那个 demo 很原始了, 基于 com 的防 mts对像, 实际作用不是很大, 98/99 年 mts/com+ 出现后, 实际上mts/com+ 也就是一个新的 com 宿主程序, 实现了 midas pooler 例子中的那个内容, 功能更强大, 之后就没什么人那样做了
现在都在用 com+ 了, 要求是只能是 active library(dll), new com 组件时指定成 tmBoth 线程模型, 安装时用 install com+ ，在组件服务里就可以指定对像的缓冲池
[解决办法]
Q.Connection:=dm.dbConn;
你的 Connection 也动态创建
或者直接用串
还有 server 换成single
