====== Хватки и трикове със скриптове ====== В тази секция се намират готови парчета код, които често се използват в скриптовете. ===== Изтегляне на преводи на полета от източника ===== 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!'';