Devart Forums

Code: Select all

PARAMETER                                                        VALUE                                                        CON_ID
---------------------------------------------------------------- ---------------------------------------------------------------- ----------
NLS_LANGUAGE                                                     FRENCH                                                            0
NLS_TERRITORY                                                    FRANCE                                                            0
NLS_CURRENCY                                                     €                                                                 0
NLS_ISO_CURRENCY                                                 FRANCE                                                            0
NLS_NUMERIC_CHARACTERS                                           ,                                                                 0
NLS_CALENDAR                                                     GREGORIAN                                                         0
NLS_DATE_FORMAT                                                  DD/MM/RR                                                          0
NLS_DATE_LANGUAGE                                                FRENCH                                                            0
NLS_CHARACTERSET                                                 WE8ISO8859P15                                                     0
NLS_SORT                                                         FRENCH                                                            0
NLS_TIME_FORMAT                                                  HH24:MI:SSXFF                                                     0
NLS_TIMESTAMP_FORMAT                                             DD/MM/RR HH24:MI:SSXFF                                            0
NLS_TIME_TZ_FORMAT                                               HH24:MI:SSXFF TZR                                                 0
NLS_TIMESTAMP_TZ_FORMAT                                          DD/MM/RR HH24:MI:SSXFF TZR                                        0
NLS_DUAL_CURRENCY                                                €                                                                 0
NLS_NCHAR_CHARACTERSET                                           AL16UTF16                                                         0
NLS_COMP                                                         BINARY                                                            0
NLS_LENGTH_SEMANTICS                                             BYTE                                                              0
NLS_NCHAR_CONV_EXCP                                              FALSE                                                             0

19 lignes sélectionnées.

Code: Select all

CREATE OR REPLACE PROCEDURE test_journalhisto(
    jcx_no IN OUT varchar2,
    jcx_poste IN varchar2,
    jcx_utilos IN varchar2,
    jcx_utilatal IN varchar2,
    jcx_comm IN varchar2,
    mode_appel IN number,
    err_num OUT NUMBER,
    err_msg OUT VARCHAR2) IS

BEGIN
  jcx_no := 822431;
  COMMIT WORK;
EXCEPTION
     WHEN OTHERS THEN
     ROLLBACK WORK;
     err_num := SQLCODE;
     err_msg := jcx_no||' *'||jcx_poste||' *'||jcx_utilos||' *'||jcx_utilatal||' *'||jcx_comm||chr(13)||chr(10)||SUBSTR(SQLERRM,1,400);
END;
/

Code: Select all

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, OraCall, Data.DB, DBAccess, Ora, MemDS;

type
  TForm1 = class(TForm)
    PROC_TEST: TOraStoredProc;
    OraButton1: TButton;
    OraSession: TOraSession;
    procedure OraButton1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OraButton1Click(Sender: TObject);
begin
   with OraSession do
   begin
      Username := 'TEST';
      Server := 'ORA12SERVER:1521:ATAL';
      Password := 'TEST';

      AutoCommit := False;
      Options.Charset := 'WE8ISO8859P15';
      Options.DateFormat := 'DD/MM/YYYY';
      Options.DateLanguage := 'FRENCH';
      Options.Direct := True;
//      Options.Net := True;
      Options.NeverConnect := True;
      Connected := True;
   end;

   with PROC_TEST do
   begin
   ParamByName('JCX_NO').AsString := '';

   ParamByName('JCX_POSTE').AsString := 'Info';
   ParamByName('JCX_UTILOS').AsString := 'User';
   ParamByName('JCX_UTILATAL').AsString := '871';
   ParamByName('JCX_COMM').AsString := '';

   ParamByName('MODE_APPEL').AsInteger := 2;
   ExecProc;
   if ParamByName('ERR_NUM').AsInteger<>0 then ShowMessage('BAD')
   else ShowMessage('OK');
   end;
end;

end.

Code: Select all

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 336
  ClientWidth = 293
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object OraButton1: TButton
    Left = 56
    Top = 208
    Width = 145
    Height = 73
    Caption = 'ORA-01460'
    TabOrder = 0
    OnClick = OraButton1Click
  end
  object PROC_TEST: TOraStoredProc
    StoredProcName = 'TEST_JOURNALHISTO'
    Session = OraSession
    SQL.Strings = (
      'begin'
      
        '  TEST_JOURNALHISTO(:JCX_NO, :JCX_POSTE, :JCX_UTILOS, :JCX_UTILA' +
        'TAL, :JCX_COMM, :MODE_APPEL, :ERR_NUM, :ERR_MSG);'
      'end;')
    Left = 160
    Top = 40
    ParamData = <
      item
        DataType = ftString
        Name = 'JCX_NO'
        ParamType = ptInputOutput
        Value = nil
      end
      item
        DataType = ftString
        Name = 'JCX_POSTE'
        ParamType = ptInput
        Value = nil
      end
      item
        DataType = ftString
        Name = 'JCX_UTILOS'
        ParamType = ptInput
        Value = nil
      end
      item
        DataType = ftString
        Name = 'JCX_UTILATAL'
        ParamType = ptInput
        Value = nil
      end
      item
        DataType = ftString
        Name = 'JCX_COMM'
        ParamType = ptInput
        Value = nil
      end
      item
        DataType = ftFloat
        Name = 'MODE_APPEL'
        ParamType = ptInput
        Value = nil
      end
      item
        DataType = ftFloat
        Name = 'ERR_NUM'
        ParamType = ptOutput
        Value = nil
      end
      item
        DataType = ftString
        Name = 'ERR_MSG'
        ParamType = ptOutput
        Value = nil
      end>
    CommandStoredProcName = 'TEST_JOURNALHISTO'
  end
  object OraSession: TOraSession
    Options.DateFormat = 'DD/MM/RR'
    Options.KeepDesignConnected = False
    AutoCommit = False
    Left = 74
    Top = 41
  end
end

Code: Select all

procedure TOCIRecordSet.InitFetchCursor;

  function IsValidCursor(Cursor: TOraCursor): Boolean;
  var
    State: integer;
  begin
    if (Cursor = nil) or (Cursor.hOCIStmt = nil) then
      Result := False
    else begin
       if OCISvcCtx.Home.OCIVersion >= 9100 then // supported starting with 9.1       
           Check(OCI8.OCIAttrGet2(Cursor.OCIStmt, OCI_HTYPE_STMT, State, nil, OCI_ATTR_STMT_STATE, CISvcCtx.hOCIError))
      else
        State := OCI_STMT_STATE_EXECUTED;
      Result := (State = OCI_STMT_STATE_EXECUTED);
    end;
  end;

var
  i: integer;
  Cursor: TOraCursor;
begin
  FFetchCursor := FCommand.FCursorRef;

  if FCommand.NativeCursor and (FCommand.FSQLType = SQL_PLSQL) then begin
    // read implicit result sets
    FCommand.InitResultSets;

    FFetchCursor := nil;

    if FCommand.FResultSets <> nil then
      for i := 0 to FCommand.FResultSets.Count - 1 do begin
        Cursor := FCommand.FResultSets[i];
        if IsValidCursor(Cursor) then begin
          FFetchCursor := Cursor;
          Break;
        end;
      end;

    if FFetchCursor = nil then
      for i := 0 to FCommand.Params.Count - 1 do
        if FCommand.GetParam(i).DataType = dtCursor then begin
          Cursor := FCommand.GetParam(i).GetAsCursor;
          if IsValidCursor(Cursor) then begin
            FFetchCursor := Cursor;
            Break;
          end;
        end;

    // redefine command type - depend on cursor: canbe executed or not
    if FFetchCursor = nil then
      FCommand.CommandType := ctStatement
    else
      FCommand.CommandType := ctCursor;
  end;
end;