100 **======================================================================** 200 H DFTACTGRP(*NO) ACTGRP(*caller) 300 h BNDDIR('BASE64') 400 h BNDDIR('QC2LE') 500 ************************************************************************** 600 700 * System includes 800 D/Copy QSYSINC/QRPGLESRC,QUSEC 900 D/Copy V15HTRPGLE,httpapi_h 1000 D/Copy QTSTSORC,bASE64_h 1100 1200 * prototyped program for encryption 1300 D QC3EncryptData pr ExtPgm('QC3ENCDT') 1400 D P@InpDta 32767 Options (*VarSize) Const Data to encrypt 1500 D P@InpDtaLen 10I 0 Const Length of data to en 1600 D P@InpDtaFmt 8 Const Format of data to en 1700 D P@AlgoDesc 32767 Options (*VarSize) Algorithm and assoc 1800 D P@AlgoDesFmt 8 Const Algorithm desc fmt 1900 D P@KDesc 32767 Options (*VarSize) Key description 2000 D P@KDFormat 8 Const Key desc format 2100 D P@CryptSPrv 1 Const 2200 D P@CryptDev 10 Const 2300 D P@OutEncrData 32767 Options (*VarSize) 2400 D P@EncDataLen 10i 0 Const 2500 D P@EncDLRet 10i 0 2600 D errcde like(APIERR) 2700 2800 D QC3GenPRNs pr ExtPgm('QC3GENRN') 2900 D PrnDta 32767 Options (*VarSize) 3000 D PrnDtaLen 10I 0 const 3100 D PrnType 1 const 3200 D PrnParity 1 const 3300 D errcde like(APIERR) 3400 3500 D base64_encod PR 10U 0 ExtProc('BASE64ENCODE') 3600 D Input * value 3700 D InputLen 10U 0 value 3800 D Output * value 3900 D OutputSize 10U 0 value 4000 4100 * Data Inputted 4200 D @DData0200 DS 4300 D D@DClrPtr * 4400 D D@DClrLen 10i 0 4500 D D@DRserv 12 4600 4700 * Algorithm Description 4800 d @DAlgD0200 DS 4900 d D@ABCip 10i 0 block cipher algortm 5000 d D@ABLen 10i 0 block length 5100 d D@AMode 1 mode 5200 d D@APOpt 1 pad option 5300 D D@APCha 1 pad character 5400 D D@ARserv 1 reserved 5500 D D@AMLen 10i 0 MAC length 5600 D D@AKSize 10i 0 effective key size 5700 D D@AIV 32 initial vector 5800 5900 * Key Description 6000 D @DKeyD0200 DS 6100 D D@KType 10i 0 6200 D D@KLength 10i 0 6300 D D@KFmt 1 6400 D D@KRserv 3 6500 D D@KString 32767 6600 6700 * API error structure 6800 D APIERR ds 6900 D ERRPRV 10I 0 INZ(272) 7000 D ERRLEN 10I 0 7100 D EXCPID 7A 7200 D RSRVD2 1A 7300 D EXCPDT 256A 7400 7500 D #keyLength s 10I 0 7600 D Input s 512a 7700 D Output s 512a 7800 D PseudoRandom s 32 Inz 7900 D OutEncrData S 50 8000 D OutEncrDLen S 10i 0 8100 D pEncData s 512a 8200 D keyFormat s 1 8300 D keyForm s 1 8400 D wwEncLen S 10I 0 8500 d E@Pswrd S 100 8600 d E@KeyStr S 100 8700 d E@Encrypt S 100 8800 d E@ErrFlg S 1 8900 D P@OutEncrData s 50 9000 9100 D AES c const(22) 9200 9300 C ExSr SrPrepEncrypt 9400 C ExSr SrEncrypt 9500 9600 C ExSr SrEnd 9700 *---------------------------------------------------------------------------------- 9800 * Prepare Parameters for Encryption 9900 *---------------------------------------------------------------------------------- 10000 C SrPrepEncrypt BegSr 10100 10200 * String Password 10300 C Eval E@Pswrd = 'tpP6YE5osT9jYe2c' 10400 C Eval E@KeyStr = '3rTS5pdgRFVCBNi5' 10500 * initialize the data 10600 C Eval @DData0200 = *ALLx'00' 10700 C Eval D@DClrPtr = %Addr (E@Pswrd) 10800 C Eval D@DClrLen = %Size (E@Pswrd) 10900 11000 * String Keyspecs: AES 11100 * String Algorithm: AES/CBC/NoPadding 11200 C ExSr SrAlgorithm 11300 11400 * String key = "7rPZ4dzwBNRTRhq9 11500 C ExSr SrKeyParm @DKeyD0200 11600 11700 C EndSr 11800 *---------------------------------------------------------------------------------- 11900 * Set Algorithm 12000 *---------------------------------------------------------------------------------- 12100 C SrAlgorithm BegSr 12200 12300 C Eval @DAlgD0200 = *ALLx'00' 12400 12500 * String Algorithm: AES/CBC/NoPadding 12600 C Eval D@ABCip = AES 12700 12800 * Block length 12900 C Eval D@ABLen = 16 13000 13100 * Mode 13200 C Eval D@AMode = '1' 13300 13400 * Pad option 13500 * 0 No padding is performed. 13600 C Eval D@APOpt = '0' 13700 13800 * Pad character (null-character) 13900 C Eval D@APCha = ' ' 14000 14100 * Reserved - Must be null (binary 0s). 14200 C Eval D@ARserv = *AllX'00' 14300 14400 * MAC Length 14500 * This field is not used on an encrypt operation and must be set to 14600 * null (binary 0s). 14700 C Eval D@AMLen = X'00000000' 14800 14900 * Effective key size 15000 * This field must be set to 0. 15100 C Eval D@AKSize = 0 15200 15300 * initial vector 15400 C Callp QC3GenPRNs(PseudoRandom binary stream 15500 C :%Size (PseudoRandom) data type (AES) 15600 C :'0' type 15700 C :'0' parity 15800 C :APIERR) error ret. 15900 C Eval D@AIV = PseudoRandom 16000 16100 C EndSr 16200 *---------------------------------------------------------------------------------- 16300 * Get Key Parameters 16400 *---------------------------------------------------------------------------------- 16500 C SrKeyParm BegSr 16600 16700 * initialize key parameters 16800 C Eval @DKeyD0200 = *ALLx'00' 16900 * key type 17000 C Eval D@KType = AES 17100 * key format 17200 C Eval D@KFmt = '0' 17300 * key length 17400 C ExSr SrGetKLen 17500 * key string 17600 C Eval D@KString = %Trim (E@KeyStr) 17700 17800 C EndSr 17900 *---------------------------------------------------------------------------------- 18000 * Encrypt 18100 *---------------------------------------------------------------------------------- 18200 C SrEncrypt BegSr 18300 18400 C CallP QC3EncryptData ( 18500 1 C @DData0200 data to encrypt 18600 2 C :%Size (@DData0200) 18700 3 C :'DATA0100' 18800 4 C :@DAlgD0200 18900 5 C :'ALGD0200' 19000 6 C :@DKeyD0200 19100 7 C :'KEYD0200' 19200 8 C :'0' 19300 9 C :' ' 19400 10 C :OutEncrData 19500 C :%Size (OutEncrData) 19600 C :OutEncrDLen 19700 C :APIERR) 19800 19900 C If ERRLEN = 0 20000 c Eval pEncData = %subst(OutEncrData: 20100 c 1:%Size (OutEncrData)) 20200 c ExSr SrBase64 20300 C Endif 20400 20500 C EndSr 20600 *---------------------------------------------------------------------------------- 20700 * Use BASE64 encoded to prevent encoding problem 20800 *---------------------------------------------------------------------------------- 20900 C SrBase64 BegSr 21000 21100 C Eval Input = %Trimr (pEncData) 21200 21300 * String encrypted = Base64.getEncoder().encodeToString(combine) 21400 C Eval wwEncLen = base64_encod(%addr(Input) 21500 C : %len(%trimr(Input)) 21600 C : %addr(Output) 21700 C : %size(Output)) 21800 21900 C Eval E@Encrypt = %subst(Output:1:wwEncLen) 22000 22100 C EndSr 22200 *---------------------------------------------------------------------------------- 22300 * SrGetKLen - Get Key Length 22400 *---------------------------------------------------------------------------------- 22500 C SrGetKLen BegSr 22600 22700 C Eval #KeyLength = %Len (%Trim (E@KeyStr)) 22800 22900 C Select 23000 C When #KeyLength <= 16 23100 C Eval #KeyLength = 16 23200 C When #KeyLength <= 24 23300 C Eval #KeyLength = 24 23400 C When #KeyLength <= 32 23500 C Eval #KeyLength = 32 23600 C EndSl 23700 23800 C Eval D@KLength = #keyLength 23900 24000 C EndSr 24100 *---------------------------------------------------------------------------------- 24200 * End routine 24300 *---------------------------------------------------------------------------------- 24400 C srEnd BegSr 24500 24600 c Eval *inlr = *on 24700 24800 C EndSr * * * * E N D O F S O U R C E * * * *