*=====================================================================
* RPG ILE MODULE FUPLOAD/FDNLOAD
*
* CRTBNDRPG FUPLOAD/FDNLOAD DFTACTGRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE)
*
* The technical information (download headers) that made this program possible
* was obtained on April 4, 2006 by
* Dirk Hauwaerts from Belgium
* via Easy400Group@yahoogroups.com newsgroup.
*
*=====================================================================
/copy FUPLOAD/qrpglesrc,hspecs
/copy FUPLOAD/qrpglesrc,hspecsbnd
/copy FUPLOAD/qrpglesrc,prototypeb
/copy FUPLOAD/qrpglesrc,variables3
/copy FUPLOAD/qrpglesrc,usec
*=====================================================================
*
D xfile s 1024
*
D extHtml s 2000 inz('/fupload/html/fdnload.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
*
D yrFileName s 1024
D eor s 2 inz(x'0d25')
D FileHandle s 10i 0
D BlocksOut s 20i 0
D BytesIn s 10i 0
D DataIn s 30000a
D BytesOut s 10i 0
D OutBufferInfo ds
D OutBufferP *
D OutBufferLen 10u 0
D OutBufferL s 20i 0
*
D IfsFnd s n
D IfsObjType s 11 varying
D IfsObjSize s 10i 0
*
D l s 10i 0
D r1 s 10i 0
D r2 s 10i 0
D s s 10i 0
*
D pssrInd s n
D MaxObjSize s 10u 0
*=====================================================================
/free
// Receive and parse input
nbrVars=zhbgetinput(savedquerystring:qusec);
xfile=zhbgetvar('xfile');
// Load external html
IfsMultIndicators=getHtmlIfsMult(%trim(exthtml):'<as400>');
// If input missing
if xfile=' ';
exsr Error;
wrtsection('end');
exsr Exit;
endif;
// Check the IFS object
IfsFnd=chkIfsObj2(%trim(xfile):IfsObjType:IfsObjSize);
if IfsFnd<>*on;
exsr Error;
wrtsection('error1 end');
exsr Exit;
endif;
if IfsObjType<>'*STMF';
exsr Error;
wrtsection('error2 end');
exsr Exit;
endif;
// Make up the file name "yrFileName"
l=%len(%trim(xfile));
r1=1;
s=1;
dow r1>0;
r1=%scan('/':xfile:s);
if r1>0;
s=r1+1;
endif;
enddo;
yrFileName=%subst(xfile:s:l-s+1);
// Clear the output buffer
ClrHtmlBuffer();
// Prepare headers for the output buffer
DataIn='Expires: 0' + eor +
'Cache-Control: private' + eor +
'Pragma: public' + eor +
'Content-Description: File Transfer' + eor +
'Content-Type: application/force-download' + eor +
'Content-Length: ' + %editc(IfsObjSize:'Z') + eor +
'Content-Disposition: attachment; ' +
'filename=' + %trim(yrFileName) + eor + eor;
BytesIn=%len(%trim(DataIn));
// Write headers to the output buffer
WrtNoSection(%addr(DataIn):BytesIn);
// Initialize some debugging variables
BlocksOut=0;
OutBufferInfo=GetHtmlBufferP();
OutBufferL=OutBufferLen;
// Copy the stream file to the output buffer
FileHandle=open(%trim(xfile):O_RDONLY);
if FileHandle<0;
exsr Error;
wrtsection('error3 end');
exsr Exit;
endif;
BytesIn=read(FileHandle:%addr(DataIn):%size(DataIn));
dow BytesIn>0;
if BytesIn<%size(DataIn);
BytesIn=BytesIn;
endif;
BlocksOut=BlocksOut+1;
WrtNoSection(%addr(DataIn):BytesIn);
OutBufferL=OutBufferL+BytesIn;
//Flush the buffer before it reaches a size of 16 Mb
if OutBufferL+%size(DataIn)>1638400;
wrtsection('*fini'); //send the buffer
ClrHtmlBuffer();
OutBufferL=0;
endif;
BytesIn=read(FileHandle:%addr(DataIn):%size(DataIn));
enddo;
rc=close(FileHandle);
exsr Exit;
/end-free
*=====================================================================
* Error common
*=====================================================================
/free
Begsr Error;
ClrHtmlBuffer();
updhtmlvar('xfile':xfile);
wrtsection('top error0');
Endsr;
/end-free
*=====================================================================
* Back to caller
*=====================================================================
/free
Begsr Exit;
wrtsection('*fini');
*inlr=*on;
return;
Endsr;
/end-free
*=====================================================================
* *PSSR
*=====================================================================
/free
Begsr *PSSR;
if pssrInd=*on;
pssrInd=*off;
*inlr=*on;
return;
else;
pssrInd=*on;
endif;
ClrHtmlBuffer();
exsr Error;
updhtmlvar('psdsExcTyp':psdsExcTyp);
updhtmlvar('psdsExcNbr':psdsExcNbr);
updhtmlvar('psdsStmNbr':psdsStmNbr);
updhtmlvar('outbufferl':%editc(outbufferL:'J'));
updhtmlvar('bytesin':%editc(BytesIn:'J'));
wrtsection('error5 end *fini');
*inlr=*on;
return;
Endsr;
|