*=========================================================================
* RPG ILE PROGRAM CGIDEV2/UPLOAD
*
* It demonstrates the ability of zhbgetinput() to perform file upload
*
* CRTBNDRPG CGIDEV2/UPLOAD DFTACTGRP(*NO) ACTGRP(UPLOAD) DBGVIEW(*SOURCE)
*
*=========================================================================
/copy CGIDEV2/qrpglesrc,hspecs
/copy CGIDEV2/qrpglesrc,hspecsbnd
* The following file is used to establish if a client side extension validation is active
FCHKEXT if e disk usropn
* The following file is used to establish the client side valid extensions
FALWEXT if e k disk usropn
* The following file is used to establish if a server side extension validation is active
FEXITPOINTSif e k disk usropn
/copy CGIDEV2/qrpglesrc,prototypeb
/copy CGIDEV2/qrpglesrc,usec
/copy CGIDEV2/qrpglesrc,variables3
* retrieve system value QDATFMT
D rtvQDATFMT pr 3
D ExtHtml s 500 inz('/cgidev/html/upload.txt')
* Indicators for GetHtmlIfsMult subprocedure
D IfsMultIndicators...
d ds
D NoErrors n
D NameTooLong n
D NotAccessible n
D NoFilesUsable n
D DupSections n
D FileIsEmpty n
*
D DataLib c 'CGIDEV2DT'
D rrn s 10u 0
D YesNo s 3
D ActVal1Ind s n
D ActVal2Ind s n
D alwExtensions s 10000 varying
D nbrAlwExt s 10i 0
D xrequest s 20
D serverName s 50
D datfmt s 3
D stampNow s z
D deleteTime s z
D deleteTimeC s 26
D deleteDay s 8
D deleteHour s 6
D cmd s 1024
D PCfile s 1024 varying
D IFSFile s 1024 varying
D xyrname s 30
D xyrage s 3
D IFSobjFound s n
D NotValidated s 21 inz('*** NOT VALIDATED ***')
D CHKEXTind s n
D ALWEXTind s n
D EXITPOINTSind s n
C eptkey klist
C kfld eptsubp
C kfld eptsubpid
*=========================================================================
* Main processing path
*=========================================================================
/free
//Set "DataLib" as current library
// (this is needed by subprocedure ZHBGETINPUT in module XXXCGIPARS
// in order to open file EXITPOINTS in library "DataLib"
rc=docmd('chgcurlib ' + DataLib);
// Check files
exsr ChkF;
//Load the external HTML
IfsMultIndicators = getHtmlIfsMult(%trim(exthtml):'');
//Open files
exsr OpnF;
//Set the validation global variables for the Javascript in the HTML
exsr SetJsVars;
//Check the active validations
exsr ChkActVal;
//Start the HTML response
callp wrtsection('top');
if ActVal1Ind=*on;
callp wrtsection('valActive1');
endif;
if ActVal2Ind=*on;
callp wrtsection('valActive2');
endif;
callp wrtsection('valActiveX');
//Receive the main request
nbrVars = zhbgetinput(savedquerystring:qusec);
xrequest= zhbgetvarUpper('xrequest');
//Examine the main request
select;
when xrequest=' ';
exsr Init;
when xrequest='UPLOAD';
exsr Upload;
when xrequest='DELETE';
exsr Delete;
endsl;
//Remove current library
rc=docmd('chgcurlib *crtdft');
//Flush buffer and quit
callp wrtsection('*fini');
return;
/end-free
*=========================================================================
* The first time this program is called
*=========================================================================
/free
begsr Init;
updhtmlvar('errmsg':' ');
wrtsection('endform');
endsr;
/end-free
*=========================================================================
* The file upload was submitted
* - the file upload was performed when subprocedure zhbGetInput() was run
* - subprocedure zhbGetInput() makes the following input variables available:
* * browserfile the name of the PC file
* * browserfile_tempfile the name assigned to the IFS stream file
*=========================================================================
/free
begsr Upload;
PCfile = zhbgetvar('browserfile');
IFSfile = zhbgetvar('browserfile_tempfile');
xyrname = zhbgetvar('xyrname');
xyrage = zhbgetvar('xyrage');
if %subst(IFSfile:1:21)=NotValidated;
IFSfile=NotValidated;
endif;
updhtmlvar('errmsg':' ');
updhtmlvar('pcfile':PCfile);
updhtmlvar('ifsfile':IFSfile);
updhtmlvar('yrname':xyrname);
updhtmlvar('yrage':xyrage);
wrtsection('uploaded');
wrtsection('endform');
// If the case, schedule a deletion of the uploaded file
// 1- Check file existence
IFSobjFound=chkIFSobj4(%trim(IFSfile));
if IFSobjFound=*off; // not found
leavesr;
endif;
// 2- Check the name of the uploaded temporary file
if %subst(uppify(IFSfile):1:5)<>'/TMP/';
leavesr;
endif;
// 3- Check the name of the server
serverName=getenv('SERVER_NAME':qusec);
serverName=uppify(serverName);
rc=%scan('.EASY400.NET':serverName);
if rc=0;
leavesr;
endif;
// 4- Schedule a delete job
exsr SchedDelete; //schedule a deletion of the uploaded file
Endsr;
/end-free
*=========================================================================
* Schedule a deletion of the uploaded file
*=========================================================================
/free
Begsr SchedDelete;
datfmt=rtvQDATFMT(); //retrieve system value QDATFMT (YMD, MDY, DMY, JUL)
if datfmt='JUL';
leavesr; //give up
endif;
stampNow=%timestamp();
deleteTime=stampNow + %minutes(15);
deleteTimeC=%char(deleteTime);
select;
when datfmt='YMD';
deleteDay=%subst(deleteTimeC:1:4) +
%subst(deleteTimeC:6:2) +
%subst(deleteTimeC:9:2);
when datfmt='MDY';
deleteDay=%subst(deleteTimeC:6:2) +
%subst(deleteTimeC:9:2) +
%subst(deleteTimeC:1:4);
when datfmt='DMY';
deleteDay=%subst(deleteTimeC:9:1) +
%subst(deleteTimeC:6:2) +
%subst(deleteTimeC:1:4);
endsl;
deleteHour=%subst(deleteTimeC:12:2) +
%subst(deleteTimeC:15:2) +
%subst(deleteTimeC:18:2);
cmd='del ''' + %trim(IFSfile) + '''';
cmd='SBMJOB JOB(TMPPURGE) JOBQ(QSYSNOMAX) INQMSGRPY(*DFT) +
SCDDATE('+deleteDay+') SCDTIME('+deleteHour+') +
DATE(*SYSVAL) CMD('+%trim(cmd)+')';
rc=doCmd(cmd);
Endsr;
/end-free
*=========================================================================
* Delete the stream file just uploaded
* - the name of the IFS stream file to be deleted is received from
* the hidden field named "ifsfile"
*=========================================================================
/free
begsr Delete;
PCfile = zhbgetvar('pcfile');
IFSfile = zhbgetvar('ifsfile');
if %subst(IFSFile:%len(IFSFile)-1:2)=x'0D25'; //if ending CRLF, ...
IFSFile=%subst(IFSFile:1:%len(IFSFile)-2); //drop CRLF
endif;
if IFSfile<>NotValidated;
cmd='del '''+IFSfile+ '''';
rc=docmd(cmd);
if rc=0;
updhtmlvar('errmsg':' ');
else;
updhtmlvar('errmsg':'IFS file ' +
%trim(IFSfile) + ' could not be deleted.');
updhtmlvar('pcfile':PCfile);
updhtmlvar('ifsfile':IFSfile);
wrtsection('filerow');
endif;
else;
updhtmlvar('errmsg':' ');
endif;
wrtsection('endform');
endsr;
/end-free
*=====================================================================
* Set the validation control variables for the Javascript in the HTML
*=====================================================================
/free
Begsr SetJSVars;
if CHKEXTind=*off or
CHKEXTind=*off;
YesNo='no';
updhtmlvar('yesno':'no');
updhtmlvar('alwextensions':' ');
leavesr;
endif;
//Output variable 'AlwExtensions': used to set the allowed extensions
nbrAlwExt=0;
clear AlwExtensions;
axtext=*loval;
setll axtext axt;
read axt;
dow not %eof;
AlwExtensions=AlwExtensions+''''+%trim(axtext)+''',';
nbrAlwExt=nbrAlwExt+1;
read axt;
enddo;
if nbrAlwExt>0;
AlwExtensions=%subst(AlwExtensions:1:%len(AlwExtensions)-1);//trim off the last comma
AlwExtensions=%xlate(up:lw:AlwExtensions);
endif;
//Output variable 'YesNo': used to establish if the validation process should take place
YesNo='no';
if nbrAlwExt>0;
rrn=1;
chain rrn cxt;
if %found and cxtYesNo='1';
YesNo='yes';
endif;
endif;
updhtmlvar('yesno':YesNo);
updhtmlvar2('alwextensions':%addr(AlwExtensions)+2:
%len(AlwExtensions));
endsr;
/end-free
*=====================================================================
* Check the active validations
*=====================================================================
/free
Begsr ChkActVal;
ActVal1Ind=*off;
ActVal2Ind=*off;
if CHKEXTind=*off or
CHKEXTind=*off or
EXITPOINTSind=*off;
leavesr;
endif;
// Check client side validation
if YesNo='yes';
ActVal1Ind=*on;
endif;
// Check client side validation
eptsubp='FILE-UPLOAD';
eptsubpID='001';
chain eptkey eptrcd;
if %found and eptpgm<>' ' and eptpgmlib<>' ';
rc=docmd('chkobj ' + %trim(eptpgmlib) + '/' +
%trim(eptpgm) + ' *pgm');
if rc=0;
ActVal2Ind=*on;
endif;
endif;
endsr;
/end-free
*=====================================================================
* Check Files
*=====================================================================
/free
Begsr ChkF;
rc=doCmd('CHKOBJ ' + %trim(DataLib) + '/CHKEXT *FILE');
if rc=0;
CHKEXTind=*on;
else;
CHKEXTind=*off;
endif;
rc=doCmd('CHKOBJ ' + %trim(DataLib) + '/ALWEXT *FILE');
if rc=0;
ALWEXTind=*on;
else;
ALWEXTind=*off;
endif;
rc=doCmd('CHKOBJ *CURLIB/EXITPOINTS *FILE');
if rc=0;
EXITPOINTSind=*on;
else;
EXITPOINTSind=*off;
endif;
Endsr;
/end-free
*=====================================================================
* Open Files
*=====================================================================
/free
Begsr OpnF;
if CHKEXTind=*on;
if not %open(CHKEXT);
rc=docmd('ovrdbf CHKEXT ' + %trim(DataLib) + '/CHKEXT +
secure(*yes) ovrscope(*job)');
open CHKEXT;
endif;
endif;
if ALWEXTind=*on;
if not %open(ALWEXT);
rc=docmd('ovrdbf ALWEXT ' + %trim(DataLib) + '/ALWEXT +
secure(*yes) ovrscope(*job)');
open ALWEXT;
endif;
endif;
if EXITPOINTSind=*on;
if not %open(EXITPOINTS);
rc=docmd('ovrdbf EXITPOINTS ' + '*curlib/EXITPOINTS +
secure(*yes) ovrscope(*job)');
open EXITPOINTS;
endif;
endif;
Endsr;
/end-free
*=====================================================================
* Close Files
*=====================================================================
/free
Begsr CloF;
if CHKEXTind=*on;
if %open(CHKEXT);
close CHKEXT;
rc=docmd('dltovr CHKEXT lvl(*job)');
endif;
endif;
if ALWEXTind=*on;
if %open(ALWEXT);
close ALWEXT;
rc=docmd('dltovr ALWEXT lvl(*job)');
endif;
endif;
if EXITPOINTSind=*on;
if %open(EXITPOINTS);
close EXITPOINTS;
rc=docmd('dltovr EXITPOINTS lvl(*job)');
endif;
endif;
Endsr;
/end-free
*=========================================================================
* Retrieve system value QDATFMT
P rtvQDATFMT b
D rtvQDATFMT pi 3
* prototype for Retrieve System Values (QWCRSVAL) API
D goQWCRSVAL pr extpgm('QWCRSVAL')
D 31
D 10i 0
D 10i 0
D 10
D errCode like(qusec)
* required parameter group for Retrieve System Values (QWCRSVAL) API
D rcvVar ds
D nbrRetVals 10i 0
D offsetRetVal 10i 0
D sysValInf 23
D rcvVarLen s 10i 0 inz(%size(rcvVar))
D nbrSysVals s 10i 0 inz(1)
D sysValName s 10
* Layout of System Value Information Table
D sysvalInfTabP s *
D sysvalInfTab ds based(sysvalInfTabP)
D retSysValName 10
D retSysValDTyp 1
D retSysValISts 1
D retSysValLen 10i 0
D retSysValVal 3
/free
sysvalName='QDATFMT';
goQWCRSVAL(rcvVar:rcvVarLen:nbrSysVals:sysValName:qusec);
sysvalInfTabP=%addr(rcvVar)+offsetRetVal;
return retSysValVal;
/end-free
P rtvQDATFMT e
|