We have again a problem with TOraObject type. We are using the latest ODAC VCL. The below example will demonstrate the problem. Please try the demo application. First press the btnRead button and then press the btnWrite button. Please see the comments in the Delphi source code.
The btnReadClick procedure reads the TP_HEAD_EXT object.
The btnWriteClick modify the data and calls the P_HEAD_EXT procedure to update the records in database.
Case "A": If the EXTSTATUS field is assigned BEFORE the fields of the REC object, then all data are written to the database, but freeing the object will cause an Access Violation in Delphi debug session. This problem makes the development very complicate...
Case "B": If the EXTSTATUS field is assigned AFTER the fields of the REC object, then an exception occured while calling the P_HEAD_EXT procedure, because the ITEMLIST property are empty in database side, but not in Delphi side(!).
If we change the object types in example to "FINAL" then there will be no exceptions in the above example. But with similar structure but larger object types we've got errors like "Object is not Allocated" and "Cannot convert type to OCINumber".
Thanky you for your time!
Best regards,
Balázs Miereisz
WINFORM Ltd.
Necessary database SQL code:
Code: Select all
-- Base object type
CREATE OR REPLACE TYPE TP_BASE AS OBJECT (
ID NUMBER(9),
STORNO CHAR(1),
LDATE DATE,
CREATEDBY VARCHAR2(30),
MDATE DATE,
CHANGEDBY VARCHAR2(30),
SDATE DATE,
STORNOBY VARCHAR2(30),
UDATE DATE,
WDATE DATE,
RONLY CHAR(1),
RVERSION NUMBER(9),
SECONDID NUMBER(9),
OTHERID VARCHAR2(40)
) NOT FINAL;
/
-- Head object type
CREATE OR REPLACE TYPE TP_HEAD UNDER TP_BASE (
VCH VARCHAR2(40),
BDOUBLE BINARY_DOUBLE,
INTEG NUMBER(9),
CONSTRUCTOR FUNCTION TP_HEAD (iIDGEN IN CHAR DEFAULT 'F') RETURN SELF AS RESULT
) NOT FINAL;
/
-- Head sequence
CREATE SEQUENCE S_HEAD;
-- Head object type body
CREATE OR REPLACE TYPE BODY TP_HEAD
AS
CONSTRUCTOR FUNCTION TP_HEAD (iIDGEN IN CHAR DEFAULT 'F') RETURN SELF AS RESULT
AS
BEGIN
-- ID gen
IF iIDGEN = 'T'
THEN
ID := S_HEAD.NEXTVAL;
END IF;
LDATE := SYSDATE;
RETURN;
END;
END;
/
-- Head table
CREATE TABLE T_HEAD OF TP_HEAD (CONSTRAINT HEAD_PK PRIMARY KEY (ID));
INSERT INTO T_HEAD (ID, LDATE, VCH, BDOUBLE, INTEG) VALUES (S_HEAD.NEXTVAL, SYSDATE, 'First', 1, 1);
INSERT INTO T_HEAD (ID, LDATE, VCH, BDOUBLE, INTEG) VALUES (S_HEAD.NEXTVAL, SYSDATE, 'Second', 2, 2);
INSERT INTO T_HEAD (ID, LDATE, VCH, BDOUBLE, INTEG) VALUES (S_HEAD.NEXTVAL, SYSDATE, 'Third', 3, 3);
COMMIT;
-- Item object type
CREATE OR REPLACE TYPE TP_ITEM UNDER TP_BASE (
HEADID NUMBER(9),
VCH VARCHAR2(40),
BDOUBLE BINARY_DOUBLE,
INTEG NUMBER(9),
CONSTRUCTOR FUNCTION TP_ITEM (iIDGEN IN CHAR DEFAULT 'F') RETURN SELF AS RESULT
) NOT FINAL;
/
-- Item sequence
CREATE SEQUENCE S_ITEM;
-- Item object type body
CREATE OR REPLACE TYPE BODY TP_ITEM
AS
CONSTRUCTOR FUNCTION TP_ITEM (iIDGEN IN CHAR DEFAULT 'F') RETURN SELF AS RESULT
AS
BEGIN
-- ID gen
IF iIDGEN = 'T'
THEN
ID := S_ITEM.NEXTVAL;
END IF;
LDATE := SYSDATE;
RETURN;
END;
END;
/
-- Item table
CREATE TABLE T_ITEM OF TP_ITEM (CONSTRAINT ITEM_PK PRIMARY KEY (ID));
ALTER TABLE T_ITEM ADD CONSTRAINT ITEM_HEADID_FK FOREIGN KEY (HEADID) REFERENCES T_HEAD (ID);
INSERT INTO T_ITEM (ID, LDATE, VCH, BDOUBLE, INTEG, HEADID) VALUES (S_ITEM.NEXTVAL, SYSDATE, '1.1', 1, 1, (SELECT ID FROM T_HEAD WHERE VCH = 'First'));
INSERT INTO T_ITEM (ID, LDATE, VCH, BDOUBLE, INTEG, HEADID) VALUES (S_ITEM.NEXTVAL, SYSDATE, '1.2', 2, 2, (SELECT ID FROM T_HEAD WHERE VCH = 'First'));
INSERT INTO T_ITEM (ID, LDATE, VCH, BDOUBLE, INTEG, HEADID) VALUES (S_ITEM.NEXTVAL, SYSDATE, '2.1', 3, 3, (SELECT ID FROM T_HEAD WHERE VCH = 'Second'));
COMMIT;
CREATE OR REPLACE TYPE TP_EXT_BASE AS OBJECT (
EXTSTATUS NUMBER(9),
EXTRESULT VARCHAR2(2000)
) NOT FINAL;
/
-- Item ext
CREATE OR REPLACE TYPE TP_ITEM_EXT UNDER TP_EXT_BASE (
REC TP_ITEM,
CONSTRUCTOR FUNCTION TP_ITEM_EXT (iIDGEN IN CHAR DEFAULT 'F', iID IN NUMBER DEFAULT NULL) RETURN SELF AS RESULT
) NOT FINAL;
/
CREATE OR REPLACE TYPE BODY TP_ITEM_EXT
AS
CONSTRUCTOR FUNCTION TP_ITEM_EXT (iIDGEN IN CHAR DEFAULT 'F', iID IN NUMBER DEFAULT NULL) RETURN SELF AS RESULT
AS
BEGIN
IF iID IS NULL
THEN
REC := TP_ITEM(iIDGEN);
EXTSTATUS := 1;
ELSE
SELECT t.OBJECT_VALUE INTO REC FROM T_ITEM t WHERE t.ID = iID;
EXTSTATUS := 0;
END IF;
EXTRESULT := '';
RETURN;
END;
END;
/
CREATE OR REPLACE TYPE TP_ITEM_EXT_TBL AS TABLE OF TP_ITEM_EXT;
/
-- Head ext
CREATE OR REPLACE TYPE TP_HEAD_EXT UNDER TP_EXT_BASE (
REC TP_HEAD,
ITEMLIST TP_ITEM_EXT_TBL,
CONSTRUCTOR FUNCTION TP_HEAD_EXT (iIDGEN IN CHAR DEFAULT 'F', iID IN NUMBER DEFAULT NULL) RETURN SELF AS RESULT
) NOT FINAL;
/
CREATE OR REPLACE TYPE BODY TP_HEAD_EXT
AS
CONSTRUCTOR FUNCTION TP_HEAD_EXT (iIDGEN IN CHAR DEFAULT 'F', iID IN NUMBER DEFAULT NULL) RETURN SELF AS RESULT
AS
BEGIN
ITEMLIST := TP_ITEM_EXT_TBL();
IF iID IS NULL
THEN
REC := TP_HEAD(iIDGEN);
EXTSTATUS := 1;
ELSE
SELECT t.OBJECT_VALUE INTO REC FROM T_HEAD t WHERE t.ID = iID;
FOR r IN (SELECT ID FROM T_ITEM WHERE HEADID = iID)
LOOP
ITEMLIST.EXTEND;
ITEMLIST(ITEMLIST.LAST) := TP_ITEM_EXT('F', r.ID);
END LOOP;
EXTSTATUS := 0;
END IF;
EXTRESULT := '';
RETURN;
END;
END;
/
CREATE OR REPLACE PROCEDURE P_GET_HEAD_EXT (
iID IN NUMBER,
oEXT OUT TP_HEAD_EXT
) AS
BEGIN
oEXT := TP_HEAD_EXT('F', iID);
END P_GET_HEAD_EXT;
/
CREATE OR REPLACE PROCEDURE P_HEAD_EXT (
iEXT IN TP_HEAD_EXT
) AS
BEGIN
IF iEXT.ITEMLIST IS NOT NULL AND iEXT.ITEMLIST.COUNT > 0
THEN
FOR r IN iEXT.ITEMLIST.FIRST..iEXT.ITEMLIST.LAST
LOOP
IF iEXT.ITEMLIST(r).REC IS NULL OR iEXT.ITEMLIST(r).REC.ID IS NULL
THEN
RAISE_APPLICATION_ERROR (-20100, 'Itemlist item object is null. Item index: ' || TO_CHAR(r));
END IF;
END LOOP;
ELSE
RAISE_APPLICATION_ERROR (-20100, 'Itemlist item object is null. Head index: ' || TO_CHAR(iEXT.REC.ID));
END IF;
END P_HEAD_EXT;
/
COMMIT;
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, OraObjects, Vcl.StdCtrls, Ora, OraCall,
Data.DB, DBAccess;
type
TForm1 = class(TForm)
btnRead: TButton;
btnWrite: TButton;
OraSession: TOraSession;
edVCH: TEdit;
procedure btnReadClick(Sender: TObject);
procedure btnWriteClick(Sender: TObject);
private
{ Private declarations }
Rec: TOraObject;
ID: Integer;
HeadID: Integer;
IntValue: Integer;
FloatValue: Double;
procedure CreateRecObject;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.CreateRecObject;
var
OSQL: TOraSQL;
begin
OraSession.Connect;
Rec := TOraObject.Create(TOraType.Create(OraSession.OCISvcCtx, 'TP_HEAD_EXT'));
OSQL := TOraSql.Create(nil);
try
OSQL.Session := OraSession;
OSQL.SQL.Add('BEGIN');
OSQL.SQL.Add(':RESULT := NEW TP_HEAD_EXT(''F'');');
OSQL.SQL.Add('END;');
OSQL.ParamByName('RESULT').AsObject := Rec;
OSQL.Execute;
finally
OSQL.Free;
end;
end;
procedure TForm1.btnReadClick(Sender: TObject);
var
OSP: TOraStoredProc;
begin
CreateRecObject;
OSP := TOraStoredProc.Create(nil);
try
OSP.Session := OraSession;
OSP.AutoCommit := True;
OSP.StoredProcName := 'P_GET_HEAD_EXT';
OSP.ParamCheck := True;
OSP.Prepare;
OSP.ParamByName('iID').DataType := ftInteger;
OSP.ParamByName('iID').ParamType := ptInput;
OSP.ParamByName('iID').AsInteger := 1;
OSP.ParamByName('oEXT').DataType := ftObject;
OSP.ParamByName('oEXT').ParamType := ptOutput;
OSP.ParamByName('oEXT').AsObject := Rec;
OSP.Execute;
finally
OSP.Free;
end;
edVCH.Text := Rec.AttrAsArray['ITEMLIST'].ItemAsObject[0].AttrAsObject['REC'].AttrAsString['VCH'];
ID := Rec.AttrAsArray['ITEMLIST'].ItemAsObject[0].AttrAsObject['REC'].AttrAsInteger['ID'];
HeadID := Rec.AttrAsArray['ITEMLIST'].ItemAsObject[0].AttrAsObject['REC'].AttrAsInteger['HEADID'];
IntValue := Rec.AttrAsArray['ITEMLIST'].ItemAsObject[0].AttrAsObject['REC'].AttrAsInteger['INTEG'];
FloatValue := Rec.AttrAsArray['ITEMLIST'].ItemAsObject[0].AttrAsObject['REC'].AttrAsFloat['BDOUBLE'];
end;
procedure TForm1.btnWriteClick(Sender: TObject);
var
OSQL: TOraSQL;
K: Integer;
begin
Rec.AttrAsObject['REC'].AttrAsDateTime['LDATE'] := Now;
Rec.AttrAsObject['REC'].AttrAsString['VCH'] := edVCH.Text;
Rec.AttrAsInteger['EXTSTATUS'] := 2;
Rec.AttrAsArray['ITEMLIST'].Clear;
K := Rec.AttrAsArray['ITEMLIST'].AppendItem;
// Case "A"
// If the below line in active then all data are updated to database, but there will be an AV in line 135
Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsInteger['EXTSTATUS'] := 2;
Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsObject['REC'].AttrAsInteger['ID'] := ID;
Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsObject['REC'].AttrAsInteger['HEADID'] := HeadID;
Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsObject['REC'].AttrAsInteger['INTEG'] := IntValue;
Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsObject['REC'].AttrAsString['VCH'] := edVCH.Text;
Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsObject['REC'].AttrAsFloat['BDOUBLE'] := FloatValue;
Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsObject['REC'].AttrAsDateTime['LDATE'] := Now;
// Case "B"
// If the below line in active then ITEMLIST will not be updated to database and there will be an exception in P_HEAD_EXT procedure (line 130)
// Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsInteger['EXTSTATUS'] := 2;
OSQL := TOraSql.Create(Self);
try
OSQL.Session := OraSession;
OSQL.AutoCommit := True;
OSQL.ParamCheck := True;
OSQL.SQL.Add('BEGIN');
OSQL.SQL.Add('P_HEAD_EXT(:iEXT);');
OSQL.SQL.Add('END;');
OSQL.ParamByName('iEXT').DataType := ftObject;
OSQL.ParamByName('iEXT').ParamType := ptInputOutput;
OSQL.ParamByName('iEXT').AsObject := Rec;
ShowMessage('Item ' + IntToStr(K + 1) + ': ' + Rec.AttrAsArray['ITEMLIST'].ItemAsObject[K].AttrAsObject['REC'].AttrAsString['VCH']);
OSQL.Execute; // Exception in case "B"
OraSession.Commit;
edVCH.Text := '';
finally
OSQL.Free;
Rec.Free; // AV in case "A"
end;
end;
end.Code: Select all
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 299
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object btnRead: TButton
Left = 30
Top = 22
Width = 75
Height = 25
Caption = 'btnRead'
TabOrder = 0
OnClick = btnReadClick
end
object btnWrite: TButton
Left = 30
Top = 53
Width = 75
Height = 25
Caption = 'btnWrite'
TabOrder = 1
OnClick = btnWriteClick
end
object edVCH: TEdit
Left = 146
Top = 24
Width = 255
Height = 21
TabOrder = 2
end
object OraSession: TOraSession
Options.UseUnicode = True
Options.UnicodeEnvironment = True
Username = 'WINNER'
Server = 'MBT460:1521/XEPDB1'
Connected = True
LoginPrompt = False
Schema = 'WINNER'
Left = 172
Top = 84
EncryptedPassword = 'A8FFADFFBEFFBBFFB2FFB6FFB1FF'
end
end