Devart Forums

Code: Select all

function TCustomDAConnection.DetectConnLostCause(Component: TObject): TConnLostCause;
var
  i: integer;
  AllowFailOver: boolean;
begin
  Result := clUnknown;
  AllowFailOver := True;
  for i := FOperationsStackLen - 1 downto 0 do begin

    if Result < FOperationsStack[i].Operation then begin
      Result := FOperationsStack[i].Operation;
      AllowFailOver := FOperationsStack[i].AllowFailOver;
    end;

    case Result of
      clConnect: begin
//        if TCustomDAConnection(Component).FShouldShowPrompt then
{==Vs====================================================================}
        if Assigned(Component) and TCustomDAConnection(Component).FShouldShowPrompt then
{==Vs====================================================================}
          Result := clUnknown;// This is the first connect or non DisconnectedMode - so we should raise exception
        break;
      end;
      clOpen, clExecute: begin
        if ((Component is TCustomDADataSet) and not TCustomDADataSet(Component).IsQuery) or
          (Component is TCustomDASQL) then
          Inc(FConnectCount); // Add ConnectCount - > cause of EndConnection in TCustomDADataSet.DoAfterExecute
      end;
    end;
  end;

  if not AllowFailOver then
    Result := clUnknown;

  case Result of
    clExecute, clOpen, clServiceQuery, clTransStart:
      if not IsFailOverAllowed then
        Result := clUnknown;                    //can't perform FailOver cause of possible unnoticed server changes lost
  end;
end;

Code: Select all

create table SCOTT.TEST_TBL(
  a VARCHAR2(20) not null,
  b NUMBER(1)
);

create or replace synonym SCOTT.TEST for SCOTT.TEST_TBL;

Code: Select all

program Project1;

uses
  Vcl.Forms,
  Unit12 in 'Unit12.pas' {Form12};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm12, Form12);
  Application.Run;
end.

Code: Select all

object Form12: TForm12
  Left = 0
  Top = 0
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  ParentFont = True
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object DBGrid1: TDBGrid
    Left = 0
    Top = 39
    Width = 635
    Height = 260
    Align = alBottom
    DataSource = DataSource1
    TabOrder = 1
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
  end
  object OraSession1: TOraSession
    Options.KeepDesignConnected = False
    Username = 'scott'
    Server = 'TEST'
    LoginPrompt = False
    Left = 320
    Top = 16
    EncryptedPassword = '8BFF96FF98FF9AFF8DFF'
  end
  object OraSQLMonitor1: TOraSQLMonitor
    Left = 320
    Top = 88
  end
  object SmartQuery1: TSmartQuery
    Session = OraSession1
    SQL.Strings = (
      'Select * from test')
    Left = 240
    Top = 24
    object SmartQuery1A: TStringField
      FieldName = 'A'
      Required = True
    end
    object SmartQuery1B: TIntegerField
      FieldName = 'B'
    end
  end
  object DataSource1: TDataSource
    DataSet = SmartQuery1
    Left = 240
    Top = 80
  end
end

Code: Select all

unit Unit12;

interface

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

type
  TForm12 = class(TForm)
    OraSession1: TOraSession;
    Button1: TButton;
    OraSQLMonitor1: TOraSQLMonitor;
    SmartQuery1: TSmartQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    SmartQuery1A: TStringField;
    SmartQuery1B: TIntegerField;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form12: TForm12;

implementation

{$R *.dfm}

procedure TForm12.Button1Click(Sender: TObject);
begin
 SmartQuery1.Insert;
 SmartQuery1A.AsString := DateTimeToStr(Now);
 SmartQuery1.Post;
end;

procedure TForm12.FormCreate(Sender: TObject);
begin
 OraSession1.Open;
 SmartQuery1.Open;
end;

end.

Code: Select all

procedure TOCIRecordSet.RequestFieldsInfo(Tables: TSQLObjectsInfo; Columns: TCRColumnsInfo);

  function AddDBLink(DBLink: string): string;
  begin
    if DBLink <> '' then
      Result := '@' + DBLink;
  end;

  function Locate(Query: TOCIRecordSet; RecBuf: IntPtr; const FieldNames: array of string; const Values: array of string): boolean;
  var
    i: Integer;
    v: variant;
    Fields: TList;
  begin
{==Vs====================================================================}
    Result := False;
{==Vs====================================================================}
    Fields := TList.Create;
    try
      for i := 0 to Length(FieldNames) - 1 do
        Fields.Add(Query.FieldByName(FieldNames[i]));

      Query.SetToBegin;
      while True do begin
        Query.GetNextRecord(RecBuf);
        if Query.Eof then
          break;

        Result := True;
        for i := 0 to Fields.Count - 1 do begin
          Query.GetFieldAsVariant(Fields[i], RecBuf, v);
          if not SameText(VarToStr(v), Values[i]) then begin
             Result := False;
            break;
          end;
        end;

        if Result then
          Exit;
      end;

{==Vs====================================================================}
//      Result := True;
{==Vs====================================================================}
    finally
      Fields.Free;
    end;
  end;

Code: Select all

program Project1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form13};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm13, Form13);
  Application.Run;
end.

Code: Select all

object Form13: TForm13
  Left = 0
  Top = 0
  Caption = 'Form13'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 0
    Top = 0
    Width = 635
    Height = 232
    Align = alClient
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
  end
  object Panel1: TPanel
    Left = 0
    Top = 232
    Width = 635
    Height = 67
    Align = alBottom
    TabOrder = 1
    object Button2: TButton
      Left = 360
      Top = 24
      Width = 75
      Height = 25
      Caption = 'Button2'
      TabOrder = 0
      OnClick = Button2Click
    end
  end
  object OraSession1: TOraSession
    Options.Direct = True
    AutoCommit = False
    OnConnectionLost = OraSession1ConnectionLost
    Left = 96
    Top = 48
  end
  object OraTransaction1: TOraTransaction
    DefaultSession = OraSession1
    Left = 192
    Top = 48
  end
  object DataSource1: TDataSource
    DataSet = OraQuery2
    Left = 104
    Top = 112
  end
  object OraQuery2: TOraQuery
    Session = OraSession1
    SQL.Strings = (
      'select * from emp')
    Left = 448
    Top = 80
  end
  object OraSQLMonitor1: TOraSQLMonitor
    Left = 480
    Top = 24
  end
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, Data.DB, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.Grids, Vcl.DBGrids, MemDS, DBAccess, Ora, OraTransaction, OraCall,
  OraSmart, DASQLMonitor, OraSQLMonitor, odacvcl, OraNet, MemData;

type
  TForm13 = class(TForm)
    OraSession1: TOraSession;
    OraTransaction1: TOraTransaction;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Panel1: TPanel;
    OraQuery2: TOraQuery;
    OraSQLMonitor1: TOraSQLMonitor;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure OraSession1ConnectionLost(Sender: TObject; Component: TComponent;
      ConnLostCause: TConnLostCause; var RetryMode: TRetryMode);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form13: TForm13;

implementation

{$R *.dfm}

procedure TForm13.Button2Click(Sender: TObject);
begin
 OraQuery2.Close;
 OraQuery2.Open;
end;

procedure TForm13.FormCreate(Sender: TObject);
begin
 OraSession1.Open;
 OraQuery2.Open;
 Caption := Application.ExeName;
end;

procedure TForm13.OraSession1ConnectionLost(Sender: TObject;
  Component: TComponent; ConnLostCause: TConnLostCause;
  var RetryMode: TRetryMode);
begin
 RetryMode := rmReconnectExecute;
end;

end.

Code: Select all

exception number   : 1
exception class    : EOraError
exception message  : Unknown error 1.

main thread ($1f10):
0083de22 +1ca Project17.exe OraClasses      2403  +48 TOCIConnection.OraError
00867831 +02d Project17.exe OraClasses     17759   +2 TOCITransaction.Check
00868408 +0b0 Project17.exe OraClasses     17950  +12 TOCITransaction.CommitLocal
00867f5f +023 Project17.exe OraClasses     17889   +1 TOCITransaction.StartTransactionLocal
00868ac8 +108 Project17.exe OraClasses     18091  +14 TOCITransaction.StartTransaction
007c33c5 +121 Project17.exe DBAccess       17799  +25 TDATransaction.StartTransaction
0087c04c +090 Project17.exe OraTransaction   369  +12 TOraTransaction.StartTransaction
0087bfb4 +00c Project17.exe OraTransaction   353   +1 TOraTransaction.StartTransaction
008897b6 +05a Project17.exe Ora             2554   +7 TOraSession.StartTransaction
00889754 +010 Project17.exe Ora             2541   +1 TOraSession.StartTransaction
008aa4be +03e Project17.exe Unit13            48   +2 TForm13.Button1Click
00656a67 +073 Project17.exe Vcl.Controls    7361   +9 TControl.Click
005a541a +01e Project17.exe Vcl.StdCtrls    5327   +3 TCustomButton.Click
005a5f28 +010 Project17.exe Vcl.StdCtrls    5788   +1 TCustomButton.CNCommand
006564f9 +2bd Project17.exe Vcl.Controls    7245  +91 TControl.WndProc
0065b0a1 +5e9 Project17.exe Vcl.Controls   10079 +158 TWinControl.WndProc
005a50c4 +06c Project17.exe Vcl.StdCtrls    5164  +13 TButtonControl.WndProc
00656134 +024 Project17.exe Vcl.Controls    7023  +10 TControl.Perform
0065b207 +023 Project17.exe Vcl.Controls   10148  +12 DoControlMsg
0065bc8f +00b Project17.exe Vcl.Controls   10423   +1 TWinControl.WMCommand
006564f9 +2bd Project17.exe Vcl.Controls    7245  +91 TControl.WndProc
0065b0a1 +5e9 Project17.exe Vcl.Controls   10079 +158 TWinControl.WndProc
0065a6c0 +02c Project17.exe Vcl.Controls    9786   +3 TWinControl.MainWndProc
00534e80 +014 Project17.exe System.Classes 16882   +8 StdWndProc
77433a2e +13e user32.dll                              SendMessageW
77434522 +092 user32.dll                              CallWindowProcW
0065b1b2 +0e6 Project17.exe Vcl.Controls   10120  +30 TWinControl.DefaultHandler
00656ebc +010 Project17.exe Vcl.Controls    7494   +1 TControl.WMLButtonUp
006564f9 +2bd Project17.exe Vcl.Controls    7245  +91 TControl.WndProc
0065b0a1 +5e9 Project17.exe Vcl.Controls   10079 +158 TWinControl.WndProc
005a50c4 +06c Project17.exe Vcl.StdCtrls    5164  +13 TButtonControl.WndProc
0065a6c0 +02c Project17.exe Vcl.Controls    9786   +3 TWinControl.MainWndProc
00534e80 +014 Project17.exe System.Classes 16882   +8 StdWndProc
77433e4b +00b user32.dll                              DispatchMessageW
0062cb43 +0f3 Project17.exe Vcl.Forms      10421  +23 TApplication.ProcessMessage
0062cb86 +00a Project17.exe Vcl.Forms      10451   +1 TApplication.HandleMessage
0062ceb9 +0c9 Project17.exe Vcl.Forms      10589  +26 TApplication.Run
008badb9 +049 Project17.exe Project17         17   +4 initialization
76eb3742 +022 KERNEL32.DLL                            BaseThreadInitThunk

Code: Select all

program Project17;

uses
  madExcept,
  madLinkDisAsm,
  Vcl.Forms,
  Unit13 in 'Unit13.pas' {Form13};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm13, Form13);
  Application.Run;
end.

Code: Select all

object Form13: TForm13
  Left = 0
  Top = 0
  Caption = 'Form13'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  ParentFont = True
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 0
    Top = 0
    Width = 635
    Height = 232
    Align = alClient
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
  end
  object Panel1: TPanel
    Left = 0
    Top = 232
    Width = 635
    Height = 67
    Align = alBottom
    TabOrder = 1
    object Button1: TButton
      Left = 264
      Top = 24
      Width = 75
      Height = 25
      Caption = 'Button1'
      TabOrder = 0
      OnClick = Button1Click
    end
  end
  object OraSession1: TOraSession
    Options.Direct = True
    AutoCommit = False
    Left = 96
    Top = 48
  end
  object OraTransaction1: TOraTransaction
    DefaultSession = OraSession1
    Left = 192
    Top = 48
  end
  object SmartQuery1: TSmartQuery
    UpdatingTable = 'EMP'
    KeyFields = 'EMPNO'
    Session = OraSession1
    SQL.Strings = (
      'select * from emp'
      'where ENAME like :ENAME')
    LockMode = lmNone
    Left = 296
    Top = 32
    ParamData = <
      item
        DataType = ftString
        Name = 'ENAME'
        Value = ''
      end>
  end
  object DataSource1: TDataSource
    DataSet = OraQuery2
    Left = 104
    Top = 112
  end
  object OraQuery2: TOraQuery
    Session = OraSession1
    SQL.Strings = (
      'select * from emp')
    Active = True
    Left = 448
    Top = 80
  end
end

Code: Select all

unit Unit13;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.Grids, Vcl.DBGrids, MemDS, DBAccess, Ora, OraTransaction, OraCall,
  OraSmart, odacvcl;

type
  TForm13 = class(TForm)
    OraSession1: TOraSession;
    OraTransaction1: TOraTransaction;
    SmartQuery1: TSmartQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Panel1: TPanel;
    Button1: TButton;
    OraQuery2: TOraQuery;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  end;

var
  Form13: TForm13;

implementation

{$R *.dfm}

procedure TForm13.Button1Click(Sender: TObject);
begin
 try
  OraSession1.StartTransaction;
  try
   if not SmartQuery1.Prepared then
    SmartQuery1.Prepare;
   SmartQuery1.ParamByName('ENAME').AsString := '%A%';
   SmartQuery1.Open;
   SmartQuery1.Edit;
   SmartQuery1.FieldByName('ENAME').AsString := 'test'+ SmartQuery1.FieldByName('ENAME').AsString;
   SmartQuery1.Post;
   OraSession1.Commit;
  except
   OraSession1.Rollback;
   raise;
  end;
 finally
  SmartQuery1.Close;
 end;
 OraQuery2.Close;
 OraQuery2.Open;
end;

procedure TForm13.FormCreate(Sender: TObject);
begin
 OraSession1.Open;
 OraQuery2.Open;
end;

end.

Code: Select all

create user oratest1 identified by "111" password expire default tablespace USERS temporary tablespace TEMP;
create user oratest2 identified by "111" password expire default tablespace USERS temporary tablespace TEMP;

grant connect to oratest1, oratest2;

Code: Select all

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 300
  ClientWidth = 635
  Color = clBtnFace
  ParentFont = True
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 64
    Top = 112
    Width = 75
    Height = 25
    Caption = 'OCI'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 168
    Top = 112
    Width = 75
    Height = 25
    Caption = 'Direct'
    TabOrder = 1
    OnClick = Button2Click
  end
  object OraSession1: TOraSession
    Username = 'ORATEST1'
    Server = 'TEST'
    OnError = OraSession1Error
    Left = 96
    Top = 16
  end
  object OraSession2: TOraSession
    Options.Direct = True
    Username = 'ORATEST2'
    Server = 'test:1521:TEST'
    OnError = OraSession2Error
    Left = 176
    Top = 16
  end
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, OraError, OraCall, Data.DB, DBAccess,
  Ora, Vcl.StdCtrls, OdacVcl;

type
  TForm1 = class(TForm)
    OraSession1: TOraSession;
    OraSession2: TOraSession;
    Button1: TButton;
    Button2: TButton;
    procedure OraSession2Error(Sender: TObject; E: EDAError; var Fail: Boolean);
    procedure OraSession1Error(Sender: TObject; E: EDAError; var Fail: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 OraSession1.Connected := True;
 ShowMessage('OCI Connected');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 OraSession2.Connected := True;
 ShowMessage('Direct Connected');
end;

procedure TForm1.OraSession1Error(Sender: TObject; E: EDAError;
  var Fail: Boolean);
begin
 if (E is EOraError) and (EOraError(E).ErrorCode = 28001) then
  begin
   Fail := False;
   OraSession1.ChangePassword('222');
  end;
end;

procedure TForm1.OraSession2Error(Sender: TObject; E: EDAError;
  var Fail: Boolean);
begin
 if (E is EOraError) and (EOraError(E).ErrorCode = 28001) then
  begin
   Fail := False;
   OraSession2.ChangePassword('222');
  end;
end;

end.

Code: Select all

procedure TGDSConnection.SetDatabaseHandle(Value: TISC_DB_HANDLE);

Code: Select all

 with TUniConnection(Db) do
  begin
{$IFDEF Oracle}
   if FIConnection is TOCIConnection then
    begin
     OCIConnection := (FIConnection as TOCIConnection);
     hOCISvcCtx := Pointer(PluginData.DatabaseHandle);
     if OCIConnection.Direct then
      Environment := OracleHomes.Direct.AllocEnvironment(PluginData.hOCIEnv)
     else
      begin
       Home := OracleHomes.GetHome(HomeName);
       Environment := Home.AllocEnvironment(OCIConnection.UnicodeEnvironment, 0);
      end;
     Unicode := StrToBoolDef(SpecificOptions.Values['Oracle.UseUnicode'], False);
     TempOCISvcCtx := TOCISvcCtx.Create(Environment, hOCISvcCtx, Unicode);
     OCIConnection.SetOCISvcCtx(TempOCISvcCtx);
    end;
{$ENDIF}
{$IFDEF InterBase}
   if FIConnection is TGDSConnection then
    begin
     GDSConnection := (FIConnection as TGDSConnection);
     GDSConnection.SetDatabaseHandle(Pointer(PluginData.DatabaseHandle));
    end;
{$ENDIF}
  end;

Code: Select all

 with TUniConnection(Db) do
  begin
{$IFDEF Oracle}
   if FIConnection is TOCIConnection then
    begin
     OCIConnection := (FIConnection as TOCIConnection);
     hOCISvcCtx := Pointer(PluginData.DatabaseHandle);
     if OCIConnection.Direct then
      OCIConnection.AssignSvcCtx(PluginData.hOCIEnv, hOCISvcCtx)
     else
      OCIConnection.AssignSvcCtx(hOCISvcCtx);
    end;
{$ENDIF}
{$IFDEF InterBase}
   if FIConnection is TGDSConnection then
    begin
     GDSConnection := (FIConnection as TGDSConnection);
     GDSConnection.SetDatabaseHandle(Pointer(PluginData.DatabaseHandle));
    end;
{$ENDIF}
  end;

Code: Select all

procedure TOCIConnection.AssignSvcCtx(hOCISvcCtx: pOCISvcCtx);
procedure TOCIConnection.AssignSvcCtx(hOCIEnv: pOCIEnv; hOCISvcCtx: pOCISvcCtx);