2003-12-09 如何於 RPG中 針對所定義的資料結構(DataStructure)排序？(C API QSORT)

如何於 RPG中 針對所定義的資料結構(DataStructure)排序？(C API QSORT)

於 RPG 中，若要針對矩陣排序相信大家都會使用 SORTA ，但 SORTA 並無法針對
D spec 資料結構的特定欄位排序，若要針對資料結構排序須使用 C API QSORT，V5R1 後，
ILE RPG 支援指定(Qualified)資料結構的欄位範例如下：


File  : QRPGLESRC
Member: QSORTR
Type  : RPGLE
Usage : CRTBNDRPG QSORTR
        CALL QSORTR
OS Version: V5R1

     H DFTACTGRP(*NO) BNDDIR('QC2LE')

     D qsort           PR                  ExtProc('qsort')
     D   base                          *   value
     D   num                         10U 0 value
     D   width                       10U 0 value
     D   compare                       *   procptr value

     D SortByItem      PR            10I 0
     D   parm1                             likeds(Order)
     D   parm2                             likeds(Order)

     D SortByQty       PR            10I 0
     D   parm1                             likeds(Order)
     D   parm2                             likeds(Order)

     D Order           DS                  based(prototype_only)
     D                                     Qualified
     D  DtlItem                      12A
     D  DtlOrdQty                     5S 0

     D Order1          DS                  likeds(Order) dim(99)
     D numitems        s             10I 0
     D idx             s             10I 0
     D tmpstr          s             50
     D tmpnbr          s             10I 0

      ** Throw some sample data into array to test it.

     c                   eval      order1(1).DtlItem = 'ZZ123'
     c                   eval      order1(1).DtlOrdQty = 5

     c                   eval      order1(2).DtlItem = 'BB321'
     c                   eval      order1(2).DtlOrdQty = 17

     c                   eval      order1(3).DtlItem = 'RR826'
     c                   eval      order1(3).DtlOrdQty = 14

     c                   eval      order1(4).DtlItem = 'AA000'
     c                   eval      order1(4).DtlOrdQty = 3
     c                   eval      numitems = 4

      ** Sort the array by DtlItem

     c                   callp     qsort(%addr(Order1): numitems:
     c                                %size(Order): %paddr('SORTBYITEM'))
     c                   For       idx= 1 to numitems
     c                   eval      tmpstr = order1(idx).DtlItem
     c                   Dsply                   tmpstr
     c                   Endfor

      ** Sort the array by DtlOrdQty

     c                   callp     qsort(%addr(Order1): numitems:
     c                                %size(Order): %paddr('SORTBYQTY'))
     c                   For       idx= 1 to numitems
     c                   eval      tmpnbr = order1(idx).DtlOrdQty
     c                   Dsply                   tmpnbr
     c                   Endfor
     c                   eval      *inlr = *on

      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P SortByItem      B
     D SortByItem      PI            10I 0
     D   parm1                             likeds(Order)
     D   parm2                             likeds(Order)

     c                   select
     c                   when      parm1.DtlItem < parm2.DtlItem
     c                   return    -1
     c                   when      parm1.DtlItem > parm2.DtlItem
     c                   return    1
     c                   other
     c                   return    0
     c                   endsl

     P                 E


      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P SortByQty       B
     D SortByQty       PI            10I 0
     D   parm1                             likeds(Order)
     D   parm2                             likeds(Order)

     c                   select
     c                   when      parm1.DtlOrdQty < parm2.DtlOrdQty
     c                   return    -1
     c                   when      parm1.DtlOrdQty > parm2.DtlOrdQty
     c                   return    1
     c                   other
     c                   return    0
     c                   endsl

     P                 E