*=====================================================================
* RPG ILE MODULE FUPLOAD/FUPLOAD2
*
* CRTBNDRPG FUPLOAD/FUPLOAD2 DFTACTGRP(*NO) ACTGRP(FUPLOAD) DBGVIEW(*SOURCE)
*
* This piece of code was contributed by
* Ron Egyed, RJE Consulting Inc, New Port Richey (FL), U.S.
* on May 2009
*
*=====================================================================
/copy FUPLOAD/qrpglesrc,hspecs
/copy FUPLOAD/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 FUPLOAD/qrpglesrc,prototypeb
/copy FUPLOAD/qrpglesrc,usec
D DataLib c 'FUPLOADDT'
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 lw C CONST('abcdefghijklmnopqrstuvwxyz')
D up C CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
D extHtml s 500 inz('/fupload/html/fupload2.txt +
D /fupload/html/eot.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
* Saved query string
Dsavedquerystring...
D s 32767 varying
DnbrVars s 10i 0
D UserName s 512
d RqsMeth s 4
d Cmd s 10
d ErrMsg s 100
d browserfile s 255 dim(10)
d tempfile s 255 dim(10)
d fcount s 7 0
d hcount s 7 0
d Tstamp s z
d TstampC s 26
d x s 7 0
d tagopt s 512 varying
D rc s 10i 0
d pcfile s 255 dim(50)
d tmpfile s 255 dim(50)
d tmpcnt s 7 0
D NotValidated c '*** NOT VALIDATED ***'
C eptkey klist
C kfld eptsubp
C kfld eptsubpid
*=====================================================================
* Main line
*=====================================================================
/free
// in order to open file EXITPOINTS in library "DataLib"
rc=docmd('chgcurlib ' + DataLib);
/end-free
* Initialization:
C exsr Init
* Get Input Variables:
c exsr XGetInput
* Edit Input Variables:
c exsr XEdit
* Redisplay webpage:
c exsr XdoOutput
* Return to Caller:
C exsr Exit
*****************************************************************
*‚Get Input Variables: €*
*****************************************************************
C XGetInput BEGSR
c clear ErrMsg
c clear browserfile
c clear tempfile
c clear pcfile
c clear tmpfile
C eval nbrVars =
C zhbgetinput(savedquerystring:qusec)
C eval RqsMeth = getenv('REQUEST_METHOD':qusec)
C eval fcount = c2n2(zhbGetVarUpper('fcount')) nbr files to upload
C if fcount=0
C eval fcount=1
C endif
C callp updhtmlvar('nbrFiles':%char(fcount)) replica for Javascr.
C eval hcount = c2n2(zhbGetVarUpper('hcount'))
C eval Cmd = zhbGetVarUpper('cmd')
* Get Previous uploaded file variables:
C eval tmpcnt = zhbGetVarCnt('tmpfile')
c 1 do tmpcnt x
c eval pcfile(x) = zhbGetVar('pcfile':x)
c eval tmpfile(x) = zhbGetVar('tmpfile':x)
c enddo
* Get Uploaded File variables:
c 1 do fcount x
c eval browserfile(x) = zhbGetVar('browserfile':x)
c eval tempfile(x) =
c zhbGetVar('browserfile' + '_tempfile':x)
* Add to list of previously uploaded files:
c if tempfile(x) <> *blanks
c eval tmpcnt=tmpcnt+1
c eval pcfile(tmpcnt) = browserfile(x)
c eval tmpfile(tmpcnt) = tempfile(x)
c endif
c enddo
c endsr
*****************************************************************
*‚Edit Page: €*
*****************************************************************
C XEdit BEGSR
* Exit if 1st time for page:
c if RqsMeth = 'GET'
c eval fcount = 1
c exsr XdoOutput
c endif
* Re-Display page if file count changed:
c if fcount <> hcount
c exsr XdoOutput
c endif
* Delete previously uploaded Files:
c if cmd = 'DELETE'
c exsr XDelete
c endif
c endsr
*****************************************************************
* Create HTML Output: *
*****************************************************************
C XdoOutput begsr
* Update Time Stamp:
C callp UpdHtmlVar('Tstamp':TstampC)
* Build drop down box values:
c eval tagopt = ''
c 1 do 10 x
c eval tagopt = tagopt + CrtTagOpt(%char(x)
c :%char(x):%char(fcount))
c enddo
C callp UpdHtmlVar('fcountOpt':tagopt)
C callp UpdHtmlVar('hcount':%char(fcount))
C callp UpdHtmlVar('errmsg':errmsg)
* Beginning HTML:
* - Content-type: text/html etc.
C callp wrtsection('fuploadH0')
/free
if ActVal1Ind=*on;
callp wrtsection('valActive1');
endif;
if ActVal2Ind=*on;
callp wrtsection('valActive2');
endif;
callp wrtsection('valActiveX');
/end-free
* - <form name=form1 method=post action="/fuploadp/fupload2.pgm" enctype="multipart/form-data"
C callp wrtsection('fuploadH1')
* Write File Upload lines:
* - <input type="file" name="browserfile" size="40" device="files">
c 1 do fcount x
C callp wrtsection('fuploadD1')
c enddo
C callp wrtsection('fuploadD2')
* Write list of previously uploaded files:
* several
* <tr>
* <td>/%pcfile%/<input type="hidden" name="pcfile" value="/%pcfile%/"></td>
* <td>/%tmpfile%/<input type="hidden" name="tmpfile" value="/%tmpfile%/"></td>
* </tr>
*
c 1 do tmpcnt x
C callp UpdHtmlVar('pcfile':pcfile(x))
C callp UpdHtmlVar('tmpfile':tmpfile(x))
C callp wrtsection('fuploadD3')
C if tmpfile(x)<>NotValidated
C callp wrtsection('fuploadD3OK')
C else
C callp wrtsection('fuploadD3NOK')
C endif
c enddo
C callp wrtsection('fuploadF0')
* Flush Output Buffer:
C callp wrtsection('*fini')
* Return to Caller:
C exsr Exit
c endsr
*****************************************************************
* Delete uploaded files: *
*****************************************************************
C XDelete begsr
c 1 do tmpcnt x
C eval rc = unlink(%trim(tmpfile(x)))
c enddo
c eval tmpcnt = *zero
c endsr
*=====================================================================
* Set the validation control variables for the Javascript in the HTML
*=====================================================================
/free
Begsr SetJSVars;
//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;
// 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
*=====================================================================
* Open Files
*=====================================================================
/free
Begsr OpnF;
if not %open(CHKEXT);
rc=docmd('ovrdbf CHKEXT ' + %trim(DataLib) + '/CHKEXT +
secure(*yes) ovrscope(*job)');
open CHKEXT;
endif;
if not %open(ALWEXT);
rc=docmd('ovrdbf ALWEXT ' + %trim(DataLib) + '/ALWEXT +
secure(*yes) ovrscope(*job)');
open ALWEXT;
endif;
if not %open(EXITPOINTS);
rc=docmd('ovrdbf EXITPOINTS ' + '*curlib/EXITPOINTS +
secure(*yes) ovrscope(*job)');
open EXITPOINTS;
endif;
Endsr;
/end-free
*=====================================================================
* Close Files
*=====================================================================
/free
Begsr CloF;
if %open(CHKEXT);
close CHKEXT;
rc=docmd('dltovr CHKEXT lvl(*job)');
endif;
if %open(ALWEXT);
close ALWEXT;
rc=docmd('dltovr ALWEXT lvl(*job)');
endif;
if %open(EXITPOINTS);
close EXITPOINTS;
rc=docmd('dltovr EXITPOINTS lvl(*job)');
endif;
Endsr;
/end-free
*=====================================================================
* Return to Caller:
*=====================================================================
C Exit begsr
c* eval *inlr = *on
C return
C endsr
*=====================================================================
* Initialization:
*=====================================================================
C Init begsr
C time tstamp
C eval tstampC=%char(tstamp)
* No CGI Debugging:
c callp SetNoDebug(*on)
* Get externally described HTML
C eval IfsMultIndicators = getHtmlIfsMult(
C %trim(exthtml):'<as400>')
c callp clrHtmlBuffer
* Retrieve logged-in user name (if protection active)
C eval UserName = getenv('REMOTE_USER':qusec)
/free
//Open files
exsr OpnF;
//Set the validation global variables for the Javascript in the HTML
exsr SetJsVars;
//Check the active validations
exsr ChkActVal;
/end-free
C endsr
|