*/?----------------------------------------------------------------------- */?® MALLE David programme de services : */?® + Lecture d'une zone packée stockée dans une chaine de caractères */?® -> renvoie la valeur numérique dans une chaine */?® + Lecture d'une zone décimale stockée dans une chaine de caractères */?® -> renvoie la valeur numérique dans une chaine */?® + Test si une zone est impaire ou non */?® -> renvoie *ON si la zone est impaire */?® + Déterminer la longueur d'un buffer selon le type de la zone */?® -> renvoie la longueur du buffer correspondante */?® + Traitement des quotes dans un libelle */?® -> renvoie la valeur après traitement */?® --------------------------------------------------------------------- */?® Inspirez vous de ce programme tant que vous le souhaitez */?® Modifiez le, améliorez le, ... */?® --------------------------------------------------------------------- */-> CF. README.TXT pour les instructions de compilation et de mise */-> en oeuvre. */?----------------------------------------------------------------------- H NoMain H COPYRIGHT('David MALLE') **‚------------------------------------------------------- **‚ Zone utilisées pour déclaration de type like **‚------------------------------------------------------- D t_ushort S 5U 0 D t_short S 5I 0 D t_int S 10I 0 D t_long S 10I 0 D t_int2 S 5I 0 D t_int4 S 10I 0 D t_float S 8F D t_double S Like(t_float) D t_ptr S * **‚------------------------------------------------------- **‚ Zone de la SQLDA **‚------------------------------------------------------- D SQLDA DS D SQLDAID 1 8A D SQLDABC 9 12B 0 D SQLN 13 14B 0 D SQLD 15 16B 0 D SQLVAR 80A DIM(100) D* D SQL_VAR DS D SQL_TYPE 1 2B 0 D SQL_LEN 3 4B 0 D SQL_Long 3 3I 0 D SQL_Dec 4 4I 0 D SQL_RES 5 16A D SQL_DATA 17 32* D SQL_IND 33 48* D SQL_NAMELEN 49 50B 0 D SQL_NAME 51 80A *‚------------------------------------------------------------------------ *‚Prototype lecture d'une zone packee dans une chaine de caractère *‚------------------------------------------------------------------------ D SPackToSNum PR 16A D input_VAL 16A D input_Len 5u 0 D input_Long 10i 0 D input_Dec 10i 0 *‚------------------------------------------------------------------------ *‚Prototype lecture d'une zone decimale dans une chaine de caractère *‚------------------------------------------------------------------------ D SDecToSNum PR 31A D input_VAL 31A D input_Len 5u 0 D input_Long 10i 0 D input_Dec 10i 0 *‚------------------------------------------------------------------------ *‚Prototype test zone est paire -> retourne *ON si impaire *‚------------------------------------------------------------------------ D OddZone PR 1n D ValZone 5u 0 const *‚------------------------------------------------------------------------ *‚Prototype déterminer longueur de zone selon son type *‚------------------------------------------------------------------------ D SQLBufferLen PR like(t_ushort) D Type_Zone like(SQL_TYPE) const D Len_Zone like(SQL_LEN) const *‚------------------------------------------------------------------------ *‚Prototype pour traiter les quote dans une donnée CSV *‚------------------------------------------------------------------------ D AddQuote PR D input_Val * VALUE D input_CarSep 1a VALUE D input_Quote 1a VALUE *‚------------------------------------------------------------------------ *‚Prototype pour traiter les caractères d'échappement *‚------------------------------------------------------------------------ D AddEscapeC PR D input_Val * VALUE *‚------------------------------------------------------------------------ * DS Pour conversion packée *‚------------------------------------------------------------------------ D wrkPCK ds 16 d wrkPCK00 31p00 overlay(wrkPCK:1) d wrkPCK01 31p01 overlay(wrkPCK:1) d wrkPCK02 31p02 overlay(wrkPCK:1) d wrkPCK03 31p03 overlay(wrkPCK:1) d wrkPCK04 31p04 overlay(wrkPCK:1) d wrkPCK05 31p05 overlay(wrkPCK:1) d wrkPCK06 31p06 overlay(wrkPCK:1) d wrkPCK07 31p07 overlay(wrkPCK:1) d wrkPCK08 31p08 overlay(wrkPCK:1) d wrkPCK09 31p09 overlay(wrkPCK:1) d wrkPCK10 31p10 overlay(wrkPCK:1) d wrkPCK11 31p11 overlay(wrkPCK:1) d wrkPCK12 31p12 overlay(wrkPCK:1) d wrkPCK13 31p13 overlay(wrkPCK:1) d wrkPCK14 31p14 overlay(wrkPCK:1) d wrkPCK15 31p15 overlay(wrkPCK:1) d wrkPCK16 31p16 overlay(wrkPCK:1) d wrkPCK17 31p17 overlay(wrkPCK:1) d wrkPCK18 31p18 overlay(wrkPCK:1) d wrkPCK19 31p19 overlay(wrkPCK:1) d wrkPCK20 31p20 overlay(wrkPCK:1) d wrkPCK21 31p21 overlay(wrkPCK:1) d wrkPCK22 31p22 overlay(wrkPCK:1) d wrkPCK23 31p23 overlay(wrkPCK:1) d wrkPCK24 31p24 overlay(wrkPCK:1) d wrkPCK25 31p25 overlay(wrkPCK:1) d wrkPCK26 31p26 overlay(wrkPCK:1) d wrkPCK27 31p27 overlay(wrkPCK:1) d wrkPCK28 31p28 overlay(wrkPCK:1) d wrkPCK29 31p29 overlay(wrkPCK:1) d wrkPCK30 31p30 overlay(wrkPCK:1) d wrkPCK31 31p31 overlay(wrkPCK:1) *‚------------------------------------------------------------------------ * DS Pour conversion numeric *‚------------------------------------------------------------------------ D wrkNUM ds 31 d wrkNUM00 31 00 overlay(wrkNUM:1) d wrkNUM01 31 01 overlay(wrkNUM:1) d wrkNUM02 31 02 overlay(wrkNUM:1) d wrkNUM03 31 03 overlay(wrkNUM:1) d wrkNUM04 31 04 overlay(wrkNUM:1) d wrkNUM05 31 05 overlay(wrkNUM:1) d wrkNUM06 31 06 overlay(wrkNUM:1) d wrkNUM07 31 07 overlay(wrkNUM:1) d wrkNUM08 31 08 overlay(wrkNUM:1) d wrkNUM09 31 09 overlay(wrkNUM:1) d wrkNUM10 31 10 overlay(wrkNUM:1) d wrkNUM11 31 11 overlay(wrkNUM:1) d wrkNUM12 31 12 overlay(wrkNUM:1) d wrkNUM13 31 13 overlay(wrkNUM:1) d wrkNUM14 31 14 overlay(wrkNUM:1) d wrkNUM15 31 15 overlay(wrkNUM:1) d wrkNUM16 31 16 overlay(wrkNUM:1) d wrkNUM17 31 17 overlay(wrkNUM:1) d wrkNUM18 31 18 overlay(wrkNUM:1) d wrkNUM19 31 19 overlay(wrkNUM:1) d wrkNUM20 31 20 overlay(wrkNUM:1) d wrkNUM21 31 21 overlay(wrkNUM:1) d wrkNUM22 31 22 overlay(wrkNUM:1) d wrkNUM23 31 23 overlay(wrkNUM:1) d wrkNUM24 31 24 overlay(wrkNUM:1) d wrkNUM25 31 25 overlay(wrkNUM:1) d wrkNUM26 31 26 overlay(wrkNUM:1) d wrkNUM27 31 27 overlay(wrkNUM:1) d wrkNUM28 31 28 overlay(wrkNUM:1) d wrkNUM29 31 29 overlay(wrkNUM:1) d wrkNUM30 31 30 overlay(wrkNUM:1) d wrkNUM31 31 31 overlay(wrkNUM:1) *‚------------------------------------------------------------------------ *‚Procédure d'ajout et doublage de quote dans un champ *‚------------------------------------------------------------------------ P AddQuote B EXPORT D AddQuote PI D input_Ptr * VALUE D input_CarSep 1a VALUE D input_Quote 1a VALUE * D output_Val S 32000 VARYING BASED(input_Ptr) D pos S 5 0 D start S 5 0 D dquote S 2 inz('""') D quoteEncadre S 1N /free // Doublage des quotes trouvées dans la zone. Dans ce cas, // forcage de l'encadrement de la zone par des quotes quoteEncadre = *off; start = 1; pos = 1; dow pos > 0; pos = %scan('"' :output_Val:start); if pos > 0; quoteEncadre = *on; output_Val = %subst(output_Val:1:pos-1) + dquote + %subst(output_Val:pos + 1:%len(output_Val)-pos); start = pos + 2; endif; enddo; // Forcer encadrement par Quote si zone comprend le caractère // séparateur if not (quoteEncadre); pos = %scan(input_CarSep:output_Val:1); if pos > 0; quoteEncadre = *on; endif; endif; // quote encadrant la zone si double quote dedans ou // encadrement demandé if (quoteEncadre) or (input_Quote='O'); output_Val = '"' + %trimr(output_Val) + '"'; endif; return; /end-free P AddQuote E *‚------------------------------------------------------------------------ *‚Procédure de traitement des caractères d'échappement *‚------------------------------------------------------------------------ P AddEscapeC B EXPORT D AddEscapeC PI D input_Ptr * VALUE * D output_Val S 32000 VARYING BASED(input_Ptr) D pos S 5 0 D i S 2 0 D MyEscapeC DS dim(18) qualified D C 1 D EscapeC 6 /free MyEscapeC(1).C = '&'; MyEscapeC(1).EscapeC = '&'; MyEscapeC(2).C = '"'; MyEscapeC(2).EscapeC = '"'; MyEscapeC(3).C = ''''; MyEscapeC(3).EscapeC = '''; MyEscapeC(4).C = '<'; MyEscapeC(4).EscapeC = '<'; MyEscapeC(5).C = '>'; MyEscapeC(5).EscapeC = '>'; MyEscapeC(6).C = X'20'; MyEscapeC(6).EscapeC = ''; MyEscapeC(7).C = X'21'; MyEscapeC(7).EscapeC = ''; MyEscapeC(8).C = X'22'; MyEscapeC(8).EscapeC = ''; MyEscapeC(9).C = X'23'; MyEscapeC(9).EscapeC = ''; MyEscapeC(10).C = X'24'; MyEscapeC(10).EscapeC = ''; MyEscapeC(11).C = X'25'; MyEscapeC(11).EscapeC = ''; MyEscapeC(12).C = X'26'; MyEscapeC(12).EscapeC = ''; MyEscapeC(13).C = X'27'; MyEscapeC(13).EscapeC = ''; MyEscapeC(14).C = X'28'; MyEscapeC(14).EscapeC = ''; MyEscapeC(15).C = X'29'; MyEscapeC(15).EscapeC = ''; MyEscapeC(16).C = X'2A'; MyEscapeC(16).EscapeC = ''; MyEscapeC(17).C = X'2B'; MyEscapeC(17).EscapeC = ''; MyEscapeC(18).C = X'3A'; MyEscapeC(18).EscapeC = ''; // for i = 1 to %elem(MyEscapeC); pos = 1; dow pos > 0 and pos <= %len(output_Val); pos = %scan(MyEscapeC(i).C:output_Val:pos); if pos > 0; if pos < %len(output_Val); output_Val = %subst(output_Val:1:pos-1) + %trim(MyEscapeC(i).EscapeC) + %subst(output_Val:pos + 1:%len(output_Val)-pos); else; output_Val = %subst(output_Val:1:pos-1) + %trim(MyEscapeC(i).EscapeC); endif; pos = pos + %len(%trim(MyEscapeC(i).EscapeC)); endif; enddo; endfor; return; /end-free P AddEscapeC E *‚------------------------------------------------------------------------ *‚Procédure lecture d'une zone packee dans une chaine de caractère *‚------------------------------------------------------------------------ P SPackToSNum B EXPORT D SPackToSNum PI 16A D input_VAL 16A D input_Len 5u 0 D input_Long 10i 0 D input_Dec 10i 0 * D output_PCK S 16A /free // Transformation en chaine de caractère selon la taille de // la zone packée wrkPCK = *LOVAL; %subst(wrkPCK: 16 - input_Len + 1: input_Len) = %subst(input_VAL :1:input_Len); select; when input_Dec = 31; EXEC SQL SET :output_PCK = CHAR(:wrkPCK31,','); when input_Dec = 30; EXEC SQL SET :output_PCK = CHAR(:wrkPCK30,','); when input_Dec = 29; EXEC SQL SET :output_PCK = CHAR(:wrkPCK29,','); when input_Dec = 28; EXEC SQL SET :output_PCK = CHAR(:wrkPCK28,','); when input_Dec = 27; EXEC SQL SET :output_PCK = CHAR(:wrkPCK27,','); when input_Dec = 26; EXEC SQL SET :output_PCK = CHAR(:wrkPCK26,','); when input_Dec = 25; EXEC SQL SET :output_PCK = CHAR(:wrkPCK25,','); when input_Dec = 24; EXEC SQL SET :output_PCK = CHAR(:wrkPCK24,','); when input_Dec = 23; EXEC SQL SET :output_PCK = CHAR(:wrkPCK23,','); when input_Dec = 22; EXEC SQL SET :output_PCK = CHAR(:wrkPCK22,','); when input_Dec = 21; EXEC SQL SET :output_PCK = CHAR(:wrkPCK21,','); when input_Dec = 20; EXEC SQL SET :output_PCK = CHAR(:wrkPCK20,','); when input_Dec = 19; EXEC SQL SET :output_PCK = CHAR(:wrkPCK19,','); when input_Dec = 18; EXEC SQL SET :output_PCK = CHAR(:wrkPCK18,','); when input_Dec = 17; EXEC SQL SET :output_PCK = CHAR(:wrkPCK17,','); when input_Dec = 16; EXEC SQL SET :output_PCK = CHAR(:wrkPCK16,','); when input_Dec = 15; EXEC SQL SET :output_PCK = CHAR(:wrkPCK15,','); when input_Dec = 14; EXEC SQL SET :output_PCK = CHAR(:wrkPCK14,','); when input_Dec = 13; EXEC SQL SET :output_PCK = CHAR(:wrkPCK13,','); when input_Dec = 12; EXEC SQL SET :output_PCK = CHAR(:wrkPCK12,','); when input_Dec = 11; EXEC SQL SET :output_PCK = CHAR(:wrkPCK11,','); when input_Dec = 10; EXEC SQL SET :output_PCK = CHAR(:wrkPCK10,','); when input_Dec = 09; EXEC SQL SET :output_PCK = CHAR(:wrkPCK09,','); when input_Dec = 08; EXEC SQL SET :output_PCK = CHAR(:wrkPCK08,','); when input_Dec = 07; EXEC SQL SET :output_PCK = CHAR(:wrkPCK07,','); when input_Dec = 06; EXEC SQL SET :output_PCK = CHAR(:wrkPCK06,','); when input_Dec = 05; EXEC SQL SET :output_PCK = CHAR(:wrkPCK05,','); when input_Dec = 04; EXEC SQL SET :output_PCK = CHAR(:wrkPCK04,','); when input_Dec = 03; EXEC SQL SET :output_PCK = CHAR(:wrkPCK03,','); when input_Dec = 02; EXEC SQL SET :output_PCK = CHAR(:wrkPCK02,','); when input_Dec = 01; EXEC SQL SET :output_PCK = CHAR(:wrkPCK01,','); when input_Dec = 00; EXEC SQL SET :output_PCK = CHAR(:wrkPCK00,','); other; output_PCK = *LOVAL; endsl; return output_PCK; /end-free P SPackToSNum E *‚------------------------------------------------------------------------ *‚Procédure lecture d'une zone decimale dans une chaine de caractère *‚------------------------------------------------------------------------ P SDecToSNum B EXPORT D SDecToSNum PI 31A D input_VAL 31A D input_Len 5u 0 D input_Long 10i 0 D input_Dec 10i 0 * D output_NUM S 31A /free // Transformation en chaine de caractère selon la taille de // la zone wrkNUM = *LOVAL; %subst(wrkNUM: 31 - input_Len + 1: input_Len) = %subst(input_VAL :1:input_Len); select; when input_Dec = 31; EXEC SQL SET :output_NUM = CHAR(:wrkNUM31,','); when input_Dec = 30; EXEC SQL SET :output_NUM = CHAR(:wrkNUM30,','); when input_Dec = 29; EXEC SQL SET :output_NUM = CHAR(:wrkNUM29,','); when input_Dec = 28; EXEC SQL SET :output_NUM = CHAR(:wrkNUM28,','); when input_Dec = 27; EXEC SQL SET :output_NUM = CHAR(:wrkNUM27,','); when input_Dec = 26; EXEC SQL SET :output_NUM = CHAR(:wrkNUM26,','); when input_Dec = 25; EXEC SQL SET :output_NUM = CHAR(:wrkNUM25,','); when input_Dec = 24; EXEC SQL SET :output_NUM = CHAR(:wrkNUM24,','); when input_Dec = 23; EXEC SQL SET :output_NUM = CHAR(:wrkNUM23,','); when input_Dec = 22; EXEC SQL SET :output_NUM = CHAR(:wrkNUM22,','); when input_Dec = 21; EXEC SQL SET :output_NUM = CHAR(:wrkNUM21,','); when input_Dec = 20; EXEC SQL SET :output_NUM = CHAR(:wrkNUM20,','); when input_Dec = 19; EXEC SQL SET :output_NUM = CHAR(:wrkNUM19,','); when input_Dec = 18; EXEC SQL SET :output_NUM = CHAR(:wrkNUM18,','); when input_Dec = 17; EXEC SQL SET :output_NUM = CHAR(:wrkNUM17,','); when input_Dec = 16; EXEC SQL SET :output_NUM = CHAR(:wrkNUM16,','); when input_Dec = 15; EXEC SQL SET :output_NUM = CHAR(:wrkNUM15,','); when input_Dec = 14; EXEC SQL SET :output_NUM = CHAR(:wrkNUM14,','); when input_Dec = 13; EXEC SQL SET :output_NUM = CHAR(:wrkNUM13,','); when input_Dec = 12; EXEC SQL SET :output_NUM = CHAR(:wrkNUM12,','); when input_Dec = 11; EXEC SQL SET :output_NUM = CHAR(:wrkNUM11,','); when input_Dec = 10; EXEC SQL SET :output_NUM = CHAR(:wrkNUM10,','); when input_Dec = 09; EXEC SQL SET :output_NUM = CHAR(:wrkNUM09,','); when input_Dec = 08; EXEC SQL SET :output_NUM = CHAR(:wrkNUM08,','); when input_Dec = 07; EXEC SQL SET :output_NUM = CHAR(:wrkNUM07,','); when input_Dec = 06; EXEC SQL SET :output_NUM = CHAR(:wrkNUM06,','); when input_Dec = 05; EXEC SQL SET :output_NUM = CHAR(:wrkNUM05,','); when input_Dec = 04; EXEC SQL SET :output_NUM = CHAR(:wrkNUM04,','); when input_Dec = 03; EXEC SQL SET :output_NUM = CHAR(:wrkNUM03,','); when input_Dec = 02; EXEC SQL SET :output_NUM = CHAR(:wrkNUM02,','); when input_Dec = 01; EXEC SQL SET :output_NUM = CHAR(:wrkNUM01,','); when input_Dec = 00; EXEC SQL SET :output_NUM = CHAR(:wrkNUM00,','); other; output_NUM = *LOVAL; endsl; return output_NUM; /end-free P SDecToSNum E *‚------------------------------------------------------------------------ *‚Détermine si une zone est paire -> retourne *ON si impaire *‚------------------------------------------------------------------------ P OddZone B EXPORT D OddZone PI 1N D Val_Zone 5U 0 Const /free if %rem(Val_Zone:2) = *ZEROS ; return *off; else ; return *on; endif; /end-free P OddZone E *‚------------------------------------------------------------------------ *‚Détermine la longueur d'un buffer selon le type de la zone *‚------------------------------------------------------------------------ PSQLBufferLen B EXPORT DSQLBufferLen PI like(t_ushort) D Type_Zone like(SQL_TYPE) const D Len_Zone like(SQL_LEN) const D* D Buffer_Len s 5U 0 INZ(*ZEROS) D* D ds 2 D Len_ds 1 2I 0 D Len_G 1 1I 0 D Len_D 2 2I 0 /free Len_ds = Len_Zone; select; when Type_Zone = 484 or Type_Zone = 485; Buffer_Len = %int( Len_G / 2 ) + 1 ; when Type_Zone = 488 or Type_Zone = 489 or Type_Zone = 504 or Type_Zone = 505; Buffer_Len = Len_G; when Type_Zone = 384 or Type_Zone = 385; Buffer_Len = 8; when Type_Zone = 388 or Type_Zone = 389; Buffer_Len = 8; when Type_Zone = 392 or Type_Zone = 393; Buffer_Len = 26; when Type_Zone = 448 or Type_Zone = 449; Buffer_Len = Len_Zone + 2; when Type_Zone = 464 or Type_Zone = 465; Buffer_Len = Len_Zone *2 + 2; when Type_Zone = 468 or Type_Zone = 469; Buffer_Len = Len_Zone *2; when Type_Zone = 492 or Type_Zone = 493; Buffer_Len = 8; when Type_Zone = 496 or Type_Zone = 497; Buffer_Len = 4; when Type_Zone = 500 or Type_Zone = 501; Buffer_Len = 2; when Type_Zone = 452; Buffer_Len = Len_Zone; other; Buffer_Len = Len_Zone; endsl; return Buffer_Len; /end-free P E