‚ * compilation : ‚ * CRTSRCPF FILE(QTEMP/RTVSQLP) RCDLEN(112) ‚ * TEXT('Retrieve SQL source in DDL for SQL objects') ‚ * CRTRPGMOD MODULE(jpl/RTVSQLR) SRCFILE(jpl/QPGMSRC) OPTION(*NODEBUGIO *SRCSTMT *SHOWCPY ‚ * *SECLVL *EXPDDS) DBGVIEW(*ALL) ‚ * CRTPGM PGM(jpl/RTVSQLR) ACTGRP(*CALLER) BNDDIR(*LIBL/QC2LE) /define INFDS ‚ *define VBEL ‚ *define ECOPRO ‚ *define SQL ‚ *define SQLDESCRIBE /define LOWERCASE ‚ *define QUOTE ‚ *define XLXML h debug datedit(*ymd) datfmt(*iso-) decedit('0.') /define FILE_SECTION /include qpgmsrc,jp4inc /undefine FILE_SECTION ‚ *================================================================ ‚ * sample of program ‚ *================================================================ ‚ *necessary adaptation are marked HERE ‚ *HERE replace PF jpl020p by target file to read ‚f*rtvsqlp if e disk infsr(*pssr) ‚f* prefix('DDL.') ‚f* rename(rtvsqlp :fddl) ‚ * ‚ *HERE replace DSPF jpl020 with target dspf frtvsqlfm cf e workstn infsr(*pssr) f infds(fids) f indds(indara) d ddl e ds qualified extname(rtvsqlp ) ‚ * ‚ * !!! indara ne recouvre PAS *in d indara ds d in0199 01 99 d errind 60 99 d in10 n overlay(indara:10) d rollup n overlay(indara:11) d suppression n overlay(indara:40) d clrsfl n overlay(indara:51) d dspsfl n overlay(indara:52) d sflend n overlay(indara:53) d errsfl n overlay(indara:60) d ertype n overlay(indara:61) HERE adapt the *IN d ersele n overlay(indara:61) d ermonm n overlay(indara:62) d limite n overlay(indara:98) /define DATA_SECTION /include qpgmsrc,JP4inc /undefine DATA_SECTION ‚ * commande as400 D QCmdExec PR EXTPGM('QCMDEXC') D cmd CONST like(TypeCmdStr) D cmdlen 15P 5 CONST d cmd s like(TypeCmdStr) D QCmdChk PR EXTPGM('QCMDCHK') D cmd const like(TypeCmdStr) D cmdlen 15P 5 CONST d objtext s 500 varying DMSGID S 7A IMPORT('_EXCP_MSGID') Dc_system pr 10i 0 extproc('system') Dparm2 * options(*string) value ‚ * exemple : ‚ *d rc s 9b 0 ‚ * rc = c_system(cmde ); ‚ * if rc <> 0; ‚ * dsply msgid; ‚ * endif; ‚ * structures pour chaque message d'erreur ayant des variables ‚ * bin(1) = 3i 0; bin(2) = 5i 0; bin(4) = 10i 0; bin(8) = 20i 0 d MSG0002 ds 132 vars pour erreur d msg000201 like(typebin4) ‚ * indicateur de message warning deja envoyé d warn0002 s n ‚ * Generate Data Definition Language (QSQGNDDL) API D RetrieveDDL PR EXTPGM('QSQGNDDL') ‚ *Required Parameter Group: ‚ * d Input_template... d 582 d Length_of_input_template... d like(typebin4) const d Input_template_format_name... d 8 const d Error_code_I_O... d 255 D/include qpgmsrc,sqlr0100 ‚D******************** ‚D* ‚D* ERROR CODE HANDLING FIELDS ‚D* ‚D******************** D ECH DS D ECH01 1 4B 0 LONGUEUR DE LA ZONE D ECH02 5 8B 0 lng DE LA REPONSE D ECH03 9 15 NUMERO DE L'ERREUR D ECH03a 9 11 D ECH05 17 255 MSGDTA POUR L'ERREUR d msgf s 10 ‚ * HERE program name & parameters d rtvsqlr pr d rtvsqlr pi /free //‚* programme principal //‚* initialisation générale w0flsp = '0000' ;//initialisation generale B01 dow w0flsp <> *blanks ;//‚boucle centrale B02 select ; X02 when w1flsp = '00'; exsr sp000 ;//‚initialisation X02 when w1flsp = '01'; exsr sp010 ;//‚selection X02 X02 X02 other; spmsda = 'routine cible (w0flsp) inconnue'; exsr *pssr ;//‚erreur dans wwflag E02 endsl; E01 enddo; *inlr = *on ; //‚--------------------------------------------------------------- //‚initialisation generale //‚--------------------------------------------------------------- B01 begsr sp000 ; //‚HERE choose initial screen B02 w0flsp= '0100' ;// selection sqlr0100.Object_Name = *blank ; sqlr0100.Object_Library = '*LIBL' ; sqlr0100.Object_Type = 'TABLE' ; sqlr0100.Source_File_Name = 'RTVSQLP' ; sqlr0100.Source_File_Library = 'JPL' ; sqlr0100.Source_File_Member = 'AAAAAAAAAA' ; sqlr0100.Severity_Level = 0 ; sqlr0100.Replace_Option = '1' ; sqlr0100.Statement_Formatting_Option = '0' ; sqlr0100.Date_Format = 'ISO' ; sqlr0100.Date_Separator = '/' ; sqlr0100.Time_Format = 'ISO' ; sqlr0100.Time_Separator = ':' ; sqlr0100.Naming_Option = 'SYS' ; sqlr0100.Decimal_Point = ',' ; sqlr0100.Standards_Option = '0' ; sqlr0100.Drop_Option = '1' ; sqlr0100.Message_Level = 0 ; sqlr0100.Comment_Option = '1' ; sqlr0100.Label_Option = '1' ; sqlr0100.Header_Option = '1' ; X02 E02 pmqcln() ; message('AAA0001'); E01 endsr ; //‚--------------------------------------------------------------- //‚selection task //‚--------------------------------------------------------------- B01 begsr sp010 ; B02 dow w1flsp = '01';//main loop B03 select; X03 when w2flsp = '00'; //‚initialisation w2flsp = '50'; indara = *all'0'; //‚HERE load the page //‚fa = bcl. ; FAOBJNAME = sqlr0100.Object_Name ; FAOBJLIB = sqlr0100.Object_Library ; FAOBJTYPE = sqlr0100.Object_Type ; FASRCFILE = sqlr0100.Source_File_Name ; FASRCLIB = sqlr0100.Source_File_Library ; FASRCMBR = sqlr0100.Source_File_Member ; FASEVLEVEL = sqlr0100.Severity_Level ; FAcrtmbr = sqlr0100.Replace_Option ; FAREPLACE = sqlr0100.Replace_Option ; FAFMTOPT = sqlr0100.Statement_Formatting_Option ; FADATFMT = sqlr0100.Date_Format ; FADATSEP = sqlr0100.Date_Separator ; FATIMFMT = sqlr0100.Time_Format ; FATIMSEP = sqlr0100.Time_Separator ; FANAMING = sqlr0100.Naming_Option ; FADECPOINT = sqlr0100.Decimal_Point ; FASTANDARD = sqlr0100.Standards_Option ; FADROP = sqlr0100.Drop_Option ; FAMSGLVL = sqlr0100.Message_Level ; FACOMMENT = sqlr0100.Comment_Option ; FALABEL = sqlr0100.Label_Option ; FAHEADER = sqlr0100.Header_Option ; warn0002=*off; X03 when w2flsp = '50'; //‚show w2flsp = '60'; //‚Fkey toolbar write fmtka ; X03 when w2flsp = '60'; //‚show again w2flsp = '70'; write pmqctl;//‚program message queue exfmt fmta ;//‚active screen callp pmqcln() ;//‚cleanup the program message queue X03 when w2flsp = '70'; //‚controles //‚F3=quit, exit, annulation B04 if *inkc = *on; w0flsp = *blank; iter; E04 endif; //‚F12=F3 B04 if *inkl = *on; w0flsp = *blank; iter; E04 endif; //‚F5=refresh B04 if *inke = *on ; w2flsp = '00'; iter; E04 endif ; //‚at work w2flsp = '80'; B04 if %subst(fasrcmbr:1:1) = '*'; message ('CPD0078' : 'xxxx' + 'SRCMBR ' + fasrcmbr : '' : 'QCPFMSG'); w2flsp = '50'; iter; E04 endif; sqlr0100.Object_Name = FAOBJNAME ; sqlr0100.Object_Library = FAOBJLIB ; sqlr0100.Object_Type = FAOBJTYPE ; sqlr0100.Source_File_Name = FASRCFILE ; sqlr0100.Source_File_Library = FASRCLIB ; sqlr0100.Source_File_Member = FASRCMBR ; sqlr0100.Severity_Level = FASEVLEVEL ; sqlr0100.Replace_Option = FAREPLACE ; sqlr0100.Statement_Formatting_Option = FAFMTOPT ; sqlr0100.Date_Format = FADATFMT ; sqlr0100.Date_Separator = FADATSEP ; sqlr0100.Time_Format = FATIMFMT ; sqlr0100.Time_Separator = FATIMSEP ; sqlr0100.Naming_Option = FANAMING ; sqlr0100.Decimal_Point = FADECPOINT ; sqlr0100.Standards_Option = FASTANDARD ; sqlr0100.Drop_Option = FADROP ; sqlr0100.Message_Level = FAMSGLVL ; sqlr0100.Comment_Option = FACOMMENT ; sqlr0100.Label_Option = FALABEL ; sqlr0100.Header_Option = FAHEADER ; clear ech; ech01 = %size(ech); //‚check destination file existence cmd ='CHKOBJ OBJ(' + %trim(fasrclib) + '/' + %trim(fasrcfile) + ')' + ' OBJTYPE(*FILE)' + ' MBR(*NONE)' + ' AUT(*ALL)' ; B04 monitor; qcmdexec ( cmd : %size(cmd)); X04 on-error; //‚the message is already in the message subfile //‚message('CPF9898' : spmsda : '' : 'QCPFMSG'); w2flsp = '50'; iter; E04 endmon ; //‚check destination member existence cmd ='CHKOBJ OBJ(' + %trim(fasrclib) + '/' + %trim(fasrcfile) + ')' + ' OBJTYPE(*FILE)' + ' MBR(' + %trim(fasrcmbr) + ')' + ' AUT(*ALL)' ; B04 callp(e) qcmdexec ( cmd : %size(cmd)); B04 if %error; B05 if facrtmbr = '1'; objtext = faobjtype + %trim(faobjlib) + '/' + %trim(faobjname) ; B06 if %len(objtext) > 50; %len(objtext) = 50 ; E06 endif; cmd = 'ADDPFM FILE(' + %trim(FASRCLIB) + '/' + %trim(FASRCFILE) + ') ' + 'MBR(' + %trim(FASRCMBR) + ') ' + 'TEXT(''' + objtext + ''')'; callp(e) qcmdexec ( cmd : %size(cmd)); B06 if %error(); w2flsp = '50'; iter; E06 endif; X05 else; //‚the message is already in the message subfile //‚message('CPF9898' : spmsda : '' : 'QCPFMSG'); w2flsp = '50'; iter; E05 endif; X04 else ; //‚the member already exists B05 if FAREPLACE = '0'; //‚replace member forbidden //‚message ('CPF5812' : fasrcfile + fasrclib + fasrcmbr //‚ : '' : 'QCPFMSG'); //‚w2flsp = '50'; //‚iter; E05 endif; E04 endif; retrieveDDL(sqlr0100 : %size(sqlr0100) : 'SQLR0100' : ech); B04 if ech02 > 0 ; B05 if ech03a = 'SQL'; msgf = 'QSQLMSG'; X05 else; msgf = 'QCPFMSG'; E05 endif; message(ech03 : ech05 : '*LIBL' : msgf ); w2flsp = '50'; E04 endif; X03 when w2flsp = '80'; //‚validation cmd = 'STRSEU SRCFILE(' + %trim(FASRCLIB) + '/' + %trim(FASRCFILE) + ') ' + 'SRCMBR(' + %trim(FASRCMBR) + ') ' + 'OPTION(5)'; callp(e) qcmdexec ( cmd : %size(cmd)); B04 if %error(); w2flsp = '50'; iter; E04 endif; w0flsp = '0100' ; iter; X03 other ; //‚quit w0flsp = *blank ; E03 endsl ; E02 enddo ; E01 endsr; //‚--------------------------------------------------------------- //‚begsr ; //‚endsr; //‚--------------------------------------------------------------- /end-free ‚ *---------------------------------------------------------------- ‚ * *inzsr, sr pmqsnd, sp *pssr , ... ‚ *---------------------------------------------------------------- EPR /free /define PROCEDURE_SECTION /include qpgmsrc,JP4inc