Code: Select all
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;
Это как так?
P.S. версия ODAC 10.1.3