*=====================================================================
      *  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;