Devart Forums

Code: Select all

SET SQL DIALECT 3;

SET NAMES WIN1250;

SET CLIENTLIB 'C:\Program Files\Firebird\Firebird_2_0\bin\fbclient.dll';

CREATE DATABASE 'E:\FBData\TIBCError.fdb'
USER 'STUDENT'
PAGE_SIZE 16384
DEFAULT CHARACTER SET WIN1250;

CREATE EXCEPTION EX_NAMENOTFOUND 'The supplied name was not found.';

SET TERM ^ ; 

CREATE PROCEDURE SP_NAME2ID (
    CNAME VARCHAR(4))
RETURNS (
    NID INTEGER)
AS
BEGIN
  SUSPEND;
END^


CREATE PROCEDURE SP_RAISEEXCEPT (
    CTRYNAME VARCHAR(4))
AS
BEGIN
  EXIT;
END^

SET TERM ; ^

CREATE TABLE TABLE1 (
    ID    INTEGER,
    NAME  VARCHAR(4)
);

SET TERM ^ ;

ALTER PROCEDURE SP_NAME2ID (
    CNAME VARCHAR(4))
RETURNS (
    NID INTEGER)
AS
begin
  SELECT FIRST 1 Table1.ID From Table1
  WHERE Table1.name = :cName
  INTO :nID;

  exit;
end
^

ALTER PROCEDURE SP_RAISEEXCEPT (
    CTRYNAME VARCHAR(4))
AS
declare variable nfoundid integer = null;
begin
  EXECUTE PROCEDURE sp_name2id (:cTryName)
    RETURNING_VALUES :nFoundID;
  if (nFoundID IS NULL) then
    EXCEPTION ex_namenotfound 'Name ' || cTryName || ' not exist.';

  exit;
end
^

SET TERM ; ^

Code: Select all

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DBAccess, IbDacVcl, DB, IBC, MemDS;

type
  TForm1 = class(TForm)
    btnConnect: TButton;
    IBCConnection1: TIBCConnection;
    IBCConnectDialog1: TIBCConnectDialog;
    IBCTransaction1: TIBCTransaction;
    Edit1: TEdit;
    Label1: TLabel;
    btnFindID: TButton;
    IBCStoredProc1: TIBCStoredProc;
    procedure btnConnectClick(Sender: TObject);
    procedure btnFindIDClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  MyConnectForm, IBCError;

{$R *.dfm}

procedure TForm1.btnConnectClick(Sender: TObject);
begin
  if IBCConnection1.Connected then
  begin
    IBCConnection1.Disconnect;
    btnConnect.Caption := 'Connect';
  end
  else
  begin
    try
      IBCConnectDialog1.DialogClass := 'TfmMyConnect';
      IBCConnection1.Connect;
      if IBCConnection1.Connected then
        btnConnect.Caption := 'Disconnect';
    except
      ShowMessage('Connection failed');
    end;
  end;
end;

procedure TForm1.btnFindIDClick(Sender: TObject);
begin
  //
  try
    IBCTransaction1.StartTransaction;
    IBCStoredProc1.UnPrepare;
    IBCStoredProc1.StoredProcName := 'SP_RAISEEXCEPT';
    IBCStoredProc1.Prepare;
    IBCStoredProc1.ParamByName('CTRYNAME').AsString :=
       Edit1.Text;
    IBCStoredProc1.Execute;
    IBCTransaction1.Commit;
  except
    on E:EIBCError do
    begin
      ShowMessage(E.SQLErrorMsg);
      ShowMessage(IntToStr(E.Errorcode));
      ShowMessage(E.Message);
      IBCTransaction1.Rollback;
    end;
    else
      IBCTransaction1.Rollback;
  end;
end;

end.

Code: Select all

var
  List: TStringList;
begin
  try
    IBCStoredProc.Execute;
  except
    on E: EIBCError do begin
      if E.ErrorNumber = 335544517 then begin
        List := TStringList.Create;
        try
          List.Text := E.Message;
          E.Message := List[3];
        finally
          List.Free;
        end;
      end;
      raise;
    end;
  end;
end;