2005-04-17 如何於 RPG 中產生 MD5 值 ?

如何於 RPG 中產生 MD5 值 ?

由於現今線上交易頻繁, 時常需要將訊息加以確認無誤, 
前期是使用 XOR 函式, 這一期使用 MD5, 這一期並加
上轉碼功能, 由於AS/400 是用 EBCDIC, 而外端都是使用 
ASCII 所以需要先做轉碼動作再取 MD5 值, 並以 16 位元字串呈現. 


File  : QRPGLESRC
Member: MD5R
Type  : RPGLE
Usage : CRTBNDRPG
OS    : All

      *
      * ascii 'message digest'
      * MD5 = f96b697d7cb7938d525a2f31aaf161d0

     H DFTACTGRP(*NO) ACTGRP('QILE') BNDDIR('QC2LE')
     DCipher           PR                  EXTPROC('_CIPHER')
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     DConvert          PR                  EXTPROC('_XLATEB')
     D                                 *   VALUE
     D                                 *   VALUE
     D                               10u 0 VALUE
     Dcvthc            PR                  EXTPROC('cvthc')
     D                                1
     D                                1
     D                               10i 0 VALUE
     DControls         DS
     D Function                       5i 0 inz(5)
     D HashAlg                        1    inz(x'00')
     D Sequence                       1    inz(x'00')
     D DataLngth                     10i 0 inz(15)
     D Unused                         8    inz(*LOVAL)
     D HashCtxPtr                      *   inz(%addr(HashWorkArea))
     DHashWorkArea     S             96    inz(*LOVAL)
     DMsg              S             50
     DReceiverHex      S             16
     DReceiverPtr      S               *   inz(%addr(ReceiverHex))
     DReceiverChr      S             32
     DSourcePtr        S               *   inz(%addr(Msg))
     DStartMap         s            256
     DTo819            s            256
     DCCSID1           s             10i 0 inz(37)
     DST1              s             10i 0 inz(0)
     DL1               s             10i 0 inz(%size(StartMap))
     DCCSID2           s             10i 0 inz(819)
     DST2              s             10i 0 inz(0)
     DGCCASN           s             10i 0 inz(0)
     DL2               s             10i 0 inz(%size(To819))
     DL3               s             10i 0
     DL4               s             10i 0
     DFB               s             12
     D                 ds
     D x                              5i 0
     D LowX                    2      2
     D* Get all single byte ebcdic hex values
     C     0             do        255           x
     C                   eval      %subst(StartMap:x+1:1) = LowX
     C                   enddo
     C* Get conversion table for 819 from 37
     C                   call      'QTQCVRT'
     C                   parm                    CCSID1
     C                   parm                    ST1
     C                   parm                    StartMap
     C                   parm                    L1
     C                   parm                    CCSID2
     C                   parm                    ST2
     C                   parm                    GCCASN
     C                   parm                    L2
     C                   parm                    To819
     C                   parm                    L3
     C                   parm                    L4
     C                   parm                    FB
     C* Set message text
     C                   eval      Msg = 'message digest'
     C                   eval      DataLngth = %len(%trimr(Msg))
     C* Now Change Msg to 819 from 37 using MI
     C                   callp     Convert( %addr(Msg)
     C                                     :%addr(To819)
     C                                     :%size(Msg))
     C* Get MD5 for Msg
     C                   callp     Cipher( %addr(ReceiverPtr)
     C                                    :%addr(Controls)
     C                                    :%addr(SourcePtr))
     C* Convert nibbles to characters
     C                   callp     cvthc( ReceiverChr
     C                                   :ReceiverHex
     C                                   :%size(ReceiverChr))
     C* Display the ascii "message digest"
      * MD5 = f96b697d7cb7938d525a2f31aaf161d0
     C     ReceiverChr   dsply
     C                   eval      *INLR = '1'
     C                   return