Transcript WMSUGModernRPGUnreal..

Modern RPG – Unrealized Capabilities as easy as A. B. C…
Agenda
A.
Procedures – Use them!!
B. Tools in RPGLE
C. SQL
D. Sockets
Demo 1
E. Auto Refresh a screen in a program
F. JDBC in RPGLE
G. User Spaces with Pointers
Demo 2
H. CEE Language and UNIX style API’s
I.
ENCRYPTION
J. Random #’s
K. PHP Command Line calls
Modern RPG – Unrealized Capabilities George L. Slater
1
A. Procedures – Use Them!!!
Procedures – Use them!
• ILE Structure – any program can call any other
ILE routine
• Gained access to C from RPGLE
• UNIX socket stuff from RPGLE
• Write your own Built-In functions
• Locally scoped variables so we don’t step on
ourself – i(ndex) used multiple places ok
• Recursive calls of procedures
• That’s the platform – or basis we’re using – all
of these use C language API’s
Modern RPG – Unrealized Capabilities George L. Slater
2
B. Tools in RPGLE
Tools in RPGLE
• Another way for QCmdExec
• Sleep instead of DlyJob
• What is System Catalog?
• Instead of DSPFFD – SYSCOLUMNS
• TABLE_NAME = File Name
• TABLE_SCHEMA = Library
Modern RPG – Unrealized Capabilities George L. Slater
3
B. Tools in RPGLE
QCmdExec 1 of 4
Another way for QCmdExec
The traditional way:
C
C
C
C
C
C
Or
/Free
Eval
Eval
Call
Parm
Parm
Command = ‘CHKOBJ QTEMP/WORKFILE –
OBJTYPE(*FILE)’
Length = %Len(Command)
‘QCMDEXC’
Command
Length
Command = ‘CHKOBJ QTEMP/WORKFILE OBJTYPE(*FILE)’;
Length = %Len(Command);
QCMDEXEC(Command:Length);
/End-Free
Modern RPG – Unrealized Capabilities George L. Slater
4
50
B. Tools in RPGLE
QCmdExec 2 of 4
Another way for QCmdExec
Drawbacks of traditional way:
• Command must be assembled into a variable.
• Length of data is required
• While you can determine if the command was
successful or not, you cannot determine why it
might have failed.
Modern RPG – Unrealized Capabilities George L. Slater
5
B. Tools in RPGLE
QCmdExec 3 of 4
Another way for QCmdExec
The better approach – MODERN RPG:
H BndDir(‘QC2LE’)
D ExecCmd
D Command
Pr
10i 0
*
ExtProc(‘system’)
Value Option(*String)
D CPFError
s
7
Import(‘_EXCP_MSGID’)
/Free
Reset CPFError;
ExecCmd(‘CHKOBJ ‘ + %Trim(WorkLib) + ‘/’ + %Trim(WorkFile) +
‘ OBJTYPE(*FILE)’);
If CPFError = ‘CPF9084’;
// do stuff
EndIf;
/End-Free
5/15/2013 Update to source above ** Reset CPFError; Should be
Clear CPFError;
Modern RPG – Unrealized Capabilities George L. Slater
6
B. Tools in RPGLE
QCmdExec 4 of 4
Another way for QCmdExec
Modern RPG benefits:
• Now you can get the same functionality you do in
CL programs, including all the
• added variable handling,
• I/O, and
• looping capability that you have in RPG.
Modern RPG – Unrealized Capabilities George L. Slater
7
B. Tools in RPGLE
DlyJob 1 of 2
Sleep instead of DlyJob
The traditional way:
C
C
C
C
C
Eval
Eval
Call
Parm
Parm
Command = ‘DLYJOB DLY(@num_sec)’
Length = %Len(Command)
‘QCMDEXC’
50
Command
Length
Or
/Free
Command = ‘DLYJOB DLY(@num_sec)’;
Length = %Len(Command);
QCMDEXEC(Command:Length);
/End-Free
Modern RPG – Unrealized Capabilities George L. Slater
8
B. Tools in RPGLE
DlyJob 2 of 2
Sleep instead of DlyJob
The better approach – MODERN RPG:
H BndDir(‘QC2LE’)
D wait
D seconds
Pr
extProc(‘sleep’)
10u 0 Const
/Free
// have the program wait 10 seconds.
wait(10);
/End-Free
Modern RPG – Unrealized Capabilities George L. Slater
9
B. Tools in RPGLE
System Catalog 1 of 1
What is System Catalog?
You can use it to create your own display utilities for file
definitions and record formats without the need to
use DSPFD or DSPFFD, or DSPDBR.
QSYS2/SYSTABLES
QSYS2/SYSINDEXES
QSYS2/SYSCOLUMNS
QSYS2/SYSPINDEX
File/Table definitions
Logical File/Index definitions
Column definitions
Primary Index (Physical File Key)
definitions
… and many more
Modern RPG – Unrealized Capabilities George L. Slater
10
C. SQL
SQL
• Build a String
• Return Day of Week
• Recursive SQL
• Demo
• Highlight Union All, etc
• IBM web site reference http://publib.boulder.ibm.com/infocenter/iseri
es/v5r4/index.jsp?topic=%2Fsqlp%2Frbafyr
ecursivequeries.htm
Modern RPG – Unrealized Capabilities George L. Slater
11
C. SQL
Build a String 1 of 1
Build a string
Did you know that you can Execute a SQL statement that
does not perform I/O?
/Free
Exec Sql Select ‘My ’ || ‘Data’ into :Data from SysIbm/SysDummy1;
//results in Data containing the value ‘My Data’
/End-Free
Modern RPG – Unrealized Capabilities George L. Slater
12
C. SQL
Day of Week 1 of 1
Return Day of Week
Another SQL statement that does not perform I/O…
/Free
Exec Sql Select DayOfWeek(Current Date) into :Today
From SysIbm/SysDummy1;
//results in Today contains the numeric day of the week for the current
// date where Sunday = 1, Monday =2.
/End-Free
Modern RPG – Unrealized Capabilities George L. Slater
13
C. SQL
Recursive SQL 1 of 5
SQL File Specs for BOM
Uses file METHDM:
AQPART
AQMTLP
AQSEQ#
AQLIN#
AQBLWT
AQMTLD
AQQPPC
AQUNIT
Parent Part
Material Part
Production Sequence
Line number
Blow Thru Indicator (Phantom)
Material Part Description
Qty Per
Unit of Measure
Modern RPG – Unrealized Capabilities George L. Slater
14
C. SQL
Recursive SQL 2 of 5
Recursive SQL for BOM
With BOM( Level,
Part,
BlowThru,
Total_Qty)
SubPart,
Description,
SequenceNo,
Quantity,
Line#,
UOM,
As (
Select 1,
Root.AQPART,
Root.AQMTLP,
Root.AQSEQ#,
Root.AQBLWT,
Root.AQMTLD,
Root.AQQPPC,
Root.AQQPPC
From MethDm Root
Where Root.AQPART not in ( Select AQMTLP
From METHDM)
Union All
Select Parent.Level + 1,
Child.AQPART,
Child.AQMTLP,
Child.AQSEQ#,
Child.AQBLWT,
Child.AQMTLD,
Child.AQQPPC,
Child.AQQPPC * Parent.Quantity
From BOM Parent
Join METHDM Child
On Parent.SubPart = Child.AQPART
Where Parent.Level < 10 and
Parent.BlowThru <> ‘ ‘)
Search Depth First by
Part,
SequenceNo,
Line#
Set SeqCol
Select Level,
Part,
SubPart,
SequenceNo,
Line#,
Quantity,
UOM,
Total_Qty,
From BOM
Order by SeqCol
Modern RPG – Unrealized Capabilities George L. Slater
Root.AQLIN#,
Root.AQUNIT,
Child.AQLIN#,
Child.AQUNIT,
15
C. SQL
Recursive SQL 3 of 5
Sample Output of BOM SQL
LEVEL
1
2
2
3
2
3
PART
A
B
B
D
B
F
SUBPART
B
C
D
E
F
G
SEQUENCENO LINE#
10
1
10
1
10
2
10
1
10
1
10
1
Modern RPG – Unrealized Capabilities George L. Slater
QUANTITY UOM TOTAL_QTY
1
1
2
2
2
2
4
8
1
1
1
1
16
C. SQL
Recursive SQL 4 of 5
Recap of BOM SQL
•
•
•
•
BOM, Bill of Material, that uses one file: METHDM
With Clause defines a temporary work file
As clause uses 2 SQL statements
UNION ALL inserts the results of each SQL
statement whether they duplicate an existing row
or not
• 1st Select inserts only top row level items(Items
that do not appear as components anywhere in
the BOM) and sets the level column to “1”
Modern RPG – Unrealized Capabilities George L. Slater
17
C. SQL
Recursive SQL 5 of 5
Recap of BOM SQL cont.
• 2nd Select statement = MAGIC
• Inserts rows into the work file for all children based
on join back to work file
• That join means that as children are added they
update the join so that their children (aka
grandchildren) are also part of result of 2nd Select
• That causes their children (great-grandchildren) to
be added, and their children (great-great) and so on
• STOP LOOPING = Parent level is less than 10
• Search Depth children exploded out immediately,
also use Search Breadth
Modern RPG – Unrealized Capabilities George L. Slater
18
D. Sockets
Demo 1-Sockets 1 of 3
Sockets
Demo 1
• Read a file with no F specs
• Send to a socket
• Write a copy of original file
R_TARGET –
1. Creates a socket
2. Starts a listener
R_SOURCE –
1. Create a socket
2. Connect to the listener
Once connected & Target accepts connection
3. Sends data and receives data
SOURCE = Sending
TARGET = Receiving
Modern RPG – Unrealized Capabilities George L. Slater
19
D. Sockets
Demo 1-Sockets 2 of 3
Sockets: R_TARGET
Demo 1
• R_TARGET
• Communications set up
• Socket, Bind, Listen
• TARGET = Receiving
• Receives Bytes_Read
• Writes to a PF Member
• Performs Add, Clear, OvrDbf, Delete
• Processes all entries until *END is
received
• Cool Prototype:
• RrnLocate = Locate file pointer to a
specific record in the file (SETLL)
Modern RPG – Unrealized Capabilities George L. Slater
20
D. Sockets
Demo 1-Sockets 3 of 3
Sockets: R_SOURCE
Demo 1
R_SOURCE –
• Communications setup, connected to
listener and Target accepts connection
• Sends data and receives data
• SOURCE = Sending
• Gets listing of members to read
• Sends START of refresh
• Sends RECORDS and will insert a
deleted record for each missing record
• Send END of refresh
• Cool Prototype:
• GetMbrLst = Creates User Space that
lists the members of for the file
Modern RPG – Unrealized Capabilities George L. Slater
21
E. Auto Refresh a screen in a program
Auto Refresh a screen in a program
• Using DataQueue and OvrDspF
• Code sample = SPACED
• Screen Definitions
• DSPF – Wait time on Record Format, Compile
Permanently, Limited
• ** or ** Data Queue – Stored in QTEMP, not going to
hang around afterwards, No issue with wait time and
time out for program to get control, Preferred method
• ** Gotcha **
• Write Screen with INVITE keyword *ON
• Clear Screen with INVITE keyword *OFF
• Single subfile = Works great; Multiple subfiles, 2nd
Screen F12 complains back, write old subfile
then do clear.
Modern RPG – Unrealized Capabilities George L. Slater
22
F. JDBC in RPGLE
JDBC in RPGLE
•
•
•
•
•
•
Scott Klement’s service program
Type 4 JDBC driver
Everything is a string (String and array)
Tell what fields are where and not have to define
Date, Time and Timestamp handling are biggest problems
http://www.scottklement.com/presentations/External%20D
atabases%20from%20RPG.pdf
Modern RPG – Unrealized Capabilities George L. Slater
23
G. User Spaces with Pointers
Demo 2-UsrSpc 1 of 3
User Spaces with Pointers
Demo 2
• Display an array and update with no API’s
• Run in 2 sessions
• Data updated in one session
• Refreshing in another session
• API = QUSPTRUS, QUSCRTUS
SPACED –
1. DSPF = SPACED_FM
2. Read Only
SPACEU –
1. DSPF = SPACEU_FM
2. Update, Create & Write
Modern RPG – Unrealized Capabilities George L. Slater
24
G. User Spaces with Pointers
Demo 2-UsrSpc 2 of 3
User Spaces with Pointers
Demo 2
• Remember…your program imposes the
structure onto the Data Area
• Forgot and not seeing in debug…dump it
• DMPOBJ OBJ(WMSUGEX/DATATEST)
OBJTYPE(*USRSPC)
• Pointer
• * is a pointer variable
• Cool Prototype:
• GetStatusPtr = Like ChkObj, 0=worked,
no length, string on the fly
Modern RPG – Unrealized Capabilities George L. Slater
25
G. User Spaces with Pointers
Demo 2-UsrSpc 3 of 3
User Spaces with Pointers
Demo 2
• User spaces do not have to look the same
• You could define the original data structure
so that it just looks at some control
information at the beginning of the user
space
• Then that control information defines what
the layout of the rest of the user space is
• Guess what? You can then use the pointer
to base a data structure of the correct
format, or even stack multiple different data
structure formats one after another in any
number required to represent the data you
want to store
Modern RPG – Unrealized Capabilities George L. Slater
26
H. CEE & UNIX style API’s
CEE Language & UNIX style API’s
• Sockets programming
• (TARGET/SOURCE)
H Option(*SrcStmt:*Nodebugio) DftActGrp(*No) ActGrp(*New)
H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE')
• File processing without F specs
• (TARGET/SOURCE)
//********************************************************************
// File API's
D OpenFile
Pr
* ExtProc('_Ropen')
D FileName
* Options(*String) Value
D Mode
* Options(*String) Value
Modern RPG – Unrealized Capabilities George L. Slater
27
I. ENCRYPTION
EN-CRYPT-ION
• Code page conversion
• Encryption
• Hex to character’
• Encryption
• MD5 – Web – no way to decrypt
• RC4 – uses key – way to decrypt and
encrypt
Modern RPG – Unrealized Capabilities George L. Slater
28
I. ENCRYPTION
Encryption 1 of 12
EN-CRYPT-ION
Display File for encryption example
=======================================================================================
A
DSPSIZ(24 80 *DS3)
A
R WDW001
A
CF03(03)
A
CF12(12)
A
WINDOW(*DFT 12 70)
A
WDWBORDER((*COLOR BLU) (*DSPATR RI)A
(*CHAR '
'))
A
USRRSTDSP
A
1 6'Data Encryption with RPG '
A
DSPATR(HI)
A
11 2'F3=Exit F12=Cancel'
A
COLOR(BLU)
A
3 1'Enter'
A
3 7'the'
A
3 11'data'
A
3 16'to'
A
3 19'encrypt:'
A
CHARIN
32 I 4 3
A
6 1'Md5'
A
6 5'Value:'
A
8 1'Rc4'
A
8 5'Value:'
A
MD5OUT
64 O 7 3
A
RC4OUT
64 O 9 3
A
R DUMMY
ASSUME
A
1 2' '
Modern RPG – Unrealized Capabilities George L. Slater
29
I. ENCRYPTION
Encryption 2 of 12
EN-CRYPT-ION
Source for Encryption Program Example
======================================================================================
H DftActGrp(*No) ActGrp(*Caller) BndDir('QC2LE':'QUSAPIBD')
H Option(*SrcStmt:*NoDebugIO)
H Debug(*Yes)
**********************************************************************
* Modifications
*
**********************************************************************
FencryptD CF E
WorkStn
D SysCmd
D Command
Pr
10i 0 ExtProc('system')
* Value Options(*String)
D CPFError
s
7a import('_EXCP_MSGID')
D Sleep
Pr
D SleepTime
D Cleanup
DCipher
D
D
D
10i 0 ExtProc('sleep')
10u 0 Const
Pr
Pr
ExtProc('_CIPHER')
* Value
* Value
* Value
Modern RPG – Unrealized Capabilities George L. Slater
30
I. ENCRYPTION
Encryption 3 of 12
EN-CRYPT-ION
DConvert
D
D
D
Dcvthc
D
D
D
DGetCvtTbl
D CCSID1
D St1
D StartMap
D L1
D CCSID2
D St2
D GccAsn
D L2
D To819
D L3
D L4
D Fb
D Md5Encode
D InputString
Pr
EXTPROC('_XLATEB')
* Value
* Value
10u 0 Value
Pr
ExtProc('cvthc')
1
1
10i 0 Value
Pr
Pr
ExtPgm('QTQCVRT')
10i 0
10i 0
256
10i 0
10i 0
10i 0
10i 0
10i 0
256
10i 0
10i 0
12
32
50 Const
Modern RPG – Unrealized Capabilities George L. Slater
31
I. ENCRYPTION
Encryption 4 of 12
EN-CRYPT-ION
D rc
s
D Lo
c
D Up
c
D Retry
s
D RetryCount
s
10i 0
Const('abcdefghijklmnopqrstuvwxyz')
Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
1
5i 0
D encryptScreenData...
D
Pr
D RC4Encode
D inputdata
Pr
32
64
Const
/free
DoW Not *In03 and
Not *In12;
ExFmt Wdw001;
encryptScreenData();
EndDo;
*InLR = *On;
return;
/end-free
Modern RPG – Unrealized Capabilities George L. Slater
32
I. ENCRYPTION
Encryption 5 of 12
EN-CRYPT-ION
//=====================================================================
// Encrypt the screen data for redisplay
//=====================================================================
P encryptScreenData...
P
B
D encryptScreenData...
D
Pi
/Free
If charIn <> *Blanks;
md5out = Md5Encode(charIn);
Rc4Out = Rc4Encode(charIn);
Else;
md5out = *Blanks;
Rc4Out = *Blanks;
endif;
/End-Free
P
E
//======================================================================
// MD5 Encoding routine
// Note: MD5 is a standard encoding method used on the web and can
//
not be decrypted. There are websites available, however,
//
that let you test passwords by entering them and displaying
//
the Md5 encrypted value. These websites should be avoided
Modern RPG – Unrealized Capabilities George L. Slater
33
I. ENCRYPTION
Encryption 6 of 12
EN-CRYPT-ION
//
They capture the passwords and resulting MD5 hashes so that
//
users can also lookup a hash and determine what the original
//
password is. For this reason most web applications will not
//
use a direct one-time MD5 conversion but will either:
//
1. Perform the MD5 encryption multiple times
//
2. Seed the password with some characters (possibly
//
generated randomly) and store that seed along with
//
the password so that the seed can be recombined
//
with the password for encryption.
//
3. Scramble the password in some fixed way so that the
//
entered value is not what is encrypted.
//======================================================================
P Md5Encode
B
D Md5Encode
D InputString
Pi
DControls
DS
D Function
D HashAlg
D Sequence
D DataLngth
D Unused
D HashCtxPtr
DOutputString S
DHashWorkArea S
32
50 Const
5i 0 inz(5)
1 inz(x'00')
1 inz(x'00')
10i 0 inz(15)
8 inz(*LOVAL)
* inz(%addr(HashWorkArea))
32
96
inz(*LOVAL)
Modern RPG – Unrealized Capabilities George L. Slater
34
I. ENCRYPTION
Encryption 7 of 12
EN-CRYPT-ION
DMsg
S
DReceiverHex
S
DReceiverPtr
S
DReceiverChr
S
DSourcePtr
S
DStartMap
s
DTo819
s
DCCSID1
s
DST1
s
DL1
s
DCCSID2
s
DST2
s
DGCCASN
s
DL2
s
DL3
s
DL4
s
DFB
s
DUpper
c
DLower
c
D
Dx
D LowX
50
16
* inz(%addr(ReceiverHex))
32
* inz(%addr(Msg))
256
256
10i 0 inz(37)
10i 0 inz(0)
10i 0 inz(%size(StartMap))
10i 0 inz(819)
10i 0 inz(0)
10i 0 inz(0)
10i 0 inz(%size(To819))
10i 0
10i 0
12
Const('ABCDEF')
Const('abcdef')
ds
5i 0
2
2
Modern RPG – Unrealized Capabilities George L. Slater
35
I. ENCRYPTION
Encryption 8 of 12
EN-CRYPT-ION
/Free
// Get all single byte ebcdic hex values
For x = 0 to 255;
%Subst(StartMap:x+1:1) = LowX;
EndFor;
GetCvtTbl(CCSID1:
ST1:
StartMap:
L1:
CCSID2:
ST2:
GccAsn:
L2:
To819:
L3:
L4:
Fb);
// Move the input constant to a variable and get it's length
Msg = InputString;
DataLngth = %Len(%Trim(Msg));
If DataLngth > *Zero;
// Convert the codepage of the data
Convert( %Addr(Msg):
%Addr(To819):
%Size(Msg));
Modern RPG – Unrealized Capabilities George L. Slater
36
I. ENCRYPTION
Encryption 9 of 12
EN-CRYPT-ION
// Encrypt the data
Cipher(%Addr(ReceiverPtr):
%Addr(Controls):
%Addr(SourcePtr));
// Convert the encrypted data to hex
CvtHc(ReceiverChr:
ReceiverHex:
%Size(ReceiverChr));
// Convert the hex characters to lower case since that
// is the standard format of an MD5 hash
OutputString = %XLate(Upper:Lower:ReceiverChr);
Else;
OutputString = *Blanks;
EndIf;
// Return the encrypted data
Return OutputString;
/End-Free
Modern RPG – Unrealized Capabilities George L. Slater
37
I. ENCRYPTION
Encryption 10 of 12
EN-CRYPT-ION
//======================================================================
// RC4 Encryption routine
// Note: Rc4 encryption allows for decrypting the data once it is
//
encrypted so long as the original encryption key is known
//======================================================================
P RC4encode
B
D RC4encode
Pi
64
D data2Encrypt
32 Const
D inputData
D encrypted
s
s
32
64
Inz(*Blanks)
// This is the key used to encrypt the data
D e_key
s
54A varying inz('NowIsTheTimeForAllGoodMD
enToEncryptTheirDataWithRc4Yeah')
D
Ds
D RC4_Controls
D funct_id
D datalen
D operation
D reserved
D p_key_ctx
D key_ctx
D stream
D len
D reserved
ds
qualified
2A
5I 0
1A
11A
*
ds
qualified
256A
5U 0
6A
Modern RPG – Unrealized Capabilities George L. Slater
38
I. ENCRYPTION
Encryption 11 of 12
EN-CRYPT-ION
D
ds
D HexData
s
D p_recv
D p_src
s
s
64
*
*
/Free
// Move input constant to variable for processing
inputData = data2Encrypt;
// Setup the encryption key and processing information
key_ctx = *ALLx'00';
%subst(key_ctx.stream:1:%len(e_key)) = e_key;
key_ctx.len = %len(e_key);
RC4_Controls = *ALLx'00';
RC4_Controls.funct_id = x'0013';
RC4_Controls.datalen = %size(inputData);
RC4_Controls.operation = x'00';
// 0=Encrypt,1=Decrypt
RC4_Controls.p_key_ctx = %addr(key_ctx);
Modern RPG – Unrealized Capabilities George L. Slater
39
I. ENCRYPTION
Encryption 12 of 12
EN-CRYPT-ION
// Point to the source and destination values
p_src = %addr(inputData);
p_recv = %addr(Encrypted);
// Encrypt the data
cipher( %addr(p_recv): %addr(RC4_Controls): %addr(p_src));
// Convert the data to hex for display since the encrypted data
// may contain non-displayable characters.
CvtHc(HexData:
Encrypted:
%Size(Encrypted));
// Return the encrypted data
Return HexData;
/End-Free
P
E
Modern RPG – Unrealized Capabilities George L. Slater
40
J. Random #’s
Random #’s
• Uses a random number generator
• Creates a 5 character confirmation key
• User must type in the key to verify that they
want to perform a given action
Modern RPG – Unrealized Capabilities George L. Slater
41
J. Random #’s
Random # 1 of 4
Random #’s
Display File for Random Number example
===================================================================================
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
A
DSPSIZ(24 80 *DS3)
R WDW001
WINDOW(*DFT 10 40)
WDWBORDER((*COLOR BLU) (*DSPATR RI)(*CHAR '
'))
USRRSTDSP
CF03(03)
CF12(12)
1 6'Random Character Generation'
DSPATR(HI)
3 2'Confirm'
3 10'by'
3 13'typing'
3 20'the'
3 24'following'
3 34'key:'
@KEY
5A O 5 16DSPATR(HI)
7 2'Enter'
7 8'Key:'
@CONFIRM
5A B 7 13
9 2'F3=Exit F12=Cancel'
COLOR(BLU)
R DUMMY
ASSUME
1 2' '
Modern RPG – Unrealized Capabilities George L. Slater
42
J. Random #’s
Random # 2 of 4
Random #’s
Program source for Random Number example
===================================================================================
H DftActGrp(*No) ActGrp(*Caller) BndDir('QC2LE')
H Option(*SrcStmt:*NoDebugIO)
FRANDOMD CF E
WorkStn
D SysCmd
D Command
Pr
10i 0 ExtProc('system')
* value options(*string)
D CPFError
s
7a Import('_EXCP_MSGID')
D Confirmed
Pr
D GetRandomNbr
D Seed
D Random
D CharArr
s
n
Pr
ExtProc('CEERAN0')
10i 0
8F
1
Dim(36) CtData PerRcd(36)
Modern RPG – Unrealized Capabilities George L. Slater
43
J. Random #’s
Random # 3 of 4
Random #’s
/Free
DoU *InLR;
If Confirmed();
*InLR = *On;
EndIf;
EndDo;
Return;
/End-Free
P Confirmed
B
D Confirmed
Pi
D RandomFloat S
D Seed
S
D RandomInt
S
DI
S
1n
8f
10i 0 Inz(0)
10i 0
5i 0
/Free
DoU @Confirm = @Key or
*In03 = *On or
*In12 = *On;
Modern RPG – Unrealized Capabilities George L. Slater
44
J. Random #’s
Random # 4 of 4
Random #’s
For I = 1 to 5;
DoU RandomInt > *Zero;
GetRandomNbr(Seed:RandomFloat);
RandomInt = %Int(RandomFloat * 36);
RandomFloat = *Zero;
EndDo;
%Subst(@Key:I:1) = CharArr(RandomInt);
EndFor;
ExFmt Wdw001;
EndDo;
Return @Confirm = @Key;
/End-Free
P
E
** CharArr
ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567689
Modern RPG – Unrealized Capabilities George L. Slater
45
K. PHP Command Line calls
PHP Command Line calls
• FTP
• Image manipulation
• Accessing an image from local storage: a
form upload, or FTP and storing, displaying,
resizing it and converting it to another format
• PHP writes classes
• Anything else you need it to do such as a web
routine that you want to be called at intervals as
well as being called from the web. Don’t write it
twice.
Modern RPG – Unrealized Capabilities George L. Slater
46
X. EXCLUDED from Presentation -
EXCLUSIONS
• Scheduling Jobs less than a day
Modern RPG – Unrealized Capabilities George L. Slater
47
MODERNRPG/QSQLSRC
Appendix
RECURS_SQL
. . . :
1 100
Browse
MODERNRPG/QSQLSRC
RECURS_SQL
...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
*************** Beginning of data ***************************************************************************************
//=================================================================
// All BOM's depth first (in and out of subassemblies as they are
//
encountered)
//=================================================================
With BOM(Level,
Part,
SubPart,
SequenceNo,
Line#,
BlowThru,
Description,
Quantity,
UOM,
Total_Qty)
As (
Select 1,
Root.AQPART,
Root.AQMTLP,
Root.AQSEQ#,
BlowThru,
Description,
Quantity,
UOM,
Total_Qty)
As (
Select 1,
Root.AQPART,
Root.AQMTLP,
Root.AQSEQ#,
Root.AQLIN#,
Root.AQBLWT,
Root.AQMTLD,
Root.AQQPPC,
Root.AQUNIT,
Root.AQQPPC
From MethDm Root
Where Root.AQPART not in ( Select AQMTLP
From METHDM)
Union All
Root.AQLIN#,
Root.AQBLWT,
Root.AQMTLD,
Root.AQQPPC,
Root.AQUNIT,
Root.AQQPPC
From MethDm Root
Where Root.AQPART not in ( Select AQMTLP
From METHDM)
Union All
Select Parent.Level + 1,
Modern RPG – Unrealized Capabilities George L. Slater
48
MODERNRPG/QRPGLESRC
Appendix
R_TARGET
. . . :
6 100
Browse
MODERNRPG/QRPGLESRC
R_TARGET
... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
*************** Beginning of data ***************************************************************************************
//=============================================================
// Modifications *
//===============*
//
// 11/28/2006 Monitor for Locks on Data Areas and Retry up to
//
10 times until a good read is achieved.
//
//=============================================================
H Option(*SrcStmt:*Nodebugio) DftActGrp(*No) ActGrp(*New)
H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE')
D R_Target
Pr
D Lib_Name
10
D File_Name
10
D R_Target
D Lib_Name
D File_Name
Pi
10
10
//*************************************************************************
H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE')
D R_Target
Pr
D Lib_Name
10
D File_Name
10
D R_Target
D Lib_Name
D File_Name
Pi
10
10
//*************************************************************************
// Sockets API's
D Socket
Pr
10i 0 Extproc('socket')
D
10i 0 Value
D
10i 0 Value
D
10i 0 Value
D SetSockOpt
Pr
D
D
D
// Sockets API's
D Socket
Pr
D
D
D
10i
10i
10i
10i
0
0
0
0
Extproc('setsockopt')
Value
Value
Value
10i
10i
10i
10i
0
0
0
0
Extproc('socket')
Value
Value
Value
10i 0Capabilities
Extproc('setsockopt')
Modern RPGPr– Unrealized
George L. Slater
10i 0 Value
D SetSockOpt
D
D
D
D
10i 0 Value
10i 0 Value
*
Value
49
MODERNRPG/QRPGLESRC
Appendix
R_SOURCE
. . . :
6 100
Browse
MODERNRPG/QRPGLESRC
R_SOURCE
... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
*************** Beginning of data ***************************************************************************************
//=============================================================
// Modifications *
//===============*
//
// 11/28/2006 Monitor for Locks on Data Areas and Retry up to
//
10 times until a good read is achieved.
//
//=============================================================
H Option(*SrcStmt:*Nodebugio) DftActGrp(*No) ActGrp(*New)
H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE')
D R_Source
Pr
D Lib_Name
10
D File_Name
10
D R_Source
D Lib_Name
D File_Name
Pi
10
10
//*************************************************************************
H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE')
D R_Source
Pr
D Lib_Name
10
D File_Name
10
D R_Source
D Lib_Name
D File_Name
Pi
10
10
//*************************************************************************
// Sockets API's
D Socket
Pr
10i 0 Extproc('socket')
D
10i 0 Value
D
10i 0 Value
D
10i 0 Value
D SetSockOpt
Pr
D
D
D
// Sockets API's
D Socket
Pr
D
D
D
10i
10i
10i
10i
0
0
0
0
Extproc('setsockopt')
Value
Value
Value
10i
10i
10i
10i
0
0
0
0
Extproc('socket')
Value
Value
Value
10i 0Capabilities
Extproc('setsockopt')
Modern RPGPr– Unrealized
George L. Slater
10i 0 Value
D SetSockOpt
D
D
D
D
10i 0 Value
10i 0 Value
*
Value
50
MODERNRPG/QRPGLESRC
Appendix
JDBC_EXAMP
. . . :
6 100
Browse
MODERNRPG/QRPGLESRC
JDBC_EXAMP
*. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
*************** Beginning of data ***************************************************************************************
**************************************************************************
* Modifications
*
**************************************************************************
H DFTACTGRP(*NO) BNDDIR('JDBC':'QC2LE':'PROP') ALWNULL(*USRCTL)
H Actgrp(*New)
/copy jdbc_h
D SysCmd
D Command
Pr
10i 0 ExtProc('system')
*
Value Options(*String)
D rc
D MemberNumber
s
s
10i 0
20
D PushConn
D rs
D rs2
s
s
s
like(Connection)
like(ResultSet)
like(ResultSet)
D SysCmd
D Command
Pr
10i 0 ExtProc('system')
*
Value Options(*String)
D rc
D MemberNumber
s
s
10i 0
20
D PushConn
D rs
D rs2
s
s
s
like(Connection)
like(ResultSet)
like(ResultSet)
D Upd_Stmt
D Ins_Stmt
s
s
Like(PreparedStatement)
Like(PreparedStatement)
D Pub_Conn
D ProcOk
s
s
D Mode
D CountStmt
s
s
D inputData
D Upd_Stmt
D Ins_Stmt
Ds
s
s
D Pub_Conn
D ProcOk
s
s
60
n
10
256
Dtaara('PUB_CONN')
Inz(*Blanks)
Qualified Inz
Like(PreparedStatement)
Like(PreparedStatement)
60
n
Dtaara('PUB_CONN')
10
Inz(*Blanks)
Modern RPGss – Unrealized
Capabilities
George L. Slater
256
D Mode
D CountStmt
D inputData
d AssociationId
Ds
60
Qualified Inz
Varying
51
MODERNRPG/QDDSSRC
Appendix
SPACED_FM
. . . :
1 100
Browse
MODERNRPG/QDDSSRC
SPACED_FM
.....A*. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
*************** Beginning of data ***************************************************************************************
A*%%TS SD 20120705 135644 ASIGEORGE
REL-V5R4M0 5722-WDS
A*%%EC
A
DSPSIZ(24 80 *DS3)
A 66
INVITE
A
R SPACE_FT
A*%%TS SD 20120705 135644 ASIGEORGE
REL-V5R4M0 5722-WDS
A
23 2'F3=Exit'
A
COLOR(BLU)
A
23 11'F5=Refresh'
A
COLOR(BLU)
A
23 23'F12=Cancel'
A
COLOR(BLU)
A
R SPACE_SF
SFL
A*%%TS SD 20120705 134437 ASIGEORGE
REL-V5R4M0 5722-WDS
A 50
SFLNXTCHG
A
RRN
5I 0H
A
DISP_KEY
10A O 6 11
A
DISP_DATE
19A O 6 23
A
R SPACE_CT
SFLCTL(SPACE_SF)
A
COLOR(BLU)
A
23 23'F12=Cancel'
A
COLOR(BLU)
A
R SPACE_SF
SFL
A*%%TS SD 20120705 134437 ASIGEORGE
REL-V5R4M0 5722-WDS
A 50
SFLNXTCHG
A
RRN
5I 0H
A
DISP_KEY
10A O 6 11
A
DISP_DATE
19A O 6 23
A
R SPACE_CT
SFLCTL(SPACE_SF)
A*%%TS SD 20120705 134437 ASIGEORGE
REL-V5R4M0 5722-WDS
A
SFLSIZ(0015)
A
SFLPAG(0014)
A
VLDCMDKEY(25)
A
CF03(03)
A
CF05(05)
A
CF12(12)
A
OVERLAY
A 41
SFLDSP
A N40
SFLDSPCTL
A*%%TS SD 20120705 134437 ASIGEORGE
REL-V5R4M0 5722-WDS
A
SFLSIZ(0015)
A
SFLPAG(0014)
A
VLDCMDKEY(25)
A
CF03(03)
A
CF05(05)
A
CF12(12)
A
OVERLAY
A 41
SFLDSP
A N40
SFLDSPCTL
A 40
SFLCLR
Modern RPG – Unrealized Capabilities George L. Slater
52
MODERNRPG/QRPGLESRC
Appendix
SPACED
. . . :
6 100
Browse
MODERNRPG/QRPGLESRC
SPACED
HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++Comments++++++++++++
*************** Beginning of data ***************************************************************************************
H DftActGrp(*No) ActGrp(*Caller) BndDir('QC2LE')
//======================================================================
// This program provides an example of how to use a user space with
// pointers to pass or store data directly as if it were in memory.
// Because this approach uses pointers the data layout is completly
// dynamic since the pointer can be moved forward or backward through
// the space and applied to various data structure definitions to
// achieve multiple, conditional structures within the space itself
//=======================================================================
FSpaced_Fm CF
E
WorkStn SFile(Space_SF:Rrn) UsrOpn
D GetStatusPtr
Pr
D RtvSpcPtr
D UserSpace
D SpacePtr
Pr
D CrtUsrSpc
D UserSpace
FSpaced_Fm CF
Pr
*
ExtPgm('QUSPTRUS')
20
*
E
D GetStatusPtr
Pr
D RtvSpcPtr
D UserSpace
D SpacePtr
Pr
D CrtUsrSpc
D UserSpace
D ExtendAttr
D SpaceSize
D SpaceVal
D SpaceAut
D SpaceText
D SpaceRepl
D Api_Error
D SpaceDomn
D SpaceTfr
D SpaceAlign
D ExtendAttr
D SpaceSize
D SpaceVal
D SpaceAut
D SpaceText
D SpaceRepl
D Api_Error
D SpaceDomn
D SpaceTfr
D SpaceAlign
Pr
ExtPgm('QUSCRTUS')
20
WorkStn SFile(Space_SF:Rrn) UsrOpn
*
ExtPgm('QUSPTRUS')
20
*
ExtPgm('QUSCRTUS')
20
10
10i 0
1
10
50
10
LikeDs(API_ErrorDs)
10
10i 0
1
10
10i 0
1
10
50
10
LikeDs(API_ErrorDs)
Modern RPG – Unrealized
Capabilities
George L. Slater
10
10i 0
1
53
MODERNRPG/QDDSSRC
Appendix
SPACEU_FM
. . . :
1 100
Browse
MODERNRPG/QDDSSRC
SPACEU_FM
.....A*. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
*************** Beginning of data ***************************************************************************************
A*%%TS SD 20120705 140201 ASIGEORGE
REL-V5R4M0 5722-WDS
A*%%EC
A
DSPSIZ(24 80 *DS3)
A
R SPACE_FT
A*%%TS SD 20120705 135644 ASIGEORGE
REL-V5R4M0 5722-WDS
A
23 2'F3=Exit'
A
COLOR(BLU)
A
23 11'F5=Refresh'
A
COLOR(BLU)
A
23 23'F12=Cancel'
A
COLOR(BLU)
A
R SPACE_UPD
A*%%TS SD 20120705 140201 ASIGEORGE
REL-V5R4M0 5722-WDS
A
VLDCMDKEY(25)
A
CF03(03)
A
CF12(12)
A
OVERLAY
A
1 2DATE
A
EDTCDE(Y)
A
23 23'F12=Cancel'
A
COLOR(BLU)
A
R SPACE_UPD
A*%%TS SD 20120705 140201 ASIGEORGE
REL-V5R4M0 5722-WDS
A
VLDCMDKEY(25)
A
CF03(03)
A
CF12(12)
A
OVERLAY
A
1 2DATE
A
EDTCDE(Y)
A
2 2TIME
A
1 21'User Space Update Utility
'
A
DSPATR(HI)
A
2 19'Update User Space Keys and Dates '
A
1 59SYSNAME
A
1 70'SPACEUPD '
A
2 70USER
A
9 14'Space'
A
9 20'Key:'
A
SPACEKEY
10A B 9 25
A
2 2TIME
A
1 21'User Space Update Utility
'
A
DSPATR(HI)
A
2 19'Update User Space Keys and Dates '
A
1 59SYSNAME
A
1 70'SPACEUPD '
A
2 70USER
A
9 14'Space'
A
9 20'Key:'
A
SPACEKEY
10A B 9 25
A
11 14'Current'
Modern RPG – Unrealized Capabilities George L. Slater
54
MODERNRPG/QRPGLESRC
Appendix
SPACEU
. . . :
6 100
Browse
MODERNRPG/QRPGLESRC
SPACEU
HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++Comments++++++++++++
*************** Beginning of data ***************************************************************************************
H DftActGrp(*No) ActGrp(*Caller) BndDir('QC2LE')
FSpaceU_Fm CF
E
WorkStn
D GetStatusPtr
Pr
D RtvSpcPtr
D UserSpace
D SpacePtr
Pr
D CrtUsrSpc
D UserSpace
D ExtendAttr
D SpaceSize
D SpaceVal
D SpaceAut
D SpaceText
D SpaceRepl
D Api_Error
D SpaceDomn
D CrtUsrSpc
D UserSpace
D ExtendAttr
D SpaceSize
D SpaceVal
D SpaceAut
D SpaceText
D SpaceRepl
D Api_Error
D SpaceDomn
D SpaceTfr
D SpaceAlign
Pr
D DisplayScreen
Pr
D CheckCmdKeys
Pr
D UpdateSpace
D SpaceData
Pr
D
D
*
ExtPgm('QUSPTRUS')
20
*
ExtPgm('QUSCRTUS')
20
10
10i 0
1
10
50
10
LikeDs(API_ErrorDs)
10
Pr
ExtPgm('QUSCRTUS')
20
10
10i 0
1
10
50
10
LikeDs(API_ErrorDs)
10
10i 0
1
10
SpaceTfr
SpaceAlign
Value
10i 0
1
D DisplayScreen
Pr
D CheckCmdKeys
Pr
Modern RPGPr– Unrealized Capabilities George L. Slater
D UpdateSpace
D
SpaceData
* User Space Definition
10
Value
55
MODERNRPG/QRPGLESRC
Appendix
INCJOBSCDE
. . . :
6 100
Browse
MODERNRPG/QRPGLESRC
INCJOBSCDE
HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++Comments++++++++++++
*************** Beginning of data ***************************************************************************************
H DftActGrp(*No) ActGrp(*Caller) Option(*SrcStmt:*NoDebugIo)
H BndDir('QC2LE':'GRARBNDDIR')
D Rets_Incr
D Job_Name
D Run_Interval
Pr
D Rets_Incr
D Job_Name
D Run_Interval
Pi
D ExecCmd
D Command
Pr
D CPFMsg
s
D Sleep
D interval
Pr
D
10
t
10
t
Run_Interval
10i 0 extProc('system')
*
Value Options(*String)
7a
import('_EXCP_MSGID')
10i 0 extProc('sleep')
10u 0 value
t
D ExecCmd
D Command
Pr
D CPFMsg
s
D Sleep
D interval
Pr
10i 0 extProc('sleep')
10u 0 value
D RtvJobScdE
D JobName
Pr
*
10
D JobScdE
D Inf_Status
D Job_Name
D Entry_Number
D Sched_Date
D Sched_Days
D Sched_Time
D RtvJobScdE
D JobName
Ds
D JobScdE
D Inf_Status
D Job_Name
D Entry_Number
D Sched_Date
D Sched_Days
D Sched_Time
D Sched_Freq
Ds
Pr
10i 0 extProc('system')
*
Value Options(*String)
7a
import('_EXCP_MSGID')
Qualified Based(JobScdEPtr)
1
10
10
10
70
6
*
10
Qualified Based(JobScdEPtr)
1
10
10
10
70
6
10
Modern RPG – Unrealized Capabilities George L. Slater
56