Program FTP's to a directory lists the files then allows users to download.
You will need to make adjustments for this to work for you..
![Click image for larger version
Name: dyno.jpg
Views: 2
Size: 31.9 KB
ID: 127922](filedata/fetch?id=127922&d=1396886733)
Copy book
You will need to make adjustments for this to work for you..
PHP 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
*--------------------------------------------------------
PHP Code:
/if defined(QSNAPI_H)
/eof
/endif
/define QSNAPI_H
*-------------------------------------------------------------
* Simple data types
*-------------------------------------------------------------
D Q_Handle_T s 10I 0 based(Template)
D Qsn_Cmd_Buf_T s like(Q_Handle_T) based(Template)
D Qsn_Inp_Buf_T s like(Q_Handle_T) based(Template)
D Qsn_Env_T s like(Q_Handle_T) based(Template)
D QSN_FAIL c -1
*-------------------------------------------------------------
* QsnCrtCmdBuf(): Create command buffer
*-------------------------------------------------------------
D QsnCrtCmdBuf PR 10I 0 extproc('QsnCrtCmdBuf')
D InitSize 10I 0 const
D IncrAmt 10I 0 const options(*omit)
D MaxSize 10I 0 const options(*omit)
D Handle 10I 0 options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnCrtInpBuf(): Create Input Buffer
*-------------------------------------------------------------
D QsnCrtInpBuf PR 10I 0 extproc('QsnCrtInpBuf')
D BufSize 10I 0 const
D IncrAmt 10I 0 const options(*omit)
D MaxSize 10I 0 const options(*omit)
D Handle 10I 0 options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnClrBuf(): Clear/Reset Buffer (any type)
*-------------------------------------------------------------
D QsnClrBuf PR 10I 0 extproc('QsnClrBuf')
D BufHandle 10I 0 const
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnDltBuf(): Delete buffer (any type)
*-------------------------------------------------------------
D QsnDltBuf PR 10I 0 extproc('QsnDltBuf')
D BufHandle 10I 0 const
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnClrScr(): Clear screen
*-------------------------------------------------------------
D QsnClrScr PR 10I 0 extproc('QsnClrScr')
D mode 1A const options(*omit)
D cmdbuf 10I 0 const options(*omit)
D LowEnvHandle 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnWrtDta(): Write data to the display
*-------------------------------------------------------------
D QsnWrtDta PR 10I 0 extproc('QsnWrtDta')
D Data 32767A const options(*varsize)
D DataLen 10I 0 const
D FieldID 10I 0 const options(*omit)
D Row 10I 0 const options(*omit)
D Column 10I 0 const options(*omit)
D StrMonoAttr 1A const options(*omit)
D EndMonoAttr 1A const options(*omit)
D StrColorAttr 1A const options(*omit)
D EndColorAttr 1A const options(*omit)
D CmdBufHandle 10I 0 const options(*omit)
D LowEnvHandle 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnSetFld(): Add a field to the display
*-------------------------------------------------------------
D QsnSetFld PR 10I 0 extproc('QsnSetFld')
D FieldID 10I 0 const options(*omit)
D FieldLen 10I 0 const options(*omit)
D Row 10I 0 const options(*omit)
D Column 10I 0 const options(*omit)
D FFW 2A const options(*omit)
D FCW 2A const dim(32767)
D options(*omit: *varsize)
D NumOfFCW 10I 0 const options(*omit)
D MonoAttr 1A const options(*omit)
D ColorAttr 1A const options(*omit)
D CmdBufHandle 10I 0 const options(*omit)
D LowEnvHandle 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnReadInp(): Read data and wait for AID key
*-------------------------------------------------------------
D QsnReadInp PR 10I 0 extproc('QsnReadInp')
D CC1 1A const
D CC2 1A const
D DataBytes 10I 0 options(*omit)
D InpBufHandle 10I 0 options(*omit)
D CmdBufHandle 10I 0 options(*omit)
D LowEnvHandle 10I 0 options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnPutGetBuf(): Send command output buffer to terminal
* then wait for input buffer from terminal
*-------------------------------------------------------------
D QsnPutGetBuf PR 10I 0 extproc('QsnPutGetBuf')
D CmdBufHandle 10I 0 const
D InpBufHandle 10I 0 const
D LowEnvHandle 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnRtvDta(): Get pointer to input data in input buffer
*-------------------------------------------------------------
D QsnRtvDta PR * extproc('QsnRtvDta')
D InpBufHandle 10I 0 const
D PtrToData * const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnRtvDtaLen(): Get length of input data in input buffer
*-------------------------------------------------------------
D QsnRtvDtaLen PR 10I 0 extproc('QsnRtvDtaLen')
D InpBufHandle 10I 0 const
D DataLen 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
*
*-------------------------------------------------------------
D Qsn_Env_Desc_T...
D DS qualified based(Template)
D color_support 1A
D CDRA 1A
D CDRA_3F 1A
D DBCS_support 1A
D coexist 1A
D alt_help 1A
D tgt_dev 10A
D disp_file 20A
D invite_active 1A
D prevent_ovrd 1A
*-------------------------------------------------------------
*
*-------------------------------------------------------------
D Qsn_Env_Rtv_Desc_T...
D DS qualified based(Template)
D bytes_rtn 10I 0
D bytes_avail 10I 0
D color_support 1A
D CDRA 1A
D CDRA_3F 1A
D DBCS_support 1A
D coexist 1A
D alt_help 1A
D tgt_dev 10A
D dsp_file 20A
D invite_active 1A
D prevent_ovrd 1A
*-------------------------------------------------------------
* Constants used for creating/querying the environment
*-------------------------------------------------------------
D QSN_COLOR_NO...
D C '1'
D QSN_COLOR_YES...
D C '2'
D QSN_COLOR_SELECT...
D C '3'
D QSN_CDRA_STD...
D C '1'
D QSN_CDRA_CNVT...
D C '2'
D QSN_DBCS_STD...
D C '1'
D QSN_DBCS_ONLY...
D C '2'
D QSN_DBCS_EITHER...
D C '3'
D QSN_DBCS_MIXED...
D C '4'
D QSN_COEXIST_YES...
D C '1'
D QSN_COEXIST_NO...
D C '2'
D QSN_ALTHELP_NO...
D C '1'
D QSN_TGT_REQ...
D C '*REQUESTER'
D QSN_INVITE_NO...
D C '1'
D QSN_INVITE_YES...
D C '2'
D QSN_PREVENT_OVERRIDE_NO...
D C '1'
D QSN_PREVENT_OVERRIDE_YES...
D C '2'
D QSN_SAME C '0'
D QSN_DSP03 C '3'
D QSN_DSP04 C '4'
*-------------------------------------------------------------
* AID keys (function keys, et al)
*-------------------------------------------------------------
D Qsn_F1 C X'31'
D Qsn_F2 C X'32'
D Qsn_F3 C X'33'
D Qsn_F4 C X'34'
D Qsn_F5 C X'35'
D Qsn_F6 C X'36'
D Qsn_F7 C X'37'
D Qsn_F8 C X'38'
D Qsn_F9 C X'39'
D Qsn_F10 C X'3A'
D Qsn_F11 C X'3B'
D Qsn_F12 C X'3C'
D Qsn_F13 C X'B1'
D Qsn_F14 C X'B2'
D Qsn_F15 C X'B3'
D Qsn_F16 C X'B4'
D Qsn_F17 C X'B5'
D Qsn_F18 C X'B6'
D Qsn_F19 C X'B7'
D Qsn_F20 C X'B8'
D Qsn_F21 C X'B9'
D Qsn_F22 C X'BA'
D Qsn_F23 C X'BB'
D Qsn_F24 C X'BC'
D Qsn_SLP C X'3F'
D Qsn_FET C X'50'
D Qsn_PA1 C X'6C'
D Qsn_PA2 C X'6E'
D Qsn_PA3 C X'6B'
D Qsn_Clear C X'BD'
D Qsn_Enter C X'F1'
D Qsn_Help C X'F3'
D Qsn_RollDown C X'F4'
D Qsn_RollUp C X'F5'
D Qsn_PageUp C X'F4'
D Qsn_PageDown C X'F5'
D Qsn_Print C X'F6'
D Qsn_RecBS C X'F8'
DQsn5250QY C '1'
DQsn5250QN C '2'
DQsn5250QF C '3'
*-------------------------------------------------------------
* Control Characters ( CC1 & CC2 )
*-------------------------------------------------------------
D QSN_CC1_NULL...
D C X'00'
D QSN_CC1_LOCKBD...
D C X'20'
D QSN_CC1_MDTNBY...
D C X'40'
D QSN_CC1_MDTALL...
D C X'60'
D QSN_CC1_CLRMOD...
D C X'80'
D QSN_CC1_MDTNBY_CLRALL...
D C X'A0'
D QSN_CC1_MDTNBY_CLRMOD...
D C X'C0'
D QSN_CC1_MDTALL_CLRALL...
D C X'E0'
D QSN_CC2_NULL...
D C X'00'
D QSN_CC2_NO_IC...
D C X'40'
D QSN_CC2_RST_CSR_BL...
D C X'20'
D QSN_CC2_SET_CSR_BL...
D C X'10'
D QSN_CC2_UNLOCKBD...
D C X'08'
D QSN_CC2_ALARM...
D C X'04'
D QSN_CC2_MSG_OFF...
D C X'02'
D QSN_CC2_MSG_ON...
D C X'01'
*-------------------------------------------------------------
* Screen Attributes
*-------------------------------------------------------------
D QSN_NO_SA...
D C X'00'
D QSN_SA_NORM...
D C X'20'
D QSN_SA_CS...
D C X'30'
D QSN_SA_BL...
D C X'28'
D QSN_SA_UL...
D C X'24'
D QSN_SA_HI...
D C X'22'
D QSN_SA_RI...
D C X'21'
D QSN_SA_ND...
D C X'27'
D QSN_SA_GRN...
D C X'20'
D QSN_SA_GRN_RI...
D C X'21'
D QSN_SA_WHT...
D C X'22'
D QSN_SA_WHT_RI...
D C X'23'
D QSN_SA_GRN_UL...
D C X'24'
D QSN_SA_GRN_UL_RI...
D C X'25'
D QSN_SA_WHT_UL...
D C X'26'
D QSN_SA_RED...
D C X'28'
D QSN_SA_RED_RI...
D C X'29'
D QSN_SA_RED_BL...
D C X'2A'
D QSN_SA_RED_RI_BL...
D C X'2B'
D QSN_SA_RED_UL...
D C X'2C'
D QSN_SA_RED_UL_RI...
D C X'2D'
D QSN_SA_RED_UL_BL...
D C X'2E'
D QSN_SA_ND_2F...
D C X'2F'
D QSN_SA_TRQ_CS...
D C X'30'
D QSN_SA_TRQ_CS_RI...
D C X'31'
D QSN_SA_YLW_CS...
D C X'32'
D QSN_SA_YLW_CS_RI...
D C X'33'
D QSN_SA_TRQ_UL...
D C X'34'
D QSN_SA_TRQ_UL_RI...
D C X'35'
D QSN_SA_YLW_UL...
D C X'36'
D QSN_SA_ND_37...
D C X'37'
D QSN_SA_PNK...
D C X'38'
D QSN_SA_PNK_RI...
D C X'39'
D QSN_SA_BLU...
D C X'3A'
D QSN_SA_BLU_RI...
D C X'3B'
D QSN_SA_PNK_UL...
D C X'3C'
D QSN_SA_PNK_UL_RI...
D C X'3D'
D QSN_SA_BLU_UL...
D C X'3E'
D QSN_SA_ND_3F...
D C X'3F'
*-------------------------------------------------------------
* Ideographic shift-in and shift-out
*-------------------------------------------------------------
D QSN_SO C X'0E'
D QSN_SI C X'0F'
*-------------------------------------------------------------
* Field Format Words
*-------------------------------------------------------------
D QSN_NO_FFW C X'0000'
D QSN_FFW_BYPASS C X'6000'
D QSN_FFW_DUP C X'5000'
D QSN_FFW_MDT C X'4800'
D QSN_FFW_ALPHA_SHIFT...
D C X'4000'
D QSN_FFW_ALPHA_ONLY...
D C X'4100'
D QSN_FFW_NUM_SHIFT...
D C X'4200'
D QSN_FFW_NUM_ONLY...
D C X'4300'
D QSN_FFW_KATA...
D C X'4400'
D QSN_FFW_DIGIT_ONLY...
D C X'4500'
D QSN_FFW_IO...
D C X'4600'
D QSN_FFW_SIGNED_NUMERIC...
D C X'4700'
D QSN_FFW_AUTO_ENTER...
D C X'4080'
D QSN_FFW_FER...
D C X'4040'
D QSN_FFW_AUTO_FER...
D C X'4040'
D QSN_FFW_MONOCASE...
D C X'4020'
D QSN_FFW_AUTO_MONOCASE...
D C X'4020'
D QSN_FFW_ME...
D C X'4008'
D QSN_FFW_NOADJUST...
D C X'4000'
D QSN_FFW_RA_ZERO...
D C X'4005'
D QSN_FFW_RA_BLANK...
D C X'4006'
D QSN_FFW_MF...
D C X'4007'
D QSN_FCW_RESEQ...
D C X'8000'
D QSN_FCW_MSR...
D C X'8101'
D QSN_FCW_SLP...
D C X'8102'
D QSN_FCW_MSR_SLP...
D C X'8103'
D QSN_FCW_SLP_SA...
D C X'8106'
D QSN_FCW_DBCS_ONLY...
D C X'8200'
D QSN_FCW_DBCS_PURE...
D C X'8220'
D QSN_FCW_DBCS_EITHER...
D C X'8240'
D QSN_FCW_DBCS_OPEN...
D C X'8280'
D QSN_FCW_DBCS_OPEN_CO...
D C X'82C0'
D QSN_FCW_TRANSPARENT...
D C X'8400'
D QSN_FCW_FET...
D C X'8501'
D QSN_FCW_CONT_FIRST...
D C X'8601'
D QSN_FCW_CONT_LAST...
D C X'8602'
D QSN_FCW_CONT_MIDDLE...
D C X'8603'
D QSN_FCW_CP...
D C X'8800'
D QSN_FCW_HL...
D C X'8900'
D QSN_FCW_PDS...
D C X'8A00'
D QSN_FCW_MOD11...
D C X'B140'
D QSN_FCW_MOD10...
D C X'B1A0'
D QSN_READ_INP...
D C X'42'
D QSN_READ_MDT...
D C X'52'
D QSN_READ_IMM...
D C X'72'
D QSN_READ_MDT_ALT...
D C X'82'
/if defined(TO_BE_CONVERTED_LATER)
*
* Structure definitions.
*
DQsnEnvExtI DS
* Data structure for QsnCrtEnv API.
D QsnEEDta *
D QsnEEChg * procptr
D QsnEEDlt * procptr
DQsnEnvWM DS
* Data structures for QsnSetEnvWinMod API.
D QsnEWAtrC 1A
D QsnEWULR 10I 0
D QsnEWULC 10I 0
D QsnEWNumR 10I 0
D QsnEWNumC 10I 0
DQsnREnvWM DS
* Data structures for QsnRtvEnvWinMod API.
D QsnREWRet 10I 0
D QsnREWAvl 10I 0
D QsnREWMode 1A
D QsnREWAtr 1A
D QsnREWULR 10I 0
D QsnREWULC 10I 0
D QsnREWNumR 10I 0
D QsnREWNumC 10I 0
DQsnQ5250 DS
* Data structure for QsnQry5250 API.
D QsnQ5Ret 10I 0
D QsnQ5Avl 10I 0
D QsnQ5Stat 1A
D QsnQ5Wkstn 4B 0
D QsnQ5CLvl 3A
D QsnQ5R1 16A
D QsnQ5WType 1A
D QsnQ5MType 4A
D QsnQ5Model 3A
D QsnQ5KbdID 1A
D QsnQ5EKbd 1A
D QsnQ5PcKbd 1A
D QsnQ5SNum 4A
D QsnQ5MaxIn 4B 0
D QsnQ5WSCSp 2A
D QsnQ5R2 1A
D QsnQ5WSCB1 1A
D QsnQ5WSCB2 1A
D QsnQ5WSCB3 1A
D QsnQ5WSCB4 1A
D QsnQ5WSCB5 1A
D QsnQ5R3 5A
D QsnQ5Prt 1A
D QsnQ5R4 1A
D QsnQ5GrdBf 1A
D QsnQ5R5 9A
*Note: this may be expanded in the future
DQsnReadInf DS
* Data structure for QsnRtvReadInf API.
D QsnRIRet 10I 0
D QsnRIAvl 10I 0
D QsnRIR1 8A
D QsnRIDta *
D QsnRIFDta *
D QsnRIDtaL 10I 0
D QsnRIFDtaL 10I 0
D QsnRINumF 10I 0
D ReadLen 10I 0
D QsnRIRow 10I 0
D QsnRICol 10I 0
D QsnRIAID 1A
D QsnRIR2 7A
DQsnFldInf DS
* Data structure for QsnRtvFldInf API.
D QsnFIRet 10I 0
D QsnFIAvl 10I 0
D QsnFIType 1A
D QsnFIRow 10I 0
D QsnFICol 10I 0
D QsnFIFDtaL 10I 0
D QsnFIR1 11A
D QsnFIDta *
DQsnWinExtI DS
* Data structure for QsnCrtWin API
D QsnWEDta *
D QsnWEChg * procptr
D QsnWEDlt * procptr
D QsnWECoord * procptr
D QsnWEDraw * procptr
D QsnWECur * procptr
DQsnWinD DS
* Data structures for QsnCrtWin and QsnChgWin APIs.
D QsnWTopR 10I 0
D QsnWLeftC 10I 0
D QsnWNumR 10I 0
D QsnWNumC 10I 0
D QsnWMinR 10I 0
D QsnWMinC 10I 0
D QsnWMaxR 10I 0
D QsnWMaxC 10I 0
D QsnWFS 1A
D QsnWAtrM1 1A
D QsnWAtrM2 1A
D QsnWAtrM3 1A
D QsnWAtrC1 1A
D QsnWAtrC2 1A
D QsnWAtrC3 1A
D QsnWShowB 1A
D QsnWShowBA 1A
D QsnWShowLA 1A
D QsnWShowRA 1A
D QsnWMsgL 1A
D QsnWULCh 1A
D QsnWTopCh 1A
D QsnWURCh 1A
D QsnWLCh 1A
D QsnWRCh 1A
D QsnWLLCh 1A
D QsnWBotCh 1A
D QsnWLRCh 1A
D QsnWGUI 1A
D QsnWFlg1 1A
D QsnWFlg2 1A
D QsnWR1 1A
D QsnWBdrF 1A
D QsnWTtlF 1A
D QsnWTAtrM 1A
D QsnWTAtrC 1A
D QsnWR2 1A
D QsnWR3 3A
D QsnWTtlO 10I 0
D QsnWTtlL 10I 0
D QsnWR4 10I 0
DQsnRWinD DS
* Data structure for QsnRtvWinD API.
D QsnRWRet 10I 0
D QsnRWAvl 10I 0
D QsnRWTopR 10I 0
D QsnRWLeftC 10I 0
D QsnRWNumR 10I 0
D QsnRWNumC 10I 0
D QsnRWMinR 10I 0
D QsnRWMinC 10I 0
D QsnRWMaxR 10I 0
D QsnRWMaxC 10I 0
D QsnRWFS 1A
D QsnRWAtrM1 1A
D QsnRWAtrM2 1A
D QsnRWAtrM3 1A
D QsnRWAtrC1 1A
D QsnRWAtrC2 1A
D QsnRWAtrC3 1A
D QsnRWShwB 1A
D QsnRWShwBA 1A
D QsnRWShwLA 1A
D QsnRWShwRA 1A
D QsnRWMsgL 1A
D QsnRWULCh 1A
D QsnRWTopCh 1A
D QsnRWURCh 1A
D QsnRWLCh 1A
D QsnRWRCh 1A
D QsnRWLLCh 1A
D QsnRWBotCh 1A
D QsnRWLRCh 1A
D QsnRWGUI 1A
D QsnRWFlg1 1A
D QsnRWFlg2 1A
D QsnRWR1 1A
D QsnRWBdrF 1A
D QsnRWTtlF 1A
D QsnRWTAtrM 1A
D QsnRWTAtrC 1A
D QsnRWR2 1A
D QsnRWR3 3A
D QsnRWTtlO 10I 0
D QsnRWTtlL 10I 0
D QsnRWR4 10I 0
DQsnSsnExtI DS
* Data structure for QsnCrtSsn API
D QsnSEDta *
D QsnSEChg * procptr
D QsnSEDlt * procptr
D QsnSECoord * procptr
D QsnSEDraw * procptr
D QsnSECur * procptr
DQsnSsnD DS
* Data structure for QsnCrtSsn and QsnChgSsn APIs
D QsnSActn * procptr Dim(24)
D QsnSTRow 10I 0
D QsnSLCol 10I 0
D QsnSNRows 10I 0
D QsnSNCols 10I 0
D QsnSRollA 10I 0
D QsnSShftA 10I 0
D QsnSISize 10I 0
D QsnSMSize 10I 0
D QsnSIncr 10I 0
D QsnSIRows 10I 0
D QsnSR1 1A
D QsnSWrap 1A
D QsnSR2 1A
D QsnEBCDIC 1A
D QsnSEcho 1A
D QsnSLDsp 1A
D QsnSCDsp 1A
D QsnSShowC 1A
D QsnSCmdAM 1A
D QsnSCmdAC 1A
D QsnSInLAM 1A
D QsnSInLAC 1A
D QsnSPmtO 10I 0
D QsnSPmtL 10I 0
D QsnSCmdO1 10I 0
D QsnSCmdL1 10I 0
D QsnSCmdO2 10I 0
D QsnSCmdL2 10I 0
D QsnSR4 20A
DQsnRSsnD DS
* Data structure for QsnRtvSsnD APIs
D QsnRSRet 10I 0
D QsnRSAvl 10I 0
D QsnRSR1 8A
D QsnRSActn * procptr Dim(24)
D QsnRSTRow 10I 0
D QsnRSLCol 10I 0
D QsnRSNRows 10I 0
D QsnRSNCols 10I 0
D QsnRSRollA 10I 0
D QsnRSShftA 10I 0
D QsnRSISize 10I 0
D QsnRSMSize 10I 0
D QsnRSIncr 10I 0
D QsnRSIRows 10I 0
D QsnRSR2 1A
D QsnRSWrap 1A
D QsnRSR3 1A
D QsnREBCDIC 1A
D QsnRSEcho 1A
D QsnRSLDsp 1A
D QsnRSCDsp 1A
D QsnRSShowC 1A
D QsnRSCmdAM 1A
D QsnRSCmdAC 1A
D QsnRSInLAM 1A
D QsnRSInLAC 1A
D QsnRSPmtO 10I 0
D QsnRSPmtL 10I 0
D QsnRSCmdO1 10I 0
D QsnRSCmdL1 10I 0
D QsnRSCmdO2 10I 0
D QsnRSCmdL2 10I 0
D QsnRSR5 20A
/endif
Comment