====== Хватки и трикове със скриптове ======
В тази секция се намират готови парчета код, които често се използват в скриптовете.
===== Изтегляне на преводи на полета от източника =====
execute block (
DATASOURCE_ID DM_REF = :__DATASOURCE_ID
)
returns (
test_1$1 dm_Str1024,
test_1$2 dm_Str1024,
test_2$1 dm_Str1024,
test_2$2 dm_Str1024
)
as
declare variable lang_1 DM_ISO_LANG;
declare variable lang_2 DM_ISO_LANG;
declare variable temp_text DM_STR1024;
declare variable temp_id DM_REF;
declare variable temp_lang DM_ISO_LANG;
begin
------- ЗАРЕЖДАНЕ НА ПРЕВОДИ --------------
LANG_1=null; -- LANG_1 в config е not null, така че тук инициализацията е само за красота
LANG_2=null;
select c.DEFAULT_LANG_ISO, c.SECONDARY_LANG_ISO
from config c
into :LANG_1, :LANG_2;
-- понеже може да има много преводи, а щом ги има, значи в скрипта ще се ползват всичките,
-- с долния цикъл ги взимаме наведнъж само с едно минаване
-- естествено, трябва да има декларирани променливи за всеки превод, за всеки език.
for
select substring(s.TEXT from 1 for 200), -- взимането само на първите 200 символа е само за демо - да се смени на каквото е нужно, ако полето, за което ще се ползва превода е по-късо
s.TRANSLATION_ID, s.LANG_ISO
from SYS$ACTION_DS_TRANSLATIONS s
where s.DATASOURCE_REF=:DATASOURCE_ID -- цялото демо е заради този ред - в datasource_id СМЕРП автоматично ще
-- постави ИД-то на източника, който е изпълнил (като уловката е, че горе в декларацията
-- променливата е с име __DATASOURCE_ID, това е важно; локалната променлива е без __, защото
-- firebird не дава
into :temp_text, :temp_id, :TEMP_LANG
do
begin
if ((:temp_id=1) and (:temp_lang=:LANG_1)) then TEST_1$1=:TEMP_TEXT; else
if ((:temp_id=1) and (:temp_lang=:LANG_2)) then TEST_1$2=coalesce(:TEMP_TEXT, TEST_1$1); else -- обикновено ако няма превод за допълнителния език по този начин се връща като превод първия език
--
if ((:temp_id=2) and (:temp_lang=:LANG_1)) then TEST_2$1=:TEMP_TEXT; else
if ((:temp_id=2) and (:temp_lang=:LANG_2)) then TEST_2$2=:TEMP_TEXT;
end
suspend;
end
===== Изтегляне на информация от данните на справка чрез последващ скрипт =====
--
----- ЗАРЕЖДАНЕ НА ДАННИТЕ ОТ ПРЕДНАТА СПРАВКА -----
--
if (__dbResult is not null) then
begin
-- CORRECTION OF DECIMAL SEPARATOR
d = 1/2;
s = '' || d;
DSEP = ibec_Copy(s, 2, 1);
CORRECT_FLOAT_NUMBER = 'execute ibeblock
(
NUM varchar(1000),
DEC_SEP varchar(5)
)
returns
(
RES varchar(1000)
)
as
begin
RES = NUM;
if (NUM is not null) then
begin
RES = ibec_StringReplace(RES, '','', DEC_SEP, __rfReplaceAll);
RES = ibec_StringReplace(RES, ''.'', DEC_SEP, __rfReplaceAll);
end;
end';
-- DECIMAL SEPARATOR CORRECTION END
if (c_debug=1) then
begin
s = __dbResult; ibec_InputQuery('__dbResult', '__dbResult', s);
end;
xmlfile = __dbResult;
STMT = 'select first 0 ';
xml = ibec_msxml_Create();
i = 0;
try
ibec_msxml_Load(xml, xmlfile);
nodes = ibec_msxml_SelectNodes(xml, 'DATAPACKET/METADATA/FIELDS/FIELD');
SEP = '';
foreach (nodes as node key i skip nulls) do
begin
sfieldname = ibec_msxml_GetAttribute(node, 'fieldname');
sattrname = ibec_msxml_GetAttribute(node, 'attrname');
sfieldtype = ibec_msxml_GetAttribute(node, 'fieldtype');
sWIDTH = ibec_msxml_GetAttribute(node, 'WIDTH');
myfields[i] = sattrname;
myfieldtypes[i] = sfieldtype;
AR_ALLF[i] = 0;
STMT = STMT || SEP || ' cast(null as ';
if ((sfieldtype = 'string') or (sfieldtype = 'string.uni')) then
STMT = STMT || 'VARCHAR(' || coalesce(sWIDTH, '20') || ')) COLLATE UNICODE_CI';
else
if (sfieldtype = 'i2') then
STMT = STMT || 'SMALLINT)';
else
if (sfieldtype = 'i4') then
STMT = STMT || 'INT)';
else
if (sfieldtype = 'i8') then
STMT = STMT || 'BIGINT)';
else
if (sfieldtype = 'r8') then
STMT = STMT || 'DOUBLE PRECISION)';
else
if (sfieldtype = 'date') then
STMT = STMT || 'DATE)';
else
if (sfieldtype = 'time') then
STMT = STMT || 'TIME)';
else
if (sfieldtype = 'dateTime') then
STMT = STMT || 'TIMESTAMP)';
if (sfieldname is not null) then
STMT = STMT || ' as ' || sfieldname;
else
begin
STMT = STMT || ' as ' || sattrname;
sfieldname = sattrname;
end
SEP = ',';
end
STMT = STMT || ' from CONFIG';
execute statement STMT as dataset ds_data;
j = ibec_High(myfields);
nodes = ibec_msxml_SelectNodes(xml, 'DATAPACKET/ROWDATA/ROW');
foreach (nodes as node skip nulls) do
begin
ibec_ds_Append(ds_data);
for i = 0 to j do
begin
st = myfieldtypes[i];
s = myfields[i];
val = ibec_msxml_GetAttribute(node, s);
if (val is not null) then
begin
if (st = 'date') then
begin
y = ibec_Copy(val, 1, 4);
m = ibec_Copy(val, 5, 2);
d = ibec_Copy(val, 7, 2);
val = ibec_EncodeDate(y, m, d);
end;
else
if (st = 'time') then
begin
val = ibec_Copy(val, 1, 8);
end;
else
if (st = 'dateTime') then
begin
y = ibec_Copy(val, 1, 4);
m = ibec_Copy(val, 5, 2);
d = ibec_Copy(val, 7, 2);
tm = ibec_Copy(val, 10, 8);
val = ibec_EncodeDate(y, m, d) || ' ' || tm;
end;
else
if (st = 'r8') then
begin
execute ibeblock CORRECT_FLOAT_NUMBER (:val, :DSEP) RETURNING_VALUES :val;
end;
end
if (val is not null) then
ibec_ds_SetField(ds_data, i, val);
end;
ibec_ds_Post(ds_data);
end
finally
ibec_msxml_Free(xml);
end;
end; -- __dbResult is not null
--
----- КРАЙ ЗАРЕЖДАНЕ НА ДАННИТЕ ОТ ПРЕДНАТА СПРАВКА -----
--
===== Изтегляне на информация от филтрите на справка чрез последващ скрипт =====
execute ibeblock
(
__dbFilters varchar(250),
__dbFilterValues varchar(250),
NEW_CLIENT integer,
CLIENT_ID_FIELD_NAME varchar(50)
)
as
begin
C_DEBUG = 0;
if ((__dbFilters is not null) and (__dbFilterValues is not null)) then
begin
-- ПАРСВАНЕ НА ФИЛТРИТЕ НА ИЗВИКВАЩАТА СПРАВКА, ЗА ДА МОЖЕ ОТ ТЯХ ДА СЕ ИЗТЕГЛЯТ
-- ДЕФАУЛТИ ПРИ СЪЗДАВАНЕТО НА НОВ КОНТРАГЕНТ
if (C_DEBUG = 1) then
begin
s = __dbFilters; ibec_InputQuery('a', 'FILTERS', s);
s = __dbFilterValues; ibec_InputQuery('a', 'FILTER VALUES', s);
end;
xmlfile = __dbFilters;
STMT = 'select first 0 ';
xml = ibec_msxml_Create();
i = 0;
try
ibec_msxml_Load(xml, xmlfile);
nodes = ibec_msxml_SelectNodes(xml, 'DATAPACKET/METADATA/FIELDS/FIELD');
SEP = '';
foreach (nodes as node key i skip nulls) do
begin
sfieldname = ibec_msxml_GetAttribute(node, 'fieldname');
sattrname = ibec_msxml_GetAttribute(node, 'attrname');
sfieldtype = ibec_msxml_GetAttribute(node, 'fieldtype');
sWIDTH = ibec_msxml_GetAttribute(node, 'WIDTH');
myfields[i] = sattrname;
myfieldtypes[i] = sfieldtype;
STMT = STMT || SEP || ' cast(null as ';
if ((sfieldtype = 'string') or (sfieldtype = 'string.uni')) then
STMT = STMT || 'VARCHAR(' || coalesce(sWIDTH, '20') || ')) COLLATE UNICODE_CI';
else if (sfieldtype = 'i2') then
STMT = STMT || 'SMALLINT)';
else if (sfieldtype = 'i4') then
STMT = STMT || 'INT)';
else if (sfieldtype = 'i8') then
STMT = STMT || 'BIGINT)';
else if (sfieldtype = 'r8') then
STMT = STMT || 'DOUBLE PRECISION)';
else if (sfieldtype = 'date') then
STMT = STMT || 'DATE)';
else if (sfieldtype = 'time') then
STMT = STMT || 'TIME)';
else if (sfieldtype = 'dateTime') then
STMT = STMT || 'TIMESTAMP)';
else if (sfieldtype = 'boolean') then
STMT = STMT || 'varchar(10))';
if (sfieldname is not null) then
STMT = STMT || ' as ' || sfieldname;
else
STMT = STMT || ' as ' || sattrname;
SEP = ',';
end
STMT = STMT || ' from CONFIG';
execute statement STMT as dataset DS;
j = ibec_High(myfields);
nodes = ibec_msxml_SelectNodes(xml, 'DATAPACKET/ROWDATA/ROW');
foreach (nodes as node skip nulls) do
begin
ibec_ds_Append(DS);
for i = 0 to j do
begin
st = myfieldtypes[i];
s = myfields[i];
val = ibec_msxml_GetAttribute(node, s);
if (val is not null) then
begin
if (st = 'date') then
begin
y = ibec_Copy(val, 1, 4);
m = ibec_Copy(val, 5, 2);
d = ibec_Copy(val, 7, 2);
val = ibec_EncodeDate(y, m, d);
end;
else if (st = 'time') then
begin
val = ibec_Copy(val, 1, 8) ;--|| '.' || ibec_Copy(val, 9, 3);
end;
else if (st = 'dateTime') then
begin
y = ibec_Copy(val, 1, 4);
m = ibec_Copy(val, 5, 2);
d = ibec_Copy(val, 7, 2);
tm = ibec_Copy(val, 10, 8) ;--|| '.' || ibec_Copy(val, 18, 3);
val = ibec_EncodeDate(y, m, d) || ' ' || tm;
-- val = val || tm;
end;
end
ibec_ds_SetField(DS, i, val);
end;
ibec_ds_Post(DS);
end
SEL_COUNT = 0;
finally
ibec_msxml_Free(xml);
end;
ibec_SetLength(myfields, 0);
xmlfile = __dbFilterValues;
STMT = 'select first 0 ';
xml = ibec_msxml_Create();
i = 0;
try
ibec_msxml_Load(xml, xmlfile);
nodes = ibec_msxml_SelectNodes(xml, 'DATAPACKET/METADATA/FIELDS/FIELD');
SEP = '';
foreach (nodes as node key i skip nulls) do
begin
sfieldname = ibec_msxml_GetAttribute(node, 'fieldname');
sattrname = ibec_msxml_GetAttribute(node, 'attrname');
sfieldtype = ibec_msxml_GetAttribute(node, 'fieldtype');
sWIDTH = ibec_msxml_GetAttribute(node, 'WIDTH');
myfields[i] = sattrname;
myfieldtypes[i] = sfieldtype;
STMT = STMT || SEP || ' cast(null as ';
if ((sfieldtype = 'string') or (sfieldtype = 'string.uni')) then
STMT = STMT || 'VARCHAR(' || coalesce(sWIDTH, '20') || ')) COLLATE UNICODE_CI';
else if (sfieldtype = 'i2') then
STMT = STMT || 'SMALLINT)';
else if (sfieldtype = 'i4') then
STMT = STMT || 'INT)';
else if (sfieldtype = 'i8') then
STMT = STMT || 'BIGINT)';
else if (sfieldtype = 'r8') then
STMT = STMT || 'DOUBLE PRECISION)';
else if (sfieldtype = 'date') then
STMT = STMT || 'DATE)';
else if (sfieldtype = 'time') then
STMT = STMT || 'TIME)';
else if (sfieldtype = 'dateTime') then
STMT = STMT || 'TIMESTAMP)';
if (sfieldname is not null) then
STMT = STMT || ' as ' || sfieldname;
else
STMT = STMT || ' as ' || sattrname;
SEP = ',';
end
STMT = STMT || ' from CONFIG';
execute statement STMT as dataset DS2;
j = ibec_High(myfields);
nodes = ibec_msxml_SelectNodes(xml, 'DATAPACKET/ROWDATA/ROW');
foreach (nodes as node skip nulls) do
begin
ibec_ds_Append(DS2);
for i = 0 to j do
begin
st = myfieldtypes[i];
s = myfields[i];
val = ibec_msxml_GetAttribute(node, s);
if (val is not null) then
begin
if (st = 'date') then
begin
y = ibec_Copy(val, 1, 4);
m = ibec_Copy(val, 5, 2);
d = ibec_Copy(val, 7, 2);
val = ibec_EncodeDate(y, m, d);
end;
else if (st = 'time') then
begin
val = ibec_Copy(val, 1, 8) ;--|| '.' || ibec_Copy(val, 9, 3);
end;
else if (st = 'dateTime') then
begin
y = ibec_Copy(val, 1, 4);
m = ibec_Copy(val, 5, 2);
d = ibec_Copy(val, 7, 2);
tm = ibec_Copy(val, 10, 8) ;--|| '.' || ibec_Copy(val, 18, 3);
val = ibec_EncodeDate(y, m, d) || ' ' || tm;
-- val = val || tm;
end;
end
ibec_ds_SetField(DS2, i, val);
end;
ibec_ds_Post(DS2);
end
finally
ibec_msxml_Free(xml);
end;
end -- Край на парсването
CLIENT_ID_ = null;
if (ibec_ds_Locate(DS, 'NAME', CLIENT_ID_FIELD_NAME, 0)) then
begin
ID = ibec_ds_GetField(DS, 'ID');
if (ID is not null) then
begin
if (ibec_ds_Locate(DS2, 'DATASOURCE_PARAM_REF', :ID, 0)) then
begin
CLIENT_ID_ = ibec_ds_GetField(DS2, 'VALUE_INT');
end;
end;
end;
STATE_ID_ = null;
if (ibec_ds_Locate(DS, 'NAME', 'STATE_ID', 0)) then
begin
ID = ibec_ds_GetField(DS, 'ID');
if (ID is not null) then
begin
if (ibec_ds_Locate(DS2, 'DATASOURCE_PARAM_REF', :ID, 0)) then
begin
STATE_ID_ = ibec_ds_GetField(DS2, 'VALUE_TEXT');
end;
end;
end;
NAME_ = null;
if (ibec_ds_Locate(DS, 'NAME', 'ENTITY_NAME', 0)) then
begin
ID = ibec_ds_GetField(DS, 'ID');
if (ID is not null) then
begin
if (ibec_ds_Locate(DS2, 'DATASOURCE_PARAM_REF', :ID, 0)) then
begin
NAME_ = ibec_ds_GetField(DS2, 'VALUE_TEXT');
end;
end;
end;
end;
===== търсене в скриптове =====
select ibs.ibe$script_name from ibe$scripts ibs where ibs.ibe$script_source containing '_CMB_'
into :script_name;
===== път до базата данни =====
SELECT RDB$GET_CONTEXT('SYSTEM', 'DB_NAME') FROM RDB$DATABASE
===== следващ номер на документ =====
SELECT ID, COM_ID
FROM sys$get_generator('wrh$docs_gen')
INTO :ID, :COM_ID;
===== текущ десетичен разделител =====
D = 1/2;
S = ''||:D;
DSep = ibec_copy(:S, 2, 1);
===== коректен десет. разделител =====
your_decimal_num = '0.01';
sx = ''||:your_decimal_num;
sx = ibec_StringReplace(sx,'.',:DSep,__rfReplaceAll);
sx = ibec_StringReplace(sx,',',:DSep,__rfReplaceAll);
your_decimal_num = :sx;
===== текущ разделител на дата =====
S = ''||ibec_Date();
re = ibec_re_Create('[^0-9]');
IF (ibec_re_Exec(re, :S)) THEN
DTSep = ibec_re_Match(re, 0);
ELSE
DTSep = '.';
===== празен Dataset =====
SELECT FIRST 0
CAST(NULL AS VARCHAR(32)) FIELD_STR,
CAST(NULL AS INTEGER) FIELD_INT,
CAST(NULL AS DOUBLE PRECISION) FIELD_FLOAT
FROM RDB$DATABASE D
AS DATASET DS;
===== конвертиране на кирилица в уникод =====
Използва се DFM файловете на Delphi.\\
Налага се при динамично създаване на настройките на caption-ните в грида в Custom справките.
get_caption = '
execute
ibeblock (my_cyr_text varchar(2000))
returns (my_unicode_cyr_text varchar(10000))
as
begin
i = 0;
ss = :my_cyr_text;
lcc = 0;
s1 = '''';
jj = ibec_length(ss);
while (i < jj) do
begin
i = i + 1;
c = ibec_copy(ss, i, 1);
if (c = '''''''' ) then
begin
s1 = :s1 || ''#39'';
continue;
end;
z = 0;
if (ibec_ord(c) > 191) then z = ibec_ord(c) + 848;
lc = ibec_copy(s1, ibec_length(s1), 1);
if (z = 0) then
begin
if (lc = '''''''') then s1 = ibec_copy(s1, 1, ibec_length(s1) - 1) || :c || '''''''';
else s1 = s1 || '''''''' || :c || '''''''';
end;
else s1 = :s1 || ''#'' || :z;
end;
my_unicode_cyr_text = s1;
end';
Използва се по следния начин:\\ \\
Горният блок се поставя в началото на нашия скрипт, обикновено веднага след XML частта.\\
На подходящо място в тялото на скрипта, се извиква за да конвертира низовете за caption-ните.\\ \\
S = :locaTionName||'|Посл. доставка|Дата';\\
execute ibeblock get_caption(:S) RETURNING_VALUES S1;\\
locationLastShipTitleConv = S1;\\ \\
След това, променливата locationLastShipTitleConv се поставя като caption на съответната колона в настройките на грида.
item
EditButtons = <>
FieldName = '''||'location'||:location||'LastShipp'||'''
EditButtons = <>
Footers = <>
ReadOnly = True
Title.Caption = '||:locationLastShipTitleConv||'
end
===== валиден e-mail адрес =====
Retrieve all valid e-mail addresses from an input text
This IBEBlock retrieves all valid e-mail addresses from an input text (any_text):
any_text = 'This text containing one email address - demomail@demodomain.com and
any text after email...and second email addres demo2@domain2.com and this any text....';
allemails = '';
RegExp = ibec_re_Create('[_a-zA-Z\d\-\.]+@[_a-zA-Z\d\-]+(\.[_a-zA-Z\d\-]+)+');
try
Res = ibec_re_Exec(RegExp, :any_text);
while (Res) do
begin
email = ibec_re_Match(RegExp, 0);
allemails = :allemails || :email ||',';
Res = ibec_re_ExecNext(RegExp);
end
RegExpRepl = ibec_re_Create('@(.*?)\.');
Ss = ibec_re_Replace(RegExpRepl, :any_text, '@hidden_domain.');
finally
ibec_re_Free(RegExp);
end;
===== connect oracle =====
*execute ibeblock
as
begin
-- CONNECTORACLE = 'DRIVER=Oracle In OraHome92; Server=172.20.1.41; '||
-- 'dbq=GMP.Germanos.bg;UID=INFOPLUS; PWD=3INFO5PLUS2;';
CONNECTORACLE = 'DRIVER=Oracle In OraClient11g_home1; Server=192.168.0.13; '||
'dbq= oralocal;UID=PUBLIC_MLR; PWD=PUBLIC123;';
cn = ibec_CreateConnection(__ctODBC,CONNECTORACLE);
ibec_UseConnection(cn);
execute statement 'SELECT * FROM multirama.zbg_public_material_v;' AS DATASET DS;
ibec_ds_Export(DS,__etHTML, 'c:\test.HTML' ,'Encoding=windows-1251; MemoAsText; StringAsText; DateTimeAsText');
end
===== словом =====
IN_WORDS = '
execute ibeblock
(
aNumber DOUBLE PRECISION
)
RETURNS
(
inWords VARCHAR (5000)
)
as
begin
Triades = ibec_Array('''', ''хиляд'', ''милион'', ''милиард'', ''билион'', ''трилион'', ''квадралион'');
Digits = ibec_Array('''', ''един'', ''два'', ''три'', ''четири'', ''пет'', ''шест'', ''седем'', ''осем'', ''девет'');
aNumber1 = abs(aNumber);
aNumber1 = ibec_FormatFloat(''0.00'', aNumber1);
ss = ''лв. и '' || ibec_Copy(aNumber1, ibec_Length(aNumber1) - 1, 1) || ibec_Copy(aNumber1, ibec_Length(aNumber1),1) || '' ст.'';
sss = ibec_Copy(aNumber1, 1, ibec_Length(aNumber1) - 3);
if (sss = ''0'') then
st=''нула '';
else
begin
st = '''';
k = ibec_div((ibec_Length(sss) - 1), 3) + 1;
for i = 1 to k do
begin
s1 = '''';
s2 = '''';
s3 = '''';
s4 = '''';
for j = 1 to 3 do
if (ibec_Length(sss) > 0) then
begin
s1 = ibec_Copy(sss, ibec_length(sss), 1) || s1;
sss = ibec_Copy(sss, 1, ibec_Length(sss) - 1);
end;
ch = ibec_copy(s1,1,1);
while ( (ch = ''0'') and (ibec_length(s1) > 0) ) do
begin
s1 = ibec_Copy(s1, 2, ibec_Length(s1) - 1);
ch = ibec_copy(s1, 1, 1);
end
if (ibec_length(s1) = 1) then
begin
ch = ibec_Copy(s1, ibec_Length(s1), 1);
s2 = Digits[ibec_Ord(ch) - 48];
end;
if (ibec_length(s1) > 1) then
begin
ch = ibec_Copy(s1, ibec_Length(s1) - 1, 1);
if (ch = ''1'') then
begin
ch = ibec_Copy(s1, ibec_Length(s1), 1);
if (ch = ''0'') then
s2 = '''';
else if (ch = ''1'') then
s2 = ''едина'';
else
begin
ch = ibec_Copy(s1, ibec_Length(s1), 1);
s2 = Digits[ibec_Ord(ch) - 48] || ''на'';
end;
end
else
begin
ch = ibec_Copy(s1, ibec_Length(s1) - 1, 1);
s2 = Digits[ibec_Ord(ch) - 48];
end;
ch = ibec_Copy(s1, ibec_Length(s1) - 1, 1);
if (ch <> ''0'') then
s2 = s2 || ''десет'';
ch2 = ibec_Copy(s1, ibec_Length(s1), 1);
if ( (ch <> ''1'') and (ch2 <> ''0'') ) then
begin
s2 = s2 || '' и '' || Digits[ibec_Ord(ch2) - 48];
end
end;
if ( ibec_length(s1) = 3 ) then
begin
ch = ibec_Copy(s1, 1, 1);
if (ch = ''1'') then
s4 = ''сто'';
else if (ch = ''2'') then
s4 = ''двеста'';
else if (ch = ''3'') then
s4 = ''триста'';
else
s4 = Digits[ibec_Ord(ch) - 48] || ''стотин'';
ch = ibec_copy(s1, 2, 2);
if ( (ch <> ''00'') and (ibec_pos('' и '', s2) = 0) ) then
s2 = s4 || '' и '' || s2;
else
s2 = s4 || '' '' || s2;
end;
ch = ibec_copy(s1, 2, 2);
if (
((i = 1) and (k > 1) and (s1 <> '''')) and
( ((ibec_length(s1) = 3) and (ch = ''00'')) or (ibec_pos('' и '', s2) = 0) )
) then
s2 = '' и '' || s2;
if ( (i > 1) and (s1 <> '''')) then
begin
s3 = Triades[i-1] || '' '';
if (i = 2) then
begin
if (s1 = ''1'') then
begin
s2 = '''';
s3 = Triades[i-1] || ''а'';
end;
else
begin
s3 = Triades[i-1] || ''и'';
ch = ibec_copy(s2, ibec_length(s2) - 2, 3);
if (ch = Digits[2]) then
begin
str1 = ibec_Copy(s2, 1, ibec_Length(s2) - 1);
s2 = str1 || ''е'';
end
end;
end;
if ( (i > 2) and (s1 = ''1'') ) then
begin
ch = ibec_Copy(s3, 1, 1);
s3 = ibec_Copy(s3, 2, ibec_Length(s3) - 1);
ch = ibec_Ord(ch);
s3 = ibec_Chr(ch) || s3;
end;
end;
st = s2 || '' '' || s3 || '' '' || st;
end;
end;
ss = st || ss;
if (aNumber < 0) then
ss = ''минус '' || ss;
ss = ibec_StringReplace(ss, '' '', '' '', __rfReplaceAll);
ch = ibec_Copy(ss,ibec_Length(ss),1);
if (ch = '' '') then
ss = ibec_Copy(ss, 1, ibec_Length(ss) - 1);
ch = ibec_Copy(ss, 1, 1);
if (ch = '' '') then
ss = ibec_Copy(ss, 2, ibec_Length(ss) - 1);
ch = ibec_Copy(ss, 1, 1);
ch = ibec_Chr(ibec_Ord(ch) - 32);
ss = ch || ibec_Copy(ss, 2, ibec_Length(ss) - 1);
inWords = ss;
end';
EXECUTE IBEBLOCK IN_WORDS(1235972.33) RETURNING_VALUES :S;
===== Проверка на тип на файл (UTF8 / ANSI) =====
Всички се сблъскваме с импорт все някога. При писане на скриптове е много гадно защото не можем да разпознаем файла дали е UTF8 или ANSI.
За тази цел преведохме фукнцията от Делфи, само че сме я написали за работа с файлове.
Ето как се използва:
execute ibeblock
as
begin
CHECK_FILE_UTF = 'execute ibeblock
(
AFILENAME varchar(255)
)
returns
(
FILETYPEUTF smallint
)
as
begin
-- FILETYPEUTF = 0 - ASCII, 1 - UTF
FILETYPEUTF = 0;
fs = ibec_fs_OpenFile(AFILENAME, __fmOpenRead);
if (fs is null) then
begin
ibec_MessageDlg(''Can not open file '', __mtInformation, __mbOK);
exit;
end
try
ibec_fs_Seek(fs, ibec_fs_Size(fs)-1024, 0);
while (not ibec_fs_Eof(fs)) do
begin
vByte = ibec_fs_ReadByte(fs);
if (vByte >= 128) then
break;
end;
if (not ibec_fs_Eof(fs)) then
begin
First_Time = 1;
while (not ibec_fs_Eof(fs)) do
begin
if (First_Time = 0) then
vByte = ibec_fs_ReadByte(fs);
First_Time = 0;
if (vByte between 0 and 127) then
begin
end
else if (vByte between 194 and 223) then
begin
if (ibec_fs_Eof(fs)) then exit;
vByte2 = ibec_fs_ReadByte(fs);
if ((vByte2 < 128) and (vByte2 > 277)) then exit;
end else if (vByte = 224) then
begin
if (ibec_fs_Eof(fs)) then exit;
vByte2 = ibec_fs_ReadByte(fs);
if (ibec_fs_Eof(fs)) then exit;
vByte3 = ibec_fs_ReadByte(fs);
if (not (vByte2 between 240 and 277)) then exit;
if (not (vByte3 between 128 and 277)) then exit;
end;
else if (vByte between 225 and 239) then
begin
if (ibec_fs_Eof(fs)) then exit;
vByte2 = ibec_fs_ReadByte(fs);
if (ibec_fs_Eof(fs)) then exit;
vByte3 = ibec_fs_ReadByte(fs);
if (not (vByte2 between 128 and 277)) then exit;
if (not (vByte3 between 128 and 277)) then exit;
end;
else if (vByte = 240) then
begin
if (ibec_fs_Eof(fs)) then exit;
vByte2 = ibec_fs_ReadByte(fs);
if (ibec_fs_Eof(fs)) then exit;
vByte3 = ibec_fs_ReadByte(fs);
if (ibec_fs_Eof(fs)) then exit;
vByte4 = ibec_fs_ReadByte(fs);
if (not (vByte2 between 220 and 277)) then exit;
if (not (vByte3 between 128 and 277)) then exit;
if (not (vByte4 between 128 and 277)) then exit;
end;
else if (vByte between 241 and 243) then
begin
if (ibec_fs_Eof(fs)) then exit;
vByte2 = ibec_fs_ReadByte(fs);
if (ibec_fs_Eof(fs)) then exit;
vByte3 = ibec_fs_ReadByte(fs);
if (ibec_fs_Eof(fs)) then exit;
vByte4 = ibec_fs_ReadByte(fs);
if (not (vByte2 between 128 and 277)) then exit;
if (not (vByte3 between 128 and 277)) then exit;
if (not (vByte4 between 128 and 277)) then exit;
end;
else
if (not ibec_fs_Eof(fs)) then exit;
end;
FILETYPEUTF = 1;
end;
finally
ibec_fs_CloseFile(fs);
end
end
';
Time1 = ibec_GetTickCount();
execute ibeblock CHECK_FILE_UTF('C:\temp\test.csv') returning_values :A1;
execute ibeblock CHECK_FILE_UTF('C:\temp\test_UTF_big.csv') returning_values :A2;
execute ibeblock CHECK_FILE_UTF('C:\temp\test_UTF.csv') returning_values :A1;
Time2 = ibec_GetTickCount();
sTime = ibec_div((Time2 - Time1), 1000) || '.' ||ibec_mod((Time2 - Time1), 1000);
ibec_ShowMessage('Total time spent: ' || sTime || ' seconds');
end
===== Връщане на данни от скрипт/справка =====
Имаме Търговски документ и искаме да използваме справка, която да върне максималното количество и цена.
С двоен клик искаме да върнем избраното от потребителя.
За да стане това, трябва да имаме в справката колона R_QTY1 (ако искаме да върнем в опаков. кол. 1) и PRICE_WO_VAT_BFR_DISCNT (цена). Може да добавяме и колони за %ТО и ....
Ако искаме да променяме текущият ред, то трябва да имаме и колона, която се нарича "LOCATE_ID" и в нея да поставим ID-то на реда.
--- Имаме заявка, която използваме да коригира текущ ред
select cast(:"dbDetail.ID" as bigint) as LOCATE_ID, cast(:ENTER_QTY1 as DM_FLOAT) as R_QTY1, cast(10 as dm_float) as PRICE_WO_VAT_BFR_DISCNT from rdb$database
--- Тази справка има 2 входни параметъра
-- при избор на прилагане избираме - в детайла
===== Онлайн справки =====
Текста на заявката се подава в STMT.
Connection string-а за връзка с отстрещната база: в Server_Connstr.
Подробна документация за синтаксиса на execute statement ... on external data source [[http://www.firebirdsql.org/refdocs/langrefupd25-psql-execstat.html|има тук]].
Tрябва непременно да се използва WITH AUTONOMOUS TRANSACTION, за да може след изпълнението на справката да се commit-не транзакцията на отсрещния сървер - в противен случай транзакцията остава отворена и заема памет (обикновено доста), докато не бъде затворена справката от потребителя.
execute statement STMT
WITH AUTONOMOUS TRANSACTION
ON EXTERNAL DATA SOURCE :SERVER_CONNSTR as USER 'sysdba' PASSWORD 'masterkey'
===== Изчисление на чексумата на EAN13 баркод =====
execute IBEBLOCK(BARCODE12 varchar(12) not null) returns(EAN13 varchar(13))
as declare variable SUM1 integer;
declare variable SUM2 integer;
declare variable I integer;
declare variable CHECKDIGIT integer;
begin
if (IBEC_LENGTH(BARCODE12) <> 12) then
exception GENERAL_DB_ERROR('Input barcode length must be exactly 12 digits!');
SUM1 = 0;
SUM2 = 0;
I = 2;
while (I <= 12) do
begin
SUM1 = SUM1 + cast(substring(BARCODE12 from I for 1) as integer);
I = I + 2;
end
SUM1 = SUM1 * 3;
I = 1;
while (I <= 11) do
begin
SUM2 = SUM2 + cast(substring(BARCODE12 from I for 1) as integer);
I = I + 2;
end
SUM2 = SUM1 + SUM2;
CHECKDIGIT = 10 - (IBEC_MOD(SUM2, 10));
if (CHECKDIGIT = 10) then
CHECKDIGIT = 0;
EAN13 = BARCODE12 || CHECKDIGIT;
suspend;
end;
===== Отваряне на файл с подразбиращата се програма асоциирана с разширението му =====
ibec_ShellExecute('open', 'c:\test.txt', '', '', 0);
===== Експорт на валидно CSV с кирилица, което да се отваря от Ексел 2016 (UTF8 BOM) =====
Ако трябва да се експортира CSV на кирилица в UTF8, Excel 2016 изисква файла да е кодиран като UTF8 със BOM.
Иска се първите три байта на експортирания файл да са EF BB BF, иначе Ексел 2016 (старите версии нямат проблем) при double click върху файл с разширение CSV НЕ се сеща, че той е кодиран в UTF8.
Детайлна информация за проблема има тук: http://stackoverflow.com/questions/2223882/whats-different-between-utf-8-and-utf-8-without-bom.
Т.е. програмно трябва да се прави така:
...
/* създаване на файла */
fhandle = ibec_fs_OpenFile(fName, __fmCreate);
if (fhandle is null) then
EXCEPTION CLEAN_TEXT_ERROR 'Не може да бъде създаден файл';
/* WRITE BOM HEADER - OR EXCEL WON'T BE HAPPY TO DECODE THE UTF8 IN CYRILLIC */
ibec_fs_WriteByte(fhandle , 0xEF);
ibec_fs_WriteByte(fhandle , 0xBB);
ibec_fs_WriteByte(fhandle , 0xBF);
/* пишем стандартно във файла, в случая с разделител таб */
row = 'Документ №'||tab||'Фактура №'||tab||'Дата'||tab||'Тип'||tab||'Обект'||tab||'Сума без ДДС';
ibec_fs_Writeln(fhandle , row);
/* затваряне на файла */
ibec_fs_CloseFile(fhandle);
Енкодинга може да се провери и конвертира и ако се отвори произволен файл с NotePad++ - в долния десен ъгъл Notepad++ показва дали файла е кодиран с BOM или без BOM. Смяната на енкодинга се извършва от меню ENCODING/ Encode in UTF8 wihtout BOM и Encoding/Encode in UTF8 (с BOM)
===== Сваляне на данни от MySQL (или всякаква друга). Генериране на Thumbnail (малка снимка) и зареждането ѝ =====
Използвайте долния код като пример как да:
* се свържете с база различна от Firebird (например MySQL, но може и със всякаква друга, която има ODBC драйвер) и да запишете резултата във Firebird база
* в конкретния пример, базата данни е хостната в SuperHosting. За да се осигури сигурна връзка Superhosting предлагат OpenVPN . На сървъра на СМЕРП, на който се пуска скрипта, е инсталиран OpenVPN клиент, с който е осигурен тунел до Superhosting, като mySQL базата се „вижда“ по локалното IP в тунела (примерно ip 10.1.2.3). За развойни нужди (първоначално писане на SQL заявките) и тестване, през този тунел с MySQL базата може да се осъществи достъп с инструмент от типа на mySqlWorkbench (нещо като ibexpert, но за MySQL).
* копирате от обща папка снимки по съответните директории (по артикули), така че да се закачат снимките правилно и да се регистрират описанията им
* от големи снимки да генерирате малки такива, подходящи за зареждане в поле "Малка снимка" вътре в базата
* ... за целта се използва малка command prompt програмка ConvertJPGToThumb, която обичайно не се разпространява със SelMatic ERP, но може да бъде предоставена от софтуерния отдел при поискване (проекта е в SimpleProjects папката)
* заредите малката снимка в базата данни (т.е. да заредите blob от файл през скрипт)
Кода по-долу е само за илюстративни нужди!
execute IBEBLOCK
(
__DATABASE dm_str255,
__USERNAME dm_str100,
__PASSWORD dm_str100,
do_categories smallint default 1,
do_product_images smallint default 1
)
as
begin
-- for debug purposes
if (__DATABASE is null) then
begin
__DATABASE='localhost:database';
__USERNAME='SYSDBA';
__PASSWORD='masterkey';
end
try
DB_WEB = IBEC_CREATECONNECTION(__CTODBC,
'DRIVER={MySQL ODBC 8.0 ANSI Driver};Server=10.1.2.3;Database=mySQLDatabaseName;Uid=db_user;Pwd=db_password;');
/* You must have an ODBC driver for the database. IBEC supports MySQL directly, too, but the above ODBC driver works just fine and is universal
The above MySQL driver is available at https://dev.mysql.com/downloads/connector/odbc/
*/
IBEC_USECONNECTION(DB_WEB);
if (do_categories=1) then
begin
stmt = 'select * from d4l_categories order by id';
execute statement STMT as dataset ds_categories;
num_categories=ibec_ds_RecordCount(ds_categories);
ibec_progress(num_categories||' categories downloaded...');
end
if (do_product_images=1) then
begin
stmt = 'select item_id, fname from d4l_images where `item_type`=''product'' order by `item_id`, `fname`';
execute statement STMT as dataset ds_images;
num_images=ibec_ds_RecordCount(ds_images);
ibec_progress(num_images||' photo links downloaded');
end
finally
if (DB_WEB is not null) then IBEC_CLOSECONNECTION(DB_WEB);
end
try
ibec_Progress('Connecting to SMERP database...');
DB_SMERP = ibec_CreateConnection(__ctFirebird, 'DBName="'||__DATABASE||'";
user='||__USERNAME||'; password='||__PASSWORD||'; names=UTF8; sqldialect=3');
IBEC_USECONNECTION(DB_SMERP);
if (do_categories=1) then
begin
ibec_Progress('Importing item groups/categories...');
ibec_ds_First(ds_categories);
while (not ibec_ds_eof(ds_categories)) do
begin
-- get values from the dataset
id=ibec_ds_GetField(ds_categories, 'id');
name=ibec_ds_GetField(ds_categories, 'name');
name=ibec_AnsiStringToUTF8(name);
parent=ibec_ds_GetField(ds_categories, 'parent');
meta_title=ibec_ds_GetField(ds_categories, 'meta_title');
meta_title=ibec_AnsiStringToUTF8(meta_title);
meta_desc=ibec_ds_GetField(ds_categories, 'meta_desc');
meta_desc=ibec_AnsiStringToUTF8(meta_desc);
meta_keywords=ibec_ds_GetField(ds_categories, 'meta_keywords');
meta_keywords=ibec_AnsiStringToUTF8(meta_keywords);
category_text=ibec_ds_GetField(ds_categories, 'category_text');
if (category_text is not null) then
begin
category_text=ibec_Copy(category_text, 1, 200);
category_text=ibec_AnsiStringToUTF8(category_text);
end;
status=ibec_ds_GetField(ds_categories, 'status'); -- CATEGORY_STATUS
position_order=ibec_ds_GetField(ds_categories, 'position'); -- ORDER_BY
/* Do something with these values in the Firebird database. The exact code here is irrelevant, it is just a sample */
update or insert into nom$item_Groups(id, com_id, item_group_name$1, item_group_parent_ref)
values (:id, 0, :name, :parent);
update or insert into nom$item_categories(id, com_id, category_name$1, category_parent_ref, CATEGORY_NAME_LONG$1, CATEGORY_STATUS, ORDER_BY)
values (:id, 0, :name, :parent, :category_text, :status, :position_order);
-- META_TITLE
update or insert into NOM$ITEM_CATEGORY_DESCRIPTIONS (ID, COM_ID, NOM$ITEM_CATEGORY_REF, CATEGORY_DESCRIPTION,
CATEGORY_DESCRIPTION_TYPE_REF, LANG_ISO)
values (:ID*10+1, 0, :id, :meta_title, 1, 'BG');
-- META_DESC
update or insert into NOM$ITEM_CATEGORY_DESCRIPTIONS (ID, COM_ID, NOM$ITEM_CATEGORY_REF, CATEGORY_DESCRIPTION,
CATEGORY_DESCRIPTION_TYPE_REF, LANG_ISO)
values (:ID*10+2, 0, :id, :meta_desc, 2, 'BG');
-- META_KEYWORDS
update or insert into NOM$ITEM_CATEGORY_DESCRIPTIONS (ID, COM_ID, NOM$ITEM_CATEGORY_REF, CATEGORY_DESCRIPTION,
CATEGORY_DESCRIPTION_TYPE_REF, LANG_ISO)
values (:ID*10+3, 0, :id, :meta_keywords, 3, 'BG');
ibec_ds_Next(ds_categories);
end
end -- DO_CATEGORIES
if (DO_PRODUCT_IMAGES=1) then
begin
ibec_ds_First(ds_images);
const_ImagesRoot='d:\images\';
const_SelMaticRoot = 'D:\SMERP_ATTACHMENTS\NomItems\Photos\';
cnt=0;
while (not ibec_ds_eof(ds_images)) do
begin
cnt=cnt+1;
if (ibec_mod(cnt, 100)=0) then
ibec_progress('Copying image '||cnt||' of '||num_images||'...');
product_id=ibec_ds_GetField(ds_images, 'item_id');
fname=ibec_ds_GetField(ds_images, 'fname');
fname=ibec_AnsiStringToUTF8(fname);
-- Find the SMERP item ref
item_ref=null;
select i.id, i.item_additional_name$1, iif(i.item_thumbnail is null, 1, 0)
from items i
where i.item_code2=:product_id
into :item_ref, :item_additional_name$1, :thumbnail_is_null;
if ((item_ref is not null) and ibec_FileExists(const_ImagesRoot||fname)) then
begin
if (not ibec_DirectoryExists(const_SelMaticRoot||item_ref)) then
ibec_ForceDirectories(const_SelMaticRoot||item_ref);
main_photo=const_SelMaticRoot||item_ref||'\'||item_ref||'.jpg';
if (ibec_FileExists(main_photo)) then -- main photo exists, just copy the rest
begin
SM_Photo_FName=const_SelMaticRoot||item_ref||'\'||fname;
MainPhoto=False;
end;
else
begin
SM_Photo_FName=main_photo;
MainPhoto=True;
end
ibec_CopyFile(const_ImagesRoot||fname, SM_Photo_FName, false);
if (MainPhoto) then
begin
-- and also load is as a thumbnail
thumb_fname=const_SelMaticRoot||item_ref||'\thumb_'||item_ref||'.jpg';
ibec_Exec('D:\SelmaticERP\App\Tools\ConvertJpgToThumb\ConvertJPGToThumb.exe '||SM_Photo_FName||' '||thumb_fname||' 100', '', null);
-- ibec_exec will wait until the execution of the above program finishes
if (ibec_fileexists(thumb_fname)) then
begin
-- load the thumbnail in the database
Image = ibec_loadfromfile(thumb_fname);
UPDATE items i
set item_thumbnail = :Image
where id=:item_ref;
ibec_DeleteFile(thumb_fname);
end
end;
-- REGISTER the photo
fname='\'||ibec_ExtractFileName(SM_Photo_FName);
update or insert into NOM$ATTACH_DESCRIPTIONS (CLASS_NAME, OBJECT_ID, FILE_NAME, FILE_DESCRIPTION$1, ATTACH_TYPE)
values ('NomItems', :ITEM_REF, :fname, :item_additional_name$1, 2)
matching (CLASS_NAME, OBJECT_ID, FILE_NAME);
end -- item_ref is not null
ibec_ds_Next(ds_images);
end
end -- DO_product_images
ibec_progress('fix generators...');
execute procedure sys$fix_generators;
commit;
finally
if (DB_SMERP is not null) then IBEC_CLOSECONNECTION(DB_SMERP);
end
end
===== Преоразмеряване на изображение в JPG формат =====
Налице е функция, с помощта на която можем да преоразмеряваме бързо и лесно изображения. Важно е да се знае, че функционалността работи за преоразмеряване само на изображения, на които текущия формат е "**.jpg**".
Другото удобно е, че преоразмерения файл може да бъде записан в различен формат от първоначалния, например BMP, PNG, GIF. Така с една и съща функция можем да променим формат и размер на дадено изображение.
Функцията представлява следното: \\
**ibec_Progress('RESIZE_JPG?From_File_Name?To_File_Name?Size');**
Пример: **ibec_Progress('RESIZE_JPG?C:\Pictures\home.jpg?C:\Pictures\newhome.png?1500');**
Започва с **ibec_Progress** и в скоби и апострофчета извикваме първо **RESIZE_JPG**. След това разделени с въпросителни символи следва локацията на изображението, което искаме да преоразмерим, последвано от директория, където създаваме новото изображение, като записваме и името на изображението последвано от желания формат. Накрая записваме и число от 1 до 9999 като желан размер за новото изображение и след това затваряме апостофчето и скобата.
Ето, как би изглеждало това в скрипт:
execute ibeblock
(
AFromFile varchar(255),
AToFile varchar(255),
ASize int,
WANT_ERROR smallint
)
as
begin
if (AFromFile is null) then AFromFile = '';
if (AToFile is null) then AToFile = '';
if (ASize is null) then ASize = 0;
if (WANT_ERROR is null) then WANT_ERROR = 0;
AToFile = ibec_Trim(AToFile);
ibec_Progress('RESIZE_JPG?' || AFromFile || '?' || AToFile || '?' || ASize);
end
Тук се вижда още един начин, по който можем да изпълним функцията като сме заложили в променливи стойностите за директория на старото изображение, директория на новото изображение и размера. В променливите лесно можем да зададем желаните стойности и след това функцията изглежда точно както първоначално я разгледахме.
По същия начин може да се изпълни и в **“udsblock”** като само променим в горния пример **“execute ibeblock”** с **“execute udsblock”**.
===== Промяна формата на текстов документ от .XLS(.XLSX) в .CSV =====
Използва се следната функция:
**ibec_Progress('XLS_TO_CSV?From_File_Name?To_File_Name')**
като FROM_FILE_NAME се заменя с адреса на директорията на самия файл с наименованието му и формат, а TO_FILE_NAME се заменя със директорията, в която искаме да създадем новия файл (може да допълним и име на новия файл, но ако не го направим създава новия файл с името на стария).
Важно е, че функцията работи за промяна на документи само в формат **.XLS** или **.XLSX**. Новия файл винаги ще бъде във **.CSV** формат.
Пример: **ibec_Progress('XLS_TO_CSV?C:\Documents\OldDocument.xlsx?C:\Documents\NewDocument.csv');** \\
Всички елементи в скобите са разделени с въпросителни знаци.
Можем да заменим и директориите с параметри по следния начин : \\
**Ibec_Progress('XLS_TO_CSV? ' || :FROM_FILE || '?' || :TO_FILE) ;**
execute ibeblock
(
From_File varchar(255),
To_File varchar(255),
)
as
begin
if (From_File is null) then From_File = '';
if (To_File is null) then To_File = '';
To_File = ibec_Trim(To_File);
Ibec_Progress('XLS_TO_CSV? ' || :FROM_FILE || '?' || :TO_FILE) ;
end
===== Свойства на колони в динамични справки =====
Какво може да се поставя като свойство на динамичните справки:\\
1. Формата трябва да е XML формула.... \\
2. Всичко трябва да е заградено в ... \\
3. Какво свойства има: \\
* name - име на поле
* displaylabel - Наименование на полето в таблицата (изгледа) - използва се "|" за създаване на бандове
* displaywidth - Размер на полето в таблицата (цяло число)
* readonly - Ако "false" - полето ще е разрешено за редакция (дефолт не е разрешено)
* focusing - Ако "true" - полето ще може да се клика върху него (дефолт - не може и зависи от справката дали има поне една колона за редакция!!!)
* visible - Ако е "false" се поставя за скрито (дефолт - полето е видимо)
* is_checkbox - Ако "true" означава, че полето ще бъде CHECK BOX
* is_memo - Ако "true" означава, че полето е текст
* is_icon_index - Ако "true" означава, че в полето има индекс на икона и ще се визуализира някоя от запазените картинки ()
* is_picture - Ако "true" означава, че полето е снимка
* displayformat - ако има такова свойство се поставя като формат на показване на полето
* display_format - аналогично на displayformat
* group_level - кое ниво на групране е полето (цяло число). Ако има такова свойство се търси и до кое ниво има разпънатост
* expand_level - до кое ниво да се разпъва - зависи от конкретното поле - очаква "true"
* aggregate_type - възможни стойности: SUM, AVG, COUNT, MIN, MAX
* aggregate_postion - Основните са 1, 2 и 4. 1 - Поставя се в Тотала, 2 - поставя се и в Колонтитула по групи , 4 - поставя се в заглавието на групите (трябва да има групиране поне на 1 ниво!!!). 1 - TOTAL, 2 - GROUP TOTAL, 3 - GROUP TOTAL & TOTAL 4 - GROUP HEADER, 5 - 1 + 4, 6 - 2 + 4, 7 - 1 + 2 + 4
* freezing - очаква "LEFT" ("1") или "RIGHT" ("2")
Забележка ("false" може да се заменя с "0", а "true" с "1")
Примери: \\
Дейтасет с Колони (по ТД): GROUP_LEVEL_1, GROUP_LEVEL_2, GROUP_LEVEL_3, ITEM_NAME, VALUE_WITH_VAT, FOR_PAY_CHK, PAY_SUM \\
Искаме да групираме по GROUP_LEVEL_1 и да сложим сума на двете числови полета \\
\\
\\
\\
\\
\\
\\
PAY_SUM:=VALUE_WITH_VAT*FOR_PAY_CHK \\
\\
\\
===== Системна процедура SYS$SLEEP =====
Функция **SYS$SLEEP** служи за прекъсване на изпълнението на процедура, блок или тригер за определен брой милисекунди.
Може да се използва в случай на заключване на записи и изчакване за последващото освобождаване.
Пример 1: Използване на процедурата в стейтмънт за извличане на номер от автоматична номерация (кочан).
NEW_DOC_NUMBER = null;
if (DOC_NUM_GENERATOR_REF is not null) then
begin
STMT = 'execute block
(
WRH_DOC_TYPE_REF DM_REF = :WRH_DOC_TYPE_REF,
DOC_NUM_GENERATOR_REF DM_REF = :DOC_NUM_GENERATOR_REF,
WRH_DOC_DATE DM_DATE = :WRH_DOC_DATE
)
returns
(
NEW_DOC_NUMBER DM_REF
)
as
declare variable MIN_RANGE DM_BIGINT;
declare variable MAX_RANGE DM_BIGINT;
declare variable CHECK_LAST_INVOICES_DATE DM_INT;
declare variable LAST_INVOICE_DATE DM_DATE;
declare variable LAST_INVOICE_YEAR DM_INT;
declare variable LAST_INVOICE_MONTH DM_INT;
declare variable LAST_INVOICE_DAY DM_INT;
declare variable repeat_count DM_123;
begin
MIN_RANGE = null;
MAX_RANGE = null;
select
DNG.RANGE_MIN, DNG.RANGE_MAX
from
NOM$DOC_NUM_GENERATORS DNG
join NOM$DOC_NUM_GENERATOR_TYPES DNGT on DNGT.DOC_NUM_GENERATORS_REF = DNG.ID
join CONFIG C on C.CURRENT_COM_ID = DNG.CURRENT_COM_REF
where
DNG.ID = :DOC_NUM_GENERATOR_REF and
DNGT.GENERATOR_DOC_TYPE = :WRH_DOC_TYPE_REF and
DNG.GENERATOR_TYPE = 1
into :MIN_RANGE, :MAX_RANGE;
repeat_count = 0;
NEW_DOC_NUMBER = null;
while ((repeat_count < 5) and (NEW_DOC_NUMBER is null)) do
begin
repeat_count = repeat_count + 1;
NEW_DOC_NUMBER = null;
update
NOM$DOC_NUM_GENERATORS G
set
G.CURRENT_VALUE = G.CURRENT_VALUE + 1
where
G.ID = :DOC_NUM_GENERATOR_REF
returning
G.CURRENT_VALUE - 1
into
:NEW_DOC_NUMBER;
when any do
begin
execute procedure SYS$SLEEP(200);
NEW_DOC_NUMBER = null;
end
end
if (NEW_DOC_NUMBER is null) then
exception CLEAN_TEXT_ERROR ''There was a problem getting an invoice number for the warehouse document!'';
if (((MAX_RANGE is not null) and (NEW_DOC_NUMBER >= MAX_RANGE)) or
((MIN_RANGE is not null) and (NEW_DOC_NUMBER < MIN_RANGE))) then
begin
-- exausted range of the generator
execute procedure SYS$EXCEPTION_CLEAN(64);
end
CHECK_LAST_INVOICES_DATE = null;
select
WDT2.CHECK_LAST_INVOICES_DATE
from
WRH$DOC_TYPES2 WDT2
where
WDT2.ID = :WRH_DOC_TYPE_REF
into
:CHECK_LAST_INVOICES_DATE;
if ((CHECK_LAST_INVOICES_DATE is not null) and (CHECK_LAST_INVOICES_DATE > 0)) then
begin
-- check if the date of the previous invoice is not past the date of the current invoice
LAST_INVOICE_DATE = null;
select
first 1
WD.DOC_DATE, extract(year from WD.DOC_DATE), extract(month from WD.DOC_DATE),
extract(day from WD.DOC_DATE)
from
WRH$DOCS WD
where
(WD.DOC_NUMBER < :NEW_DOC_NUMBER) and
(WD.DOC_NUMBER >= (:NEW_DOC_NUMBER - :CHECK_LAST_INVOICES_DATE)) and
(WD.DOC_STATUS >= 0) and
(WD.DOC_NUM_GENERATOR_REF = :DOC_NUM_GENERATOR_REF)
order by
WD.DOC_NUMBER desc
into
:LAST_INVOICE_DATE, :LAST_INVOICE_YEAR, LAST_INVOICE_MONTH, :LAST_INVOICE_DAY;
if ((LAST_INVOICE_DATE is not null) and
(LAST_INVOICE_DATE > :WRH_DOC_DATE)) then
begin
execute procedure SYS$EXCEPTION_CLEAN(71,
'' '' || LAST_INVOICE_DAY || ''.'' || LAST_INVOICE_MONTH || ''.'' || LAST_INVOICE_YEAR);
end
end
suspend;
end';
execute statement (STMT) (WRH_DOC_TYPE_REF := WRH_DOC_TYPE_REF, DOC_NUM_GENERATOR_REF := :DOC_NUM_GENERATOR_REF, WRH_DOC_DATE := :WRH_DOC_DATE) WITH AUTONOMOUS TRANSACTION
into
:NEW_DOC_NUMBER;
Пример 2: Показва изпълнението само в случая за изтегляне на номер и изчакването за следващ опит. Този пример е част от горната процедура.
При изтегляне на номер на фактура от кочан се извършва ъпдейт и изтегляне на номера в една транзакция. Ако транзакцията продължи около 1 секунда, то през това време, никой друг не може да достъпи същия кочан и да изтегли пореден номер.
В този случай при грешка можем да изчакаме определено време (колкото преценим, че е добре) и да опитаме отново.
Пример за точно такова изчакване е в следващия пример:
repeat_count = 0;
NEW_DOC_NUMBER = null;
while ((repeat_count < 5) and (NEW_DOC_NUMBER is null)) do
begin
repeat_count = repeat_count + 1;
NEW_DOC_NUMBER = null;
update
NOM$DOC_NUM_GENERATORS G
set
G.CURRENT_VALUE = G.CURRENT_VALUE + 1
where
G.ID = :DOC_NUM_GENERATOR_REF
returning
G.CURRENT_VALUE - 1
into
:NEW_DOC_NUMBER;
when any do
begin
execute procedure SYS$SLEEP(200); -- ако поискаме повече от 200 мс трябва да поставим съответното време за изчакване тук!
NEW_DOC_NUMBER = null;
end
end
if (NEW_DOC_NUMBER is null) then
exception CLEAN_TEXT_ERROR ''There was a problem getting an invoice number for the warehouse document!'';