Access Violation in OraObject

prosoft · Post by **prosoft** » Thu 15 Nov 2018 10:00

В Oracle 11.2 создаю 4 объекта

create or replace type event$_property as object
(
name varchar2(32),
type int,
str_value varchar(2000),
num_value number,
date_value date
);

Code: Select all

create or replace type event$_prop_array as varray(30) of event$_property;

Code: Select all

create or replace type event$_properties as object
(
  property   event$_prop_array,
  member function count return integer,
  member function item(p_index integer) return event$_property,
  member function itemType(p_index integer) return integer,
  member function findPropertyIndex(p_name varchar2) return integer,
  member procedure set_string(p_name varchar2, p_value varchar2),
  member procedure set_integer(p_name varchar2, p_value integer),
  member procedure set_boolean(p_name varchar2, p_value boolean),
  member procedure set_double(p_name varchar2, p_value number),
  member procedure set_date(p_name varchar2, p_value date),
  member function get_string(p_name varchar2) return varchar2,
  member function get_string(p_index integer) return varchar2,
  member function get_integer(p_name varchar2) return integer,
  member function get_integer(p_index integer) return integer,
  member function get_boolean(p_name varchar2) return boolean,
  member function get_boolean(p_index integer) return boolean,
  member function get_double(p_name varchar2) return number,
  member function get_double(p_index integer) return number,
  member function get_date(p_name varchar2) return date,
  member function get_date(p_index integer) return date
  )
/
create or replace type body event$_properties as
  member function count return integer is
  begin
    if property is null then
      return null;
    else
      return property.count();
    end if;
  end;

  member function item(p_index integer) return event$_property is
  begin
    if (property is null) or (p_index <= 0) then
      return null;
    elsif p_index > property.last then
      return null;
    else
      return property(p_index);
    end if;
  end;

  member function itemType(p_index integer) return integer is
    i event$_property;
  begin
    i := item(p_index);
    if i is null then
      return null;
    else
      return i.type;
    end if;
  end;

  member function findPropertyIndex(p_name varchar2) return integer is
  begin
    if property is null then
      return null;
    else
      for i in property.first .. property.last loop
        if property(i).name = p_name then
          return i;
        end if;
      end loop;
      return null;
    end if;
  end;

  member procedure set_string(p_name varchar2, p_value varchar2) is
    i    integer;
    item event$_property;
  begin
    i    := findPropertyIndex(p_name);
    item := event$_property(lower(p_name), 20, p_value, null, null);
    if i is null then
      if property is null then
        property := event$_prop_array(item);
      else
        property.extend();
        property(property.count) := item;
      end if;
    else
      property(i) := item;
    end if;
  end;

  member procedure set_integer(p_name varchar2, p_value integer) is
    i    integer;
    item event$_property;
  begin
    i    := findPropertyIndex(p_name);
    item := event$_property(lower(p_name), 21, null, p_value, null);
    if i is null then
      if property is null then
        property := event$_prop_array(item);
      else
        property.extend();
        property(property.count) := item;
      end if;
    else
      property(i) := item;
    end if;
  end;

  member procedure set_boolean(p_name varchar2, p_value boolean) is
    i    integer;
    item event$_property;
  begin
    i := findPropertyIndex(p_name);

    if p_value is null then
      item := event$_property(lower(p_name), 22, null, null, null);
    elsif p_value then
      item := event$_property(lower(p_name), 22, null, 1, null);
    else
      item := event$_property(lower(p_name), 22, null, 0, null);
    end if;

    if i is null then
      if property is null then
        property := event$_prop_array(item);
      else
        property.extend();
        property(property.count) := item;
      end if;
    else
      property(i) := item;
    end if;
  end;

  member procedure set_double(p_name varchar2, p_value number) is
    i    integer;
    item event$_property;
  begin
    i    := findPropertyIndex(p_name);
    item := event$_property(lower(p_name), 23, null, p_value, null);
    if i is null then
      if property is null then
        property := event$_prop_array(item);
      else
        property.extend();
        property(property.count) := item;
      end if;
    else
      property(i) := item;
    end if;
  end;

  member procedure set_date(p_name varchar2, p_value date) is
    i    integer;
    item event$_property;
  begin
    i    := findPropertyIndex(p_name);
    item := event$_property(lower(p_name), 24, null, null, p_value);
    if i is null then
      if property is null then
        property := event$_prop_array(item);
      else
        property.extend();
        property(property.count) := item;
      end if;
    else
      property(i) := item;
    end if;
  end;

  member function get_string(p_name varchar2) return varchar2 is
    i integer;
  begin
    i := findPropertyIndex(p_name);
    if i is null then
      return null;
    else
      return get_string(i);
    end if;
  end;

  member function get_string(p_index integer) return varchar2 is
    i event$_property;
  begin
    i := item(p_index);
    if (i is null) or (i.type != 20) then
      return null;
    else
      return i.str_value;
    end if;
  end;

  member function get_integer(p_name varchar2) return integer is
    i integer;
  begin
    i := findPropertyIndex(p_name);
    if i is null then
      return null;
    else
      return get_integer(i);
    end if;
  end;

  member function get_integer(p_index integer) return integer is
    i event$_property;
  begin
    i := item(p_index);
    if (i is null) or (i.type != 21) then
      return null;
    else
      return i.num_value;
    end if;
  end;

  member function get_boolean(p_name varchar2) return boolean is
    i integer;
  begin
    i := findPropertyIndex(p_name);
    if i is null then
      return null;
    else
      return get_boolean(i);
    end if;
  end;

  member function get_boolean(p_index integer) return boolean is
    i event$_property;
  begin
    i := item(p_index);
    if (i is null) or (i.type != 22) then
      return null;
    else
      if i.num_value is null then
        return null;
      else
        return i.num_value = 1;
      end if;
    end if;
  end;

  member function get_double(p_name varchar2) return number is
    i integer;
  begin
    i := findPropertyIndex(p_name);
    if i is null then
      return null;
    else
      return get_double(i);
    end if;
  end;

  member function get_double(p_index integer) return number is
    i event$_property;
  begin
    i := item(p_index);
    if (i is null) or (i.type != 23) then
      return null;
    else
      return i.num_value;
    end if;
  end;

  member function get_date(p_name varchar2) return date is
    i integer;
  begin
    i := findPropertyIndex(p_name);
    if i is null then
      return null;
    else
      return get_date(i);
    end if;
  end;

  member function get_date(p_index integer) return date is
    i event$_property;
  begin
    i := item(p_index);
    if (i is null) or (i.type != 24) then
      return null;
    else
      return i.date_value;
    end if;
  end;

end;
/

Code: Select all

create or replace type event$_message as object
(
  system    varchar2(32 char),
  subsystem varchar2(32 char),
  datetime  date,
  eventType varchar2(32 char),
  header    event$_properties,
  message   event$_properties,
  static function construct return event$_message,
  static function construct(p_system     varchar2,
                            p_subsystem  varchar2,
                            p_datetime   date,
                            p_event_type varchar2) return event$_message,
  member function count return integer,
  member function item(p_index integer) return event$_property,
  member function itemType(p_index integer) return integer,
  member function findPropertyIndex(p_name varchar2) return integer,
  member procedure set_string(p_name varchar2, p_value varchar2),
  member procedure set_integer(p_name varchar2, p_value integer),
  member procedure set_boolean(p_name varchar2, p_value boolean),
  member procedure set_double(p_name varchar2, p_value number),
  member procedure set_date(p_name varchar2, p_value date),
  member function get_string(p_name varchar2) return varchar2,
  member function get_string(p_index integer) return varchar2,
  member function get_integer(p_name varchar2) return integer,
  member function get_integer(p_index integer) return integer,
  member function get_boolean(p_name varchar2) return boolean,
  member function get_boolean(p_index integer) return boolean,
  member function get_double(p_name varchar2) return number,
  member function get_double(p_index integer) return number,
  member function get_date(p_name varchar2) return date,
  member function get_date(p_index integer) return date,

  member function header_count return integer,
  member function header_item(p_index integer) return event$_property,
  member function header_itemType(p_index integer) return integer,
  member function header_findPropertyIndex(p_name varchar2) return integer,
  member procedure header_set_string(p_name varchar2, p_value varchar2),
  member procedure header_set_integer(p_name varchar2, p_value integer),
  member procedure header_set_boolean(p_name varchar2, p_value boolean),
  member procedure header_set_double(p_name varchar2, p_value number),
  member procedure header_set_date(p_name varchar2, p_value date),
  member function header_get_string(p_name varchar2) return varchar2,
  member function header_get_string(p_index integer) return varchar2,
  member function header_get_integer(p_name varchar2) return integer,
  member function header_get_integer(p_index integer) return integer,
  member function header_get_boolean(p_name varchar2) return boolean,
  member function header_get_boolean(p_index integer) return boolean,
  member function header_get_double(p_name varchar2) return number,
  member function header_get_double(p_index integer) return number,
  member function header_get_date(p_name varchar2) return date,
  member function header_get_date(p_index integer) return date

)
;
/
create or replace type body event$_message as

  static function construct return event$_message is
  begin
    return event$_message(null, null, null, null, null, null);
  end;

  static function construct(p_system     varchar2,
                            p_subsystem  varchar2,
                            p_datetime   date,
                            p_event_type varchar2) return event$_message is
  begin
    return event$_message(upper(p_system),
                          upper(p_subsystem),
                          p_datetime,
                          upper(p_event_type),
                          null,
                          null);
  end;

  member function count return integer is
  begin
    if message is null then
      return null;
    else
      return message.count();
    end if;
  end;

  member function item(p_index integer) return event$_property is
  begin
    if message is null then
      return null;
    else
      return message.item(p_index);
    end if;
  end;

  member function itemType(p_index integer) return integer is
    i event$_property;
  begin
    i := item(p_index);
    if i is null then
      return null;
    else
      return i.type;
    end if;
  end;

  member function findPropertyIndex(p_name varchar2) return integer is
  begin
    if message is null then
      return null;
    else
      return message.findPropertyIndex(p_name);
    end if;
  end;

  member procedure set_string(p_name varchar2, p_value varchar2) is
  begin
    if message is null then
      message := event$_properties(null);
    end if;
    message.set_string(p_name, p_value);
  end;

  member procedure set_integer(p_name varchar2, p_value integer) is
  begin
    if message is null then
      message := event$_properties(null);
    end if;
    message.set_integer(p_name, p_value);
  end;

  member procedure set_boolean(p_name varchar2, p_value boolean) is
  begin
    if message is null then
      message := event$_properties(null);
    end if;
    message.set_boolean(p_name, p_value);
  end;

  member procedure set_double(p_name varchar2, p_value number) is
  begin
    if message is null then
      message := event$_properties(null);
    end if;
    message.set_double(p_name, p_value);
  end;

  member procedure set_date(p_name varchar2, p_value date) is
  begin
    if message is null then
      message := event$_properties(null);
    end if;
    message.set_date(p_name, p_value);
  end;

  member function get_string(p_name varchar2) return varchar2 is
  begin
    if message is null then
      return null;
    else
      return message.get_string(p_name);
    end if;
  end;

  member function get_string(p_index integer) return varchar2 is
  begin
    if message is null then
      return null;
    else

      return message.get_string(p_index);
    end if;
  end;

  member function get_integer(p_name varchar2) return integer is
  begin
    if message is null then
      return null;
    else
      return message.get_integer(p_name);
    end if;
  end;

  member function get_integer(p_index integer) return integer is
  begin
    if message is null then
      return null;
    else
      return message.get_integer(p_index);
    end if;
  end;

  member function get_boolean(p_name varchar2) return boolean is
  begin
    if message is null then
      return null;
    else

      return message.get_boolean(p_name);
    end if;
  end;

  member function get_boolean(p_index integer) return boolean is
  begin
    if message is null then
      return null;
    else
      return message.get_boolean(p_index);
    end if;
  end;

  member function get_double(p_name varchar2) return number is
  begin
    if message is null then
      return null;
    else
      return message.get_double(p_name);
    end if;
  end;

  member function get_double(p_index integer) return number is
  begin
    if message is null then
      return null;
    else
      return message.get_double(p_index);
    end if;
  end;

  member function get_date(p_name varchar2) return date is
  begin
    if message is null then
      return null;
    else
      return message.get_date(p_name);
    end if;
  end;

  member function get_date(p_index integer) return date is
  begin
    if message is null then
      return null;
    else
      return message.get_date(p_index);
    end if;
  end;

  member function header_count return integer is
  begin
    if header is null then
      return null;
    else
      return header.count();
    end if;
  end;

  member function header_item(p_index integer) return event$_property is
  begin
    if header is null then
      return null;
    else
      return header.item(p_index);
    end if;
  end;

  member function header_itemType(p_index integer) return integer is
  begin
    if header is null then
      return null;
    else
      return header.itemType(p_index);
    end if;
  end;

  member function header_findPropertyIndex(p_name varchar2) return integer is
  begin
    if header is null then
      return null;
    else
      return header.findPropertyIndex(p_name);
    end if;
  end;

  member procedure header_set_string(p_name varchar2, p_value varchar2) is
  begin
    if header is null then
      header := event$_properties(null);
    end if;
    header.set_string(p_name, p_value);
  end;

  member procedure header_set_integer(p_name varchar2, p_value integer) is
  begin
    if header is null then
      header := event$_properties(null);
    end if;
    header.set_integer(p_name, p_value);
  end;

  member procedure header_set_boolean(p_name varchar2, p_value boolean) is
  begin
    if header is null then
      header := event$_properties(null);
    end if;
    header.set_boolean(p_name, p_value);
  end;

  member procedure header_set_double(p_name varchar2, p_value number) is
  begin
    if header is null then
      header := event$_properties(null);
    end if;
    header.set_double(p_name, p_value);
  end;

  member procedure header_set_date(p_name varchar2, p_value date) is
  begin
    if header is null then
      header := event$_properties(null);
    end if;
    header.set_date(p_name, p_value);
  end;

  member function header_get_string(p_name varchar2) return varchar2 is
  begin
    if header is null then
      return null;
    else

      return header.get_string(p_name);
    end if;
  end;
  member function header_get_string(p_index integer) return varchar2 is
  begin
    if header is null then
      return null;
    else

      return header.get_string(p_index);
    end if;
  end;
  member function header_get_integer(p_name varchar2) return integer is
  begin
    if header is null then
      return null;
    else
      return header.get_integer(p_name);
    end if;
  end;
  member function header_get_integer(p_index integer) return integer is
  begin
    if header is null then
      return null;
    else
      return header.get_integer(p_index);
    end if;
  end;
  member function header_get_boolean(p_name varchar2) return boolean is
  begin
    if header is null then
      return null;
    else
      return header.get_boolean(p_name);
    end if;
  end;
  member function header_get_boolean(p_index integer) return boolean is
  begin
    if header is null then
      return null;
    else
      return header.get_boolean(p_index);
    end if;
  end;
  member function header_get_double(p_name varchar2) return number is
  begin
    if header is null then
      return null;
    else
      return header.get_double(p_name);
    end if;
  end;
  member function header_get_double(p_index integer) return number is
  begin
    if header is null then
      return null;
    else
      return header.get_double(p_index);
    end if;
  end;
  member function header_get_date(p_name varchar2) return date is
  begin
    if header is null then
      return null;
    else
      return header.get_date(p_name);
    end if;
  end;
  member function header_get_date(p_index integer) return date is
  begin
    if header is null then
      return null;
    else
      return header.get_date(p_index);
    end if;
  end;

end;

Code: Select all

CREATE TABLE TST_EVENTS$TAB
(
  EVENT  EVENT$_MESSAGE
);

вставляю в таблицу объект

Code: Select all

declare 
  i event$_message;
begin
  i := event$_message.construct('crm', 'cntr', sysdate, 'cntr_new');
  i.set_string('gE', '123456789');
  i.set_string('gE', '567890');
  i.set_integer('id', 2617627);
  i.set_boolean('active', false);
  insert into tst_events$tab values(i);
  commit;
end

пробую получить доступ к вложенным коллекциям:

Code: Select all

    try
      OraCon.Connect;
      Qry := TOraQuery.Create(OraCon);
      Qry.Session := OraCon;
      Qry.SQL.Text := 'select event from tst_events$tab';
      Qry.ObjectView := True;
      Qry.Open;

      OraObj := Qry.GetObject('event');
      if assigned(OraObj) then
       begin
         Writeln(OraObj.AttrAsString['SYSTEM']);
         Writeln(OraObj.ObjectType.Name);
         OraMsg := OraObj.AttrAsObject['MESSAGE'];
         Writeln(OraMsg.ObjectType.Name);

         OraArr := OraMsg.AttrAsArray['PROPERTY'];
         Writeln(OraArr.ObjectType.Name);
         Writeln(OraArr.Size); -- Access Violation

         OraHdr := OraObj.AttrAsObject['HEADER'];
         OraArr := OraHdr.AttrAsArray['PROPERTY'];
         Writeln(OraArr.ItemAsObject[0].AttrAsString['name']);
         Writeln(OraArr.Size); -- 3 ???? а должно быть 0 или ошибка, т.к. коллекция не существует
       end;
    finally
      OraCon.Free;
    end;

мало того что при обращении к message.property.size получаю access violation, так еще выясняется что перепутаны местами объекты header и message внутри.
Это как так?

P.S. версия ODAC 10.1.3

MaximG · Post by **MaximG** » Thu 15 Nov 2018 15:45

Please describe the issue in more detail. Which operation mode of ODAC you are using: OCI Mode or Direct Mode ?
When compiling for which platform (Win32, Win64, etc.) do the described errors occur? Is the issue reproduced on the latest version of our product 10.2.7 ? Please send us the full source code of the sample that reproduces the issue. It's convenient to do via the e-support form (https://www.devart.com/company/contactform.html).
Please write your questions in English.

Devart Forums

Access Violation in OraObject

Access Violation in OraObject

Re: Access Violation in OraObject