× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



This is a good start.  Thanks Matt.

Jose

MWHopkins@xxxxxxxxxxxxxxx wrote:

This program will encrypt or decrypt a string passed into the program and will return the opposite. The processing field is sent as either 'E'ncrypt or 'D'ecrypt. Hopefully you can figure out what it is doing based on the code. I haven't looked at it in a couple of years.

I have implemented it as a command, the command source is first. It looks like you could also put it in a service program without changing the code other then changing the API external procedure names. (see source)

/*PARMS CMD(CRYPTO) PGM(*LIBL/ENCRYPTION) */ /*PARMS SRCMBR(CRYPTO) THDSAFE(*NO) TEXT('Encrypt/Decrypt data') */ /*PARMS MODE(*ALL) ALLOW(*BPGM *IPGM) ALWLMTUSR(*NO) MAXPOS(*NOMAX) */ /*PARMS MSGF(*LIBL/QCPFMSG) HLPID(*NONE) CURLIB(*NOCHG) PRDLIB(*NOCHG) */ CMD PROMPT('Encrypt/Decrypt data') PARM KWD(CLRDTA) TYPE(*CHAR) LEN(5000) RTNVAL(*YES) MIN(1) VARY(*YES *INT2) + CHOICE('Character value') PROMPT('Clear data') PARM KWD(ENCDTA) TYPE(*CHAR) LEN(5000) RTNVAL(*YES) MIN(1) VARY(*YES *INT2) + CHOICE('Character value') PROMPT('Encrypted data') PARM KWD(PROCSS) TYPE(*CHAR) LEN(1) RSTD(*YES) VALUES(E D) MIN(1) CHOICE('E, + D') PROMPT('_E_ncrypt or _D_ecrypt')

QRPGLESRC/ENCRYPTION

    ?*   Author:              MWH copied shell from
?* http://www.maillist.com.tw/maillist/file/ms1813/20040802142448.html
    ?*   Date:                2005/06/16
     * CRTRPGMOD DECRYPTDTA
     *  BNDSRVPGM(QC3DTAEN QC3PRNG)
     *
     * Encrypt Data (OPM, QC3ENCDT; ILE, Qc3EncryptData) API
     * Service Program Name: QC3DTAEN

     * Decrypt Data (OPM, QC3DECDT; ILE, Qc3DecryptData) API
     * Service Program Name: QC3DTADE
    Hdatedit(*ymd) datfmt(*ymd) debug(*yes) timfmt(*hms)
     /If defined(SrvPgm)
    Hnomain
    D Encryption      PR             1N
    D  ClearData                 32767a   Varying
    D  EncryptData               32767a   Varying
    D  Processing                    1a
    P Encryption      B                   EXPORT
     * -----------------------------------------------------------
     * CALL QMHRMVPM to remove all messages from passed program queue
     *  always return *OFF
     * -----------------------------------------------------------
    D Encryption      PI             1N
    D  ClearData                 32767a   Varying
    D  EncryptData               32767a   Varying
    D  Processing                    1a
     /Endif
     */copy qsysinc/qrpglesrc.QC3CCI
    D*******************************************************************
    D*Data definitions
    D*******************************************************************
    D*ALGD0200 algorithm description structure
    DQC3D0200         DS
    D*                                             Qc3 Format ALGD0200
    D QC3BCA                  1      4B 0
    D*                                             Block Cipher Alg
    D QC3BL                   5      8B 0
    D*                                             Block Length
    D QC3MODE                 9      9
    D*                                             Mode
    D QC3PO                  10     10
    D*                                             Pad Option
    D QC3PC                  11     11
    D*                                             Pad Character
    D QC3ERVED               12     12
    D*                                             Reserved
    D QC3MACL                13     16B 0
    D*                                             MAC Length
    D QC3EKS                 17     20B 0
    D*                                             Effective Key Size
    D QC3IV                  21     52
    D*                                             Init Vector
    D*ALGD0300 algorithm description structure
    DQC3D0300         DS
    D*                                             Qc3 Format ALGD0300
    D QC3SCA                  1      4B 0
    D*                                             Stream Cipher Alg
    D*ALGD0400 algorithm description structure
    DQC3D0400         DS
    D*                                             Qc3 Format ALGD0400
    D QC3PKA                  1      4B 0
    D*                                             Public Key Alg
    D QC3PKABF                5      5
    D*                                             PKA Block Format
    D QC3ERVED00              6      8
    D*                                             Reserved
    D QC3SHA                  9     12B 0
    D*                                             Signing Hash Alg
    D*ALGD0500 algorithm description structure
    DQC3D0500         DS
    D*                                             Qc3 Format ALGD0500
    D QC3HA                   1      4B 0
    D*                                             Hash Alg
    D*DATA0200 array data format structure
    DQC3A0200         DS
    D*                                             Qc3 Format DATA0200
    D QC3DP                   1     16*
    D*                                             Data Ptr
    D QC3DL                  17     20B 0
    D*                                             Data Len
    D QC3ERVED01             21     32
    D*                                             Reserved
    D*KEYD0200 key description format structure
    DQC3D020000       DS
    D*                                             Qc3 Format KEYD0200
    D QC3KT                   1      4B 0
    D*                                             Key Type
    D QC3KSL                  5      8B 0
    D*                                             Key String Len
    D QC3KF                   9      9
    D*                                             Key Format
    D QC3ERVED02             10     12             inz(x'000000')
    D*                                             Reserved
    D*QC3KS                  13     13
    D*
    D*                                variable length
    D*******************************************************************

     * API error structure
    D APIERR          DS
    D  ERRPRV                       10I 0 INZ(272)
    D  ERRLEN                       10I 0
    D  EXCPID                        7A
    D  RSRVD2                        1A
    D  EXCPDT                      256A
    D
     *Encrypt Data (OPM, QC3ENCDT; ILE, Qc3EncryptData) API protects
     *data privacy by scrambling clear data into an unintelligible form.
    D*Qc3EncryptData  Pr                  ExtProc('Qc3EncryptData')
    D Qc3EncryptData  Pr                  ExtPgm('QC3ENCDT')
    D clrDta                     32767a
    D clrDtaLen                     10I 0
    D clrDtaFmt                      8
    D algorithm                           like(QC3D0200)
    D algorithmFmt                   8
    D key                                 like(KeyC)
    D keyFmt                         8
    D srvProvider                    1
    D deviceName                    10
    D encryptedData              32767a
    D encryptedBufL                 10I 0
    D encryptedRtnL                 10I 0
    D errcde                              like(APIERR)

     * Decrypt Data (OPM, QC3DECDT; ILE, Qc3DecryptData) API restores
     * encrypted data to a clear (intelligible) form.
    D*Qc3DecryptData  Pr                  ExtProc('Qc3DecryptData')
    D Qc3DecryptData  Pr                  ExtPgm('QC3DECDT')
    D encryptedData              32767a
    D encryptedDtaL                 10I 0
    D algorithm                           like(QC3D0200)
    D algorithmFmt                   8
    D key                                 like(keyC)
    D keyFmt                         8
    D srvProvider                    1
    D deviceName                    10
    D clrDta                     32767a
    D clrDtaBufL                    10I 0
    D clrDtaRtnL                    10I 0
    D errcde                              like(APIERR)

    DQc3GenPRNs       Pr                  ExtPRoc('Qc3GenPRNs')
    D PrnDta                       512
    D PrnDtaLen                     10I 0
    D PrnType                        1
    D PrnParity                      1
    D errcde                              like(APIERR)

    D PrnDta          S            512
    D PrnDtaLen       S             10I 0
    D PrnType         S              1    inz('1')
    D PrnParity       S              1    inz('1')

    D clrDta          S          32767a
    D clrDtaLen       S             10I 0
    D clrDtaFmt       S              8    inz('DATA0100')
    D algorithm       S                   like(QC3D0200)
    D algorithmFmt    S              8    inz('ALGD0200')
    D key             S                   like(KeyC)
    D keyFmt          S              8    inz('KEYD0200')
    D srvProvider     S              1    inz('1')
    D deviceName      S             10    inz(*blanks)
    D encryptedData   S          32767a
    D encryptedDtaL   S             10I 0
    D encryptedBufL   S             10I 0
    D encryptedRtnL   S             10I 0
    D clrDtaBufL      S             10I 0
    D clrDtaRtnL      S             10I 0
     * Put in what ever key string you want - or pass it in
D KeyString S 256 Inz('123456789abcdefghiABCDEFGHI')
    D KeyC            S            256
    D returnCode      S               n

     /if not defined(SrvPgm)
    D ClearData       s          32767a   Varying
    D EncryptData     s          32767a   Varying
    D Processing      s              1a

    c     *Entry        plist
    c                   parm                    ClearData
    c                   parm                    EncryptData
    c                   parm                    Processing
     /EndIf

    C                   Eval      clrDta = ClearData
    C                   Eval      clrDtaLen = %len(%trimr(clrDta))
    C                   Eval      encryptedBufL = %size(encryptedData)
    C* Block cipher algorithm
     * 20 DES
     * 21 Triple DES
     * 22 AES
    C                   Eval      QC3BCA = 22
     *Block length
     *  8  DES
     *  8  Triple DES
     * 16  AES
    C                   Eval      QC3BL  = 16
     *Mode
     * 0 ECB
     * 1 CBC
     * 2 OFB. Not valid with AES.
     * 3 CFB 1-bit. Not valid with AES.
     * 4 CFB 8-bit. Not valid with AES.
     * 5 CFB 64-bit. Not valid with AES
    C                   Eval      QC3MODE = '1'
     * Pad Option
     * 0 No padding is performed.
* 1 Use the character specified in the pad character field for padding
     * 2 The pad counter is used as the pad character.
    C                   Eval      QC3PO   = '1'

     * Pad Character
    C                   Eval      QC3PC   = X'00'
     * Reserved
    C                   Eval      QC3ERVED = X'00'
     * MAC Length
     * This field is not used on an encrypt operation and must be set to
     * null(binary 0s).
    C                   Eval      QC3MACL  = X'00000000'
     * Effective key size
     * This field must be set to 0.
    C                   Eval      QC3EKS   = 0
     * Initialization vector
     * The initialization vector (IV). An IV is not used for mode ECB,
     * and must be set to NULL (binary 0s).
    C                   Eval      QC3IV = *AllX'00'
    C                   Reset                   encryptedData
    C                   Eval      encryptedBufL = %len(encryptedData)

    C*                  Eval      algorithm = %addr(QC3D0200)
    C                   Eval      algorithm = QC3D0200
     * Key Type            KeyFormat  KeyLength
* 20 DES 0 8(7 bits used,rightmost setbit * 21 Triple DES 0 8,16,24(7 bits used,rightmost setbit
     * 22 AES                     0   16,24,32
     * 30 RC4-compatible          0    1<->256
     * 50 RSA public              1
     * 51 RSA private             1
    C                   Eval      QC3KT = 22

     * Key Format
    C                   Eval      QC3KF = '0'
     * Key String
    C* mwh              Eval      KeyString = '12345678'
    C*                  Eval      PrnDtaLen = 8
    C*                  callP     Qc3GenPRNs(
    C*                               PrnDta        :
    C*                               PrnDtaLen     :
    C*                               PrnType       :
    C*                               PrnParity     :
    C*                               APIERR
    C*                            )
    C*                  ExSr      ChkErrCde
    C*                  Eval      KeyString = %SubSt(PrnDta :
    C*                                                1 : PrnDtaLen)
     * Key Length
    C                   Eval      QC3KSL = 32
    C                   Eval      KeyC = QC3D020000 + %trim(KeyString)
    C*                  Eval      Key  = %addr(KeyC)
    C                   Eval      Key  = KeyC

    C                   Select
    C                   When      Processing = 'E'

    C                   Eval      clrDta = ClearData
    C                   Eval      clrDtaLen = %len(%trimr(clrDta))
    C                   Eval      encryptedBufL = %size(encryptedData)


    C                   callP     Qc3EncryptData(
    C                                clrDta        :
    C                                clrDtaLen     :
    C                                clrDtaFmt     :
    C                                algorithm     :
    C                                algorithmFmt  :
    C                                key           :
    C                                keyFmt        :
    C                                srvProvider   :
    C                                deviceName    :
    C                                encryptedData :
    C                                encryptedBufL :
    C                                encryptedRtnL :
    C                                APIERR
    C                             )
    C                   ExSr      ChkErrCde

    C                   When      Processing = 'D'

    C                   Eval      encryptedData = encryptData
C Eval encryptedDtaL = %len(%trimr(encryptedData))
    C                   Eval      clrDtaBufL = %size(clrDta)
    C                   callP     Qc3DecryptData(
    C                                encryptedData :
    C                                encryptedDtaL :
    C                                algorithm     :
    C                                algorithmFmt  :
    C                                key           :
    C                                keyFmt        :
    C                                srvProvider   :
    C                                deviceName    :
    C                                clrDta        :
    C                                clrDtaBufL    :
    C                                clrDtaRtnL    :
    C                                APIERR
    C                             )
    C                   ExSr      ChkErrCde
    C                   EndSl

    C                   Eval      *InLr = *On
     /If defined(SrvPgm)
    C                   Return                  returnCode
     /Else
    C                   Return
     /EndIf
**********************************************************************
    C     ChkErrCde     BegSr
    C                   If        ERRLEN > 0
    C*                  dump
    C                   Eval      returnCode = *on
    C                   Else
    C                   Eval      returnCode = *off
    C                   Select
    C                   When      Processing = 'E'
    C                   Eval      encryptData =
    C                              %subst(encryptedData:1:encryptedRtnL)
    C                   When      Processing = 'D'
    C                   Eval      ClearData = %subst(clrDta:1:clrDtaRtnL)
    C                   EndSl
    C                   EndIf
    C*                  Dump
    C                   EndSr
**********************************************************************
     /If defined(SrvPgm)
    P Encryption      E
     /EndIf

Matt Hopkins Sr. Programmer/Analyst Web: www.pdpgroupinc.com Email: MWHopkins@xxxxxxxxxxxxxxx Office: 410-584-0330 Fax: 410-584-0336



As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.