First off - Thanks to Scott Klement http://www.scottklement.com/ for posting the best samples of code on the web to play with!
This is a Bizarro! example but still interesting.
The code FTP's to a windows server (or what ever) and looks for .txt files.
Those found it will display in the below window using the Dynamic screen API's:
The step that is left to finish is when the user selects the file Getting the file.
The important part here (if there is one) is the dynamic screen stuff.
The way Scott has laid out his copybook makes creation a snap.
Tell me what you think
Jamie
This is a Bizarro! example but still interesting.
The code FTP's to a windows server (or what ever) and looks for .txt files.
Those found it will display in the below window using the Dynamic screen API's:
The step that is left to finish is when the user selects the file Getting the file.
The important part here (if there is one) is the dynamic screen stuff.
The way Scott has laid out his copybook makes creation a snap.
Code:
h Option(*NODEBUGIO) DFTACTGRP(*NO) /copy current,DYNO_CP d $Screen1 pr 500a varying d Line 78a const dim(24) options(*varsize) d NumLines 10i 0 value d AnsLen 10i 0 value d DataOut 256 * * local variables * d Abort s 1n d Choice# s 10i 0 d cmdlength s 15 5 d cmdstring s 512 d dec8 s 8 0 d decimalanswer s 1 0 d end s 3 0 d endscreen1 s n d Essay s 500A d filename s 80 d foundAS400 s 3 0 d Directory s 256 varying d GrapTheFile s n d itemnumber s 7 0 d length s 10i 0 d Lines s 78A dim(24) d Mycount s 10i 0 d newname s 512 d password s 10 inz('@PASSWORD') d processing s n d Q s 1 inz('''') * dns name or Ip address d remoteIP s 15 inz('@SERVERNAME') d*remoteIP s 15 inz('192.168.1.100') d reply s 1 d screenatr s 1 d screenerror s n d start s 3 0 d string s 512 d sqlstmt s 2500 varying d teststring s 512 d theanswer s 1 d userid s 10 inz('@USERID') d workfile s 80 d workPO# s 7 0 d workPOLine# s 3 0 * * This is the return data from subprocedure $screen * left at 256 so you can add bunch more return values * d dataout ds 256 qualified inz d F3 n overlay(dataout:1) d Choice 1 overlay(dataout:*next) **--------------------------------------------------------------- * external calls **--------------------------------------------------------------- d $command pr extpgm( 'QCMDEXC' ) d cmdstring 2000 options( *varsize ) const d cmdlength 15 5 const * d mysqldata ds qualified inz d String 512 * d mysqldata2 ds qualified inz d String 512 * d mysqldata3 ds qualified inz d String 512 * * Sql functions * d openlist pr d fetchnext pr n d closelist pr **--------------------------------------------------------------- /free *inlr = *on; directory = '/pdm/data/wkgshare/pfs/AS400_AuxiliaryFolder_wl '; exec sql set option commit=*none,datfmt=*iso, closqlcsr=*ENDMOD; //-------------------------------------------------------- // M A I N L I N E //-------------------------------------------------------- // ftp to server and get directory listing exsr $OverrideFiles; exsr $ftpDirList; exsr $startftp; exsr $readoutput; return; //-------------------------------------------------------- // $ReadOutput - read the output file //-------------------------------------------------------- begsr $ReadOutput; reset choice#; // setup the title Mycount +=1; Lines(Mycount) = 'Select File to Process'; // add blank line Mycount +=1; Lines(Mycount) = *blanks; sqlstmt = 'Select * from OUTPUT'; openList(); dow fetchNext(); // look for the direcotry listing and the file name start = %scan('6-':mysqldata3.string); // don't loop forever! FoundAS400 = %scan('AS400':mysqldata3.string); if start > *zeros and FoundAS400 > *zeros; end = %scan('.txt':mysqldata3.string); if end > *zeros; length = end+4 - start; filename = %subst(mysqldata3.string:start:length); // increment the letter Choice#+=1; Mycount+=1; lines(Mycount) = ' ' + %char(Choice#) + ') ' + %trim(filename); exsr $processfile; endif; endif; enddo; closeList(); // all files .txt are listed now show screen if Mycount <= 2; Mycount+=1; lines(Mycount) = '** No Records Found **'; endif; reset endscreen1; dow not(EndScreen1); if not(screenerror); lines(20) = *blanks; endif; reset dataout; Dataout = $Screen1(lines:20:1:DataOut); reset screenerror; // this is the error line select; when dataout.F3 = *on; EndScreen1 = *on; return; other; // check answer TheAnswer = dataout.choice; exsr $validate; if not(screenerror); exsr $getthefile; endif; endsl; enddo; endsr; //-------------------------------------------------------- // $Validate - validate the return selection //-------------------------------------------------------- begsr $Validate; reset screenerror; // validate the answer if %check(' 0123456789':TheAnswer) > *zeros; lines(20) = 'Entry ' + TheAnswer + ' is invalid'; screenerror = *on; else; TheAnswer = %xlate(' ':'0':TheAnswer); DecimalAnswer = %dec(TheAnswer:1:0); if DecimalAnswer > Choice#; lines(20) = 'Entry ' + TheAnswer + ' is Greater than ' + %char(choice#); screenerror = *on; endif; endif; endsr; //-------------------------------------------------------- // $GettheFile - get the file from FTP and process it //-------------------------------------------------------- begsr $GettheFile; endsr; //-------------------------------------------------------- // $ProcessFile - grab the file and do the work //-------------------------------------------------------- begsr $ProcessFile; // create pf in qtemp and do processing cmdstring = 'CRTPF QTEMP/MYFILE RCDLEN(512) '; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring : cmdlength); on-error; cmdstring = 'CLRPFM QTEMP/MYFILE '; cmdlength = %len(%trim(cmdstring)); endmon; // remove any get commands from the imput file exec sql delete from QTEMP/MYFILE where myfile like '%MYFILE%'; exec sql delete from QTEMP/INPUT where myfield like '%DIR%'; processing = *on; exsr $OverrideFiles; exsr $FtpDirList; processing = *off; mysqldata2.String = 'Get ' + %trim(filename) + ' QTEMP/MYFILE' + ' (replace '; exec sql insert into QTEMP/INPUT values(:mysqldata2); // change extension of .txt file to .done workfile = Filename; end = %scan('.txt':workfile); %subst(workfile:end:5) = '.done'; mysqldata2.String = 'Rename ' + %trim(filename) + ' ' + %trim(workfile); // exec sql // insert into QTEMP/INPUT values(:mysqldata2); exsr $startFTP; endsr; //-------------------------------------------------------- // $OverrideFiles - create input & output override files //-------------------------------------------------------- begsr $OverrideFiles; cmdstring = 'DLTOVR INPUT'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring : cmdlength); on-error; endmon; cmdstring = 'DLTOVR OUTPUT'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring : cmdlength); on-error; endmon; cmdstring = 'CLRPFM FILE(QTEMP/INPUT)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring : cmdlength); on-error; exec sql create table QTEMP/INPUT (MyField char(512)); endmon; cmdstring = 'CLRPFM FILE(QTEMP/OUTPUT)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring : cmdlength); on-error; exec sql create table QTEMP/OUTPUT (MyField char(512)); endmon; endsr; //-------------------------------------------------------- // $FtpDirList - get direcotory listing //-------------------------------------------------------- begsr $FtpDirList; // commands to run on server mysqldata2.string = %trim(userid) + ' ' + %trim(password); exec sql insert into QTEMP/INPUT values(:mysqldata2); mysqldata2.String = 'ASCII'; exec sql insert into QTEMP/INPUT values(:mysqldata2); mysqldata2.String = 'cd ' + directory; exec sql insert into QTEMP/INPUT values(:mysqldata2); if processing = *off; mysqldata2.String = 'Dir ' ; endif; exec sql insert into QTEMP/INPUT values(:mysqldata2); cmdstring = 'OVRDBF FILE(INPUT) TOFILE(QTEMP/INPUT)' + ' OVRSCOPE(*JOB) '; cmdlength = %len(%trim(cmdstring)); $command(cmdstring : cmdlength); cmdstring = 'OVRDBF FILE(OUTPUT) TOFILE(QTEMP/OUTPUT)' + ' OVRSCOPE(*JOB) '; cmdlength = %len(%trim(cmdstring)); $command(cmdstring : cmdlength); endsr; //-------------------------------------------------------- // $StartFTP; Start FTP... //-------------------------------------------------------- begsr $StartFTP; cmdstring = 'STRTCPFTP ' + Q + %trim(remoteIp) + Q ; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring : cmdlength); on-error; endmon; endsr; /end-free *-------------------------------------------------------- * $Screen1(): Show Screen1 (Remote files via FTP) * * Line = (input) array of lines of text containing * the question to ask * NumLines = (input) number of lines in the Line array * AnsLen = (input) size of answer blank * DataOut = (output) position 1 F3 positon 2 answer * * Returns the user's answer *-------------------------------------------------------- p $Screen1 B d $Screen1 PI 500A varying d Line 78A const d dim(24) options(*varsize) d NumLines 10I 0 value d AnsLen 10I 0 value d DataOut 256 d cmdbuf s like(Qsn_Cmd_Buf_T) d inpbuf s like(Qsn_Inp_Buf_T) d prompt s 70A varying d NRF s 50 inz('** No Records Found **') d skipthis s n d len s 10I 0 d data s 132A varying d x s 10I 0 d Row s 3U 0 d Answer s 500A varying * d InputData ds qualified d based(p_InputData) d Row 3U 0 d Col 3U 0 d AID 1A d Field 500A /free // ---------------------------------------------- // Create Input/Output buffers and clear them // ---------------------------------------------- cmdbuf = QsnCrtCmdBuf(100: 50: 0: *OMIT: *OMIT); inpbuf = QsnCrtInpBuf(200: 50: 0: *OMIT: *OMIT); QsnClrBuf( cmdbuf : *omit ); QsnClrBuf( inpbuf : *omit ); // ---------------------------------------------- // Add the "Clear Screen" command to the output // so that the terminal starts with an empty // screen. // ---------------------------------------------- QsnClrScr( *omit : cmdbuf : *omit : *omit ); // ---------------------------------------------- // Put a screen title in the output buffer // ---------------------------------------------- data = 'Select File to download and process.'; QsnWrtDta( data : %len(data) : *omit : 1 : 40 - (%len(data)/2) // center : QSN_SA_HI : QSN_SA_HI : QSN_SA_WHT : QSN_SA_WHT : cmdbuf : *omit : *omit ); // ---------------------------------------------- // Put the filename on rows 3+ of the output buf // ---------------------------------------------- row = 2; for x = 1 to NumLines; row +=1; Select; when row = 3; ScreenAtr = QSN_SA_PNK_UL; Length = 22; when row = 22; ScreenAtr = QSN_SA_RED; Length = %len(line(x)); other; ScreenAtr = QSN_SA_GRN; Length = %len(line(x)); endsl; if %scan(%trim(NRF):Line(x)) > *zeros; SkipThis = *on; endif; QsnWrtDta( Line(x) : Length : *omit : row : 2 : QSN_SA_NORM : QSN_SA_NORM : ScreenAtr : QSN_SA_GRN : cmdbuf : *omit : *omit ); endfor; // ---------------------------------------------- // Put an underlined blank input field into the // output buffer so the user has a place to // answer.. This is on Row 21 // ---------------------------------------------- if not(SkipThis); QsnSetFld( *omit : AnsLen : 21 : 2 : QSN_FFW_ALPHA_SHIFT : *omit : 0 : QSN_SA_UL : QSN_SA_GRN_UL : cmdbuf : *omit : *omit ); endif; // ---------------------------------------------- // Let the user know how to exit (color blue) // ---------------------------------------------- QsnWrtDta( 'F3=Exit' : %len('F3=Exit') : *omit : 23 : 2 : QSN_SA_HI : QSN_SA_NORM : QSN_SA_BLU : QSN_SA_GRN : cmdbuf : *omit : *omit ); // ---------------------------------------------- // put the "unlock keyboard" command into the // output buffer // ---------------------------------------------- QsnReadInp( QSN_CC1_MDTALL_CLRALL : QSN_CC2_UNLOCKBD : *omit : *omit : cmdbuf : *omit : *omit ); // ---------------------------------------------- // send the output buffer to the terminal, and // wait for input from the user // ---------------------------------------------- QsnPutGetBuf( cmdbuf: inpbuf: *omit: *omit); // ---------------------------------------------- // Get a pointer to the input data, and the // length of the input data. // ---------------------------------------------- p_InputData = QsnRtvDta( inpbuf: *omit: *omit ); Len = QsnRtvDtaLen(inpbuf: *omit: *omit) - %size(InputData.ROW) - %size(InputData.COL) - %size(InputData.AID); // ---------------------------------------------- // Copy the answer from the buffer // ---------------------------------------------- if (Len > 0); Answer = %trim( %subst( InputData.field: 1: len) ); %subst(dataout:2:1) = Answer; endif; // ---------------------------------------------- // Clean up the buffers, and return to caller // ---------------------------------------------- QsnDltBuf(cmdbuf: *omit); QsnDltBuf(inpbuf: *omit); %subst(dataout:1:1) = '0'; if (InputData.AID = QSN_F3); %subst(dataout:1:1) = '1'; endif; // return Variable return dataout; /end-free P E *-------------------------------------------------------- * openList - Open a cursor to read file *-------------------------------------------------------- p openList b d openList pi /free exec sql declare MyCursor cursor for statement; exec sql prepare statement from :sqlstmt; exec sql open mycursor; /End-Free p openList e *-------------------------------------------------------- * fetchNext - read one record at a time *-------------------------------------------------------- p fetchNext b d fetchNext pi n /free exec sql fetch next from mycursor into : mysqldata3; if sqlstt < '02000'; return *on; else; return *off; endif; /end-free p fetchnext e *-------------------------------------------------------- * closeOrderList - Close the OrderHdr cursor *-------------------------------------------------------- p closeList b d closeList pi /free exec sql close MyCursor; /end-free p closeList e *--------------------------------------------------------
Jamie
Comment