SQL存储过程内部RaisError客户端抓不住弹不出错误的解决

我们有个海宏商业erp3，库存部分是用存储过程写的，减库存时会先检查负库存，比如还有5个你想出库6个，存储过程就raisError('库存不足',16,1)。

最近这一个版本发布后，有客户反映有时候会出负库存。

再一个，我们软件特殊情况下会同时操作本地和远程两个数据库、开两个sql事务，容易产生莫名其妙的错误。

倒腾了一阵，结果汇总在这里，百度上搜不到答案，希望以后有人遇到能管用。

{*****************************************测试目的******************************
sql存储过程中会先检查库存数量，如果库存是负数就raisError('库存不足',16,1)，
这时候发现客户端会截获不住这个错误。
经过测试发现：
  1：用AdoQuery.Open比较保险。能抓做存储过程内部raisEror的错误，直接就报错了。
     用用AdoQuery.ExecSql、AdoStoredProc.ExecProc、Connection.Execute都抓不住错误，
  2：这些方式都能取到存储过程的return值，那么写存储过程时，得在raiseError之后，
     马上return一个错误代码，原则上return 0表示没错误，其他非零值都是错误代码.
     这样程序可以取到这个值，判断这个值是否=0，非0就是有错误

        3：insert into employee后，种子键nID就被sql记住了，即使你事务撤销了。
下次insert 成功了他也不在出现了，比如：nID现在是5，insert后出错、回滚了事务。
下次再insert成功后，nID会是7而不是6
        4：同时开启两个事务访问两个数据库，其中事务A成功了，事务B会有时候失败有时候成功，
可以用connection.execute能解决

}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DB, ADODB, Grids, DBGrids;

type
  TForm1 = class(TForm)
    btn_ByQuery: TBitBtn;
    btn_ByProc: TBitBtn;
    btn_ByConn: TBitBtn;
    conn_main: TADOConnection;
    qry_main: TADOQuery;
    asp_R: TADOStoredProc;
    Label1: TLabel;
    txt_SQL: TMemo;
    qry_R: TADOQuery;
    Label2: TLabel;
    lbl_Total: TLabel;
    Label3: TLabel;
    ds_main: TDataSource;
    grd_main: TDBGrid;
    Label4: TLabel;
    txt_info: TMemo;
    cbx_execSQL: TComboBox;
    procedure btn_ByQueryClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn_ByProcClick(Sender: TObject);
    procedure btn_ByConnClick(Sender: TObject);
  private
    { Private declarations }
  public
    //读取结果
    function showResult:integer;
    //
    procedure showInfo(sInfo:string=''; lTime:boolean=true);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.btn_ByProcClick(Sender: TObject);
var asp:TAdoStoredProc;               n:integer;
    s:String;
begin
    asp:=asp_R;                     
    with asp do
    try
        close;
        connection.beginTrans;
        //执行
        asp.ProcedureName:='testError';
        asp.Parameters.Clear;
        asp.Parameters.CreateParameter('@RETURN_VALUE', ftInteger, pdReturnValue, 10, fgUnAssigned);
        asp.parameters.CreateParameter('@sComment', ftString, pdInput, 254, 'AdoStoredProc');
        asp.ExecProc;
        n:=round( asp.Parameters.ParamValues['@RETURN_VALUE'] );
        //***************************AdoStoredProc测试结果********************//
        //经过分析发现，在存储过程中raiseError用AdoStoredProc抓不住，只能用return 0的返回值做判断
        If n=0 then showInfo('AdoStoredProc执行成功')
          else begin
            if connection.errors.count>0 then s:=#13+connection.Errors[0].Description else s:='';
            Raise Exception.Create('AdoStoredProc出错！错误代码：'+Inttostr(n)+s);
          end;
        //提交事务
        connection.CommitTrans;
    except
        on x:exception do begin
            if connection.InTransaction then connection.RollbackTrans;
            showInfo(x.message);
        end;
    end;
    showResult;
end;

procedure TForm1.btn_ByQueryClick(Sender: TObject);
var qry:TAdoQuery;                  l,lExec,lOpen:boolean;
begin
    qry:=qry_R;                     lExec:=cbx_execSql.itemIndex=0;
    lOpen:=not lExec;
    with qry do
    try
        close;
        connection.beginTrans;
        //执行
        sql.text:='declare @n int, @n2 int ';
        sql.add('  exec @n=testError '+quotedStr('AdoQuery-'+cbx_execSQl.text)+' ');
        if lOpen then sql.add('  select @n as vResult '); //打开
        //*************关键点：execSQL不会导致报错，而open会导致报错**********//
        if lExec then
            execSQL                 //抓不住存储过程中raiseError
        else
            open;                   //打开能抓住raisError
        if not isEmpty then showInfo('AdoQuery执行成功，返回值：'+fields[0].asString) else showInfo('执行完毕，无返回值');
        //提交事务
        connection.CommitTrans;
    except
        on x:exception do begin
            if connection.InTransaction then connection.RollbackTrans;
            showInfo(x.message);
        end;
    end;
    showResult;
end;
//用connection执行
procedure TForm1.btn_ByConnClick(Sender: TObject);
var rec:_Recordset;                       conn:TAdoConnection;
    s:String;                             n, n2, nR:integer;
begin
    conn:=conn_main;                      nR:=-1;
    rec:=nil;
    with conn do 
    try
        if not conn.Connected then conn.Open;
        conn.BeginTrans;
        //
        with qry_R do begin
            sql.text:='declare @n int, @n2 int ';
            sql.add('  exec @n=testError ''Connection'' ');
            sql.add('  select @n as vResult ');
            s:=sql.text;
        end;

        //*****************用最底层的连接执行兼容sql2000、2008****************//
        //测试发现：存储过程raisError时connection是抓不住的，只能用return值判断
        //用rec.fields[0].value取返回值容易出莫名其妙的错误，还需要继续找可靠的办法
        //另外，同时开启两个事务访问两个数据库，其中事务A成功了，事务B会有时候失败有时候成功，可以用connection.execute能解决
        //nR:=connection.Execute(s)(0);
        //rec:=conn.Execute(s, n2, eoAsyncFetch);
        rec:=conn.Execute(s);                 //, cmdText, [eoAsyncFetch]
        //if (assigned(rec)) and (not rec.EOF) then nR:=rec.Fields[0].Value;
        if nR<>0 then showInfo('  Connection出错，结果返回值：'+intToStr(nR))
          else showInfo('Connection执行成功！');

        //提交
        conn.CommitTrans;
    except
        on x:exception do begin
            if conn.InTransaction then conn.RollbackTrans;
            showInfo(x.message);
        end;
    end;
    showResult;
end;

//读取结果
function TForm1.showResult:integer;
var qry:TAdoQuery;                          i:integer;
begin
    result:=-1;
    qry:=TAdoQuery.create(self);
    qry.connection:=qry_main.connection;
    with qry do
    try
        qry_main.disableControls;
        //
        close;
        sql.text:='select count(1) from employee ';
        open;
        if not isEmpty then lbl_total.caption:=intToStr(fields[0].value);
        //表格
        with qry_main do begin
            close;
            sql.text:='select top 10 * from employee order by nID desc ';
            open;
            for i:=0 to fieldCount-1 do fields[i].DisplayWidth:=14;
        end;
    except
        on x:exception do showMessage(x.message);
    end;
    qry_main.enableControls;
    if assigned(qry) then freeAndNil(qry);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    try
        lbl_total.caption:='';
        //
        conn_main.open;
        showResult;
    except
        on x:exception do showMessage(x.message);
    end;
end;

procedure TForm1.showInfo(sInfo:string=''; lTime:boolean=true);
begin
    txt_info.Lines.Add(formatDateTime('yyyy-MM-dd HH:mm:ss',now)+' '+sInfo);
end;




end.

　　

用到的sql测试表需要的脚本：

--创建库
if not exists(select * from master..sysdatabases where name='test') begin
	create database test
end
go

--创建表
use test
go
--	drop table employee
if not exists(select * from sysObjects where name='employee') begin
	create table employee 
	(
		[nID] [int] IDENTITY (1, 1) NOT NULL ,
		[sID] [varchar] (50) NULL default('') ,
		[sName] [varchar] (254) NULL default('') ,
		[sComment] varChar(254) null default(''),
		[nOK] [int] NULL  default(0),
		[dCreate] [datetime] NULL default(getdate()) 
	) 
end
GO



--创建存储过程
if exists(select * from sysObjects where name='testError') drop procedure testError
go

--测试
create procedure testError(@sComment varChar(254))
as
begin
	declare @n int
	select @n=count(1) from employee
	--前置错误
	-- raisError('testError内部触发raisError错误(前置)', 16, 1)
	
	--写入
	insert into employee(sID, sName, sComment, nOK, dCreate) values(newid(), convert(varChar(50),@n), @sComment, 0, getdate())
	
	--后置错误
	raisError('testError内部触发raisError错误(后置)', 16, 1)
	
	--完成
	return 2
end
go

--	exec testError
go


select count(1) from employee

select top 10 * from employee order by nID desc
go