2,497
社区成员
发帖
与我相关
我的任务
分享〖分享〗一个基于ADO存储过程的池化处理
依据工作的需要而开发，所以这里只选择了MSSQL和Oracle两个数据库。通过相对固定的调用方式，可以很好地让同一个程序在兼容Oracle和MSSQL。
1.约定都采用过程（不是函数）
2.第一个参数为整形，用于存储过程的返回值，即MSSQL存储过程当中的return
3.存储过程都通过记录集返回结果：
Oracle演示存储过程
MSSQL演示存储过程
Oracle演示代码
MSSQL演示代码
下面是模块代码，仅供参考，如果有觉得不够完善，并且愿意完善的同仁欢迎完善，比如这里只做了存储过程，但是TADOConnPoolObject.ExecObject返回的是基类TCustomADODataSet，因此可以支持ADOQuery,ADOCommand等作为“池”元素。
PS:分数不多，发到技术区主要是为了可能的奖励^_^
1.约定都采用过程（不是函数）
2.第一个参数为整形，用于存储过程的返回值，即MSSQL存储过程当中的return
3.存储过程都通过记录集返回结果：
Oracle演示存储过程
create or replace procedure Simple_Procedure_Test
( Result out Integer,
--...--其它参数
PRetCursor out sys_refcursor
)
is
begin
open PRetCursor for select '名称' as "TestName",'值' as "TestValue" from dual; --返回一个结果集
Result := 1; --MSSQL 的return值
return;
end;MSSQL演示存储过程
create procedure Simple_Procedure_Test
As
begin
select '名称' as [TestName],'值' as [TestValue] --返回一个结果集
return 1 --MSSQL 的return值
endOracle演示代码
procedure TestOracle;
var
ADOPoolMan: TADOConnPoolMan;
ProcObj: TADOConnPoolObject;
Proc: TADOStoredProc;
begin
ADOPoolMan := TADOConnPoolMan.Create(Alias,dbUser,DbPass,DBName,true,ado_dtOracle);
try
ProcObj := ADOPoolMan.CreateSP('Simple_Procedure_Test');
if ProcObj = Nil then Exit;//错误处理
try
Proc := ProcObj.ExecObject as TADOStoredProc;
Proc.Close;
//参数填充
//...
Proc.Open;
ShowMessage('Result = ' +Proc.Parameters.ParamByName('Result'));
ShowMessage(Proc.Fields[0].FieldName + '=' + Proc.Fields[0].Value + #13#10 + Proc.Fields[1].FieldName + '=' + Proc.Fields[1].Value);
finally
ADOPoolMan.FreeObject(ProcObj);
end;
finally
ADOPoolMan.Free;
end;
end;MSSQL演示代码
procedure TestMSSQLServer;
var
ADOPoolMan: TADOConnPoolMan;
ProcObj: TADOConnPoolObject;
Proc: TADOStoredProc;
begin
ADOPoolMan := TADOConnPoolMan.Create(Alias,dbUser,DbPass,DBName,true,ado_dtMSSQL);
try
ProcObj := ADOPoolMan.CreateSP('Simple_Procedure_Test');
if ProcObj = Nil then Exit;//错误处理
try
Proc := ProcObj.ExecObject as TADOStoredProc;
Proc.Close;
//参数填充
//...
Proc.Open;
ShowMessage('Result = ' +Proc.Parameters.ParamByName('Result'));
ShowMessage(Proc.Fields[0].FieldName + '=' + Proc.Fields[0].Value + #13#10 + Proc.Fields[1].FieldName + '=' + Proc.Fields[1].Value);
finally
ADOPoolMan.FreeObject(ProcObj);
end;
finally
ADOPoolMan.Free;
end;
end;下面是模块代码，仅供参考，如果有觉得不够完善，并且愿意完善的同仁欢迎完善，比如这里只做了存储过程，但是TADOConnPoolObject.ExecObject返回的是基类TCustomADODataSet，因此可以支持ADOQuery,ADOCommand等作为“池”元素。
PS:分数不多，发到技术区主要是为了可能的奖励^_^
...全文
请发表友善的回复…
发表回复
MICTAN 2009-07-06
- 打赏
- 举报
mark一下。
cmdream 2009-06-25
- 打赏
- 举报
UP
likeyrain 2009-06-04
- 打赏
- 举报
不知道有没有BCB版的？
僵哥 2009-05-05
- 打赏
- 举报
...
class procedure TExecuteObjectManager.CreateDB2Parameter( Parameters: TParameters
; AFieldName
, AFieldType: AnsiString
; AFieldLength: Integer
; AFieldDirection: AnsiString
);
var
Direction: TParameterDirection;
DataType: TFieldType;
DataSize: Integer;
DataDefault: Variant;
pdIn_Pos, pdOut_Pos: Integer;
param: TParameter;
begin
pdIn_Pos := Pos('IN',AFieldDirection);
pdOut_Pos := Pos('OUT',AFieldDirection);
if (pdIn_Pos > 0) and (pdOut_Pos > 0) then Direction := pdInputOutput
else if pdIn_Pos > 0 then Direction := pdInput
else if pdOut_Pos > 0 then Direction := pdOutput
else Direction := pdUnknown;
IF AFieldType = 'INTEGER' then begin
DataType := ftInteger;
DataDefault := 0;
end else IF AFieldType = 'SMALLINT' then begin
DataType := ftSmallint;
DataDefault := 0;
end else IF AFieldType = 'BIGINT' then begin
DataType := ftBCD;
DataDefault := 0;
end else if AFieldType = 'REAL' then begin
DataType := ftFloat;
DataDefault := 0.0;
end else if AFieldType = 'DOUBLE' then begin
DataType := ftFloat;
DataDefault := 0.0;
end else if AFieldType = 'CHAR' then begin
DataType := ftFixedChar;
DataDefault := #0;
end else if AFieldType = 'VARCHAR' then begin
DataType := ftString;
DataDefault := '';
end else if AFieldType = 'DECIMAL' then begin
DataType := ftBCD;
DataDefault := 0;
end else if AFieldType = 'DATE' then begin
DataType := ftDate;
DataDefault := 0;
end else if AFieldType = 'TIME' then begin
DataType := ftTime;
DataDefault := 0;
end else if AFieldType = 'TIMESTAMP' then begin
DataType := ftTimeStamp;
DataDefault := 0;
end else Exit;
Parameters.CreateParameter(AFieldName, DataType, Direction, AFieldLength, DataDefault);
end;
...
class function TExecuteObjectManager.RefreshParam( ExecuteObject: TCustomADODataSet
; AADODBType: TADODatabaseType
; const ADBUser: AnsiString
): Boolean;
var
Qry: TADOQuery;
Proc: TADOStoredProc;
iPos: Integer;
sParamName
, sProcOwner : AnsiString;
begin
Result := False;
try
if Not Assigned(ExecuteObject) then Exit;
if Not (ExecuteObject is TADOStoredProc) then Exit;
case AADODBType of
ado_dtMSSQL: begin
Result := TADOStoredProc(ExecuteObject).Parameters.Refresh;
if Result then TADOStoredProc(ExecuteObject).Parameters.ParamByName('@RETURN_VALUE').Name:='Result';
end;
ado_dtOracle: begin
Result := true;
if ExecuteObject is TADOStoredProc then begin
Proc := ExecuteObject as TADOStoredProc;
Qry := TADOQuery.Create(Nil);
try
Qry.Connection := ExecuteObject.Connection;
Qry.SQL.Text := 'SELECT OBJECT_NAME,PACKAGE_NAME,ARGUMENT_NAME,DATA_TYPE,IN_OUT '+
'from user_arguments '+
'where OBJECT_NAME = ''' + UpperCase(Proc.ProcedureName) + ''' '+
'order by position';
try
Qry.Open;
Proc.Parameters.Clear;
while Not Qry.eof do begin
CreateOracleParameter( Proc.Parameters
, Qry.FieldByName('ARGUMENT_NAME').AsString
, Qry.FieldByName('DATA_TYPE').AsString
, Qry.FieldByName('IN_OUT').AsString
);
Qry.Next;
end;
except
Result := false;
end;
finally
Qry.Free;
end;
end;
end;
ado_dtDB2: begin
Result := true;
if ExecuteObject is TADOStoredProc then begin
Proc := ExecuteObject as TADOStoredProc;
Proc.LockType := ltUnspecified;
sParamName := Proc.ProcedureName;
iPos := Pos('.',sParamName);
if iPos > 0 then begin
sProcOwner := Copy(sParamName, 1, iPos - 1);
sParamName := Copy(sParamName, iPos + 1, Length(sParamName) - iPos);
end else begin
sProcOwner := ADBUser;
end;
Qry := TADOQuery.Create(Nil);
try
Qry.Connection := ExecuteObject.Connection;
Qry.SQL.Text := 'SELECT PARMNAME,TYPENAME,LENGTH,PARM_MODE '+
'FROM SYSIBM.SYSPROCPARMS '+
'WHERE PROCNAME='''+UpperCase(sParamName)+''' '+
'AND PROCSCHEMA = '''+UpperCase(sProcOwner)+''' '+
' order by ordinal';
try
Qry.Open;
Proc.Parameters.Clear;
while Not Qry.eof do begin
CreateDB2Parameter( Proc.Parameters
, Qry.FieldByName('PARMNAME').AsString
, Qry.FieldByName('TYPENAME').AsString
, Qry.FieldByName('LENGTH').AsInteger
, Qry.FieldByName('PARM_MODE').AsString
);
Qry.Next;
end;
except
Result := false;
end;
finally
Qry.Free;
end;
end;
end;
end;
except
On E:Exception do
begin
Result := false;
WriteLog(' 连接串:['+ExecuteObject.Connection.ConnectionString+']'+' Exception: TExecuteObjectManager.RefreshParam with Error:'+E.Message);
end;
end;
end;
僵哥 2009-05-05
- 打赏
- 举报
增加对DB2的支持
...
type
TADODatabaseType = (ado_dtMSSQL, ado_dtOracle, ado_dtDB2);
...
TExecuteObjectManager = class(TManagedObject)
...
public
...
class procedure CreateDB2Parameter( Parameters: TParameters
; AFieldName
, AFieldType: AnsiString
; AFieldLength: Integer
; AFieldDirection: AnsiString
);
...
end;
...
function TADOConnPoolObject.TestConnection: Boolean;
begin
Result := true;
try
case FOwner.ADODBType of
ado_dtMSSQL: FConn.Execute('select ''Test Connect...'' [NoName]');
ado_dtOracle: FConn.Execute('select ''Test Connect...'' "NoName" from dual');
ado_dtDB2: FConn.Execute('select ''Test Connect...'' "NoName" from sysibm.dual');
end;
except
On E:Exception do begin
if Reconnect then Exit;
Result := false;
WriteLog(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz ',Now) + ' 连接串:['+FConn.ConnectionString+']'+' Exception: TADOConnPoolObject.TestConnection with Error:'+E.Message);
end;
end;
end;
...
function TADOConnPoolMan.Reconnect(AConnection: TADOConnection): Boolean;
begin
Result := True;
try
If AConnection.Connected Then begin
AConnection.Close;
Sleep(15);
end;
AConnection.CommandTimeout := 15;
AConnection.ConnectionTimeout := 15;
AConnection.KeepConnection := FKeepConnection;
AConnection.LoginPrompt := false;
case FADODBType of
ado_dtMSSQL: begin
AConnection.ConnectionString := 'DistribTX=0;Provider=SQLOLEDB.1;'
+ 'Persist Security Info=True;'
+ 'User ID=' + FDBUser + ';'
+ 'Initial Catalog=' + FDbName + ';'
+ 'Data Source=' + FDBServer + ';';
end;
ado_dtOracle: begin
AConnection.ConnectionString := 'PLSQLRSet=1;DistribTX=0;Provider=OraOLEDB.Oracle.1;'
+ 'Persist Security Info = True;'
+ 'Data Source=' + FDBServer + ';'
+ 'User ID=' + FDBUser + ';'
+ 'Password =''' + Trim(FDBPass) + '''';
end;
ado_dtDB2: begin
AConnection.ConnectionString := 'Provider=IBMDADB2;'
+ 'Persist Security Info=True;'
+ 'Location=' + FDBServer + ';'
+ 'User ID=' + FDBUser + ';'
+ 'Data Source=' + FDBName + ';'
+ 'Password=' +FDBPass
;
end
else
Exit;
end;
AConnection.Open(FDBUser, FDBPass);
except
Result := False;
end;
end;
class Function TADOConnPoolMan.ConnectADO( const sServerip
, sUser
, sPass
, sDbName : AnsiString
; bKeep : Boolean
; Var ADOConn : TADOConnection
; ADODBType: TADODatabaseType = ado_dtMSSQL
): Boolean;
Begin
Result := False;
Try
Try
If ADOConn = Nil Then ADOConn := TADOConnection.Create(Nil)
Else ADOConn.Close;
ADOConn.CommandTimeout := 3;
ADOConn.ConnectionTimeout := 3;
ADOConn.KeepConnection := bKeep;
ADOConn.LoginPrompt := false;
case ADODBType of
ado_dtMSSQL: begin
ADOConn.ConnectionString := 'DistribTX=0;Provider=SQLOLEDB.1;'
+ 'Persist Security Info=True;'
+ 'User ID=' + sUser + ';'
+ 'Initial Catalog=' + sDbName + ';'
+ 'Data Source=' + sServerip + ';';
end;
ado_dtOracle: begin
ADOConn.ConnectionString := 'PLSQLRSet=1;DistribTX=0;Provider=OraOLEDB.Oracle.1;'
+ 'Persist Security Info = True;'
+ 'Data Source=' + sServerip + ';'
+ 'User ID=' + sUser + ';'
+ 'Password =''' + Trim(sPass) + '''';
end;
ado_dtDB2: begin
ADOConn.ConnectionString := 'Provider=IBMDADB2;'
+ 'Persist Security Info=True;'
+ 'Location=' + sServerip + ';'
+ 'User ID=' + sUser + ';'
+ 'Data Source=' + sDbName + ';'
+ 'Password=' +sPass
;
end
else
Exit;
end;
ADOConn.Open(sUser, sPass);
result := True;
Except
Result := False;
End;
Finally
End;
End;
shuihan20e 2009-05-04
- 打赏
- 举报
thx
僵哥 2009-05-04
- 打赏
- 举报
更正一下，查询oracle存储过程参数的时候须加上"Order By Position"，否则在Oracle 10当中可能不会保证顺序。
Qry.SQL.Text := 'SELECT OBJECT_NAME,PACKAGE_NAME,ARGUMENT_NAME,DATA_TYPE,IN_OUT from user_arguments where OBJECT_NAME = '''+UpperCase(Proc.ProcedureName)+''' order by position';
Qry.SQL.Text := 'SELECT OBJECT_NAME,PACKAGE_NAME,ARGUMENT_NAME,DATA_TYPE,IN_OUT from user_arguments where OBJECT_NAME = '''+UpperCase(Proc.ProcedureName)+''' order by position';
Bear_hx 2009-04-27
- 打赏
- 举报
僵哥，你太牛了。。。
wsq279024988 2009-04-27
- 打赏
- 举报
支持一下啊
ESvvv 2009-04-27
- 打赏
- 举报
学习学习
zhuchengchuan 2009-04-27
- 打赏
- 举报
学习
fescort 2009-04-27
- 打赏
- 举报
学习
pilicat 2009-04-26
- 打赏
- 举报
嗯，学习，受教了。
rejoice818 2009-04-26
- 打赏
- 举报
MARK!!在MARK
mclovein 2009-04-26
- 打赏
- 举报
v看的我晕晕的~继续看完他。。。。。。。。。厉害~
supboy 2009-04-26
- 打赏
- 举报
看的我晕晕的~继续看完他。。。。。。。。。厉害~
半生浮云 2009-04-25
- 打赏
- 举报
关注中
qq8352280 2009-04-25
- 打赏
- 举报
学习····
zzh570060189 2009-04-25
- 打赏
- 举报
顶！！！看不懂
zzh570060189 2009-04-25
- 打赏
- 举报
顶！！！太牛了
加载更多回复（32）
