星期四, 11月 09, 2023

2012-12-27 如何於 AS400 系統中建立一個文字型態的序號產生器?(NumericToAlpha sequence generator)


如何於 AS400 系統中建立一個文字型態的序號產生器?(NumericToAlpha sequence generator)

下列範例為二位文字型態的序號產生器,其產生順序為
00,01,...,09,0A,...0Z,10,11...,A0,A1,...,ZZ
二位文字型態的序號可以產生 1296 個序號。



File  : QRPGLESRC

Member: SEQGENRT

Type  : RPGLE

Usage : CRTBNDRPG SEQGENRT
        CALL SEQGENRT     
        會產生一份報表,前段為 1296 個序號列,後段為取下依序號測試。



     **
     **  Program . . : SEQGENRT
     **  Description : 2 byte NumericToAlpha sequence generator demo
     **
     **  Author  . . : Vengoal Chang
     **
     **  Date    . . : 2012/12/27
     **
     **  Modified  . :
     **
     **  Compile and setup instructions:
     **    CrtBndRpg   Pgm( SEQGENRT  )
     **
     **
     **-- Control specification:  --------------------------------------------**
     H Option( *SrcStmt: *NoDebugIo ) DftActGrp(*NO) Debug

     FQSYSPRT   O    F  132        printer

      *00,01,...,09,0A,...0Z,10,11...,A0,A1,...,ZZ
     D NumericToAlpha  C                   '1'

     D keyCode         S              2
     D currCode        S              2
     D nextCode        S              2
     D code            S              2

     D CodeLen         S              2  0 Inz(2)
     D currNbr         S             20U 0
     D codeNbr         S             20U 0
     D nextNbr         S             20U 0
     D nextNbrC        S             20
     D Mul             S             20U 0
     D divBase         S             20U 0
     D divNbr          S             20U 0
     D remNbr          S              2  0
     D i               S              2  0
     D pos             S              2  0
     D count           S              2  0
     D oneChar         S              1
     D idx             S              5U 0

     D SequenceType    S              1

     D TABCHA1         S              1    DIM(36) CTDATA PERRCD(1)             Hex Cnv Tbl
     D TABDEC1         S              2  0 DIM(36) ALT(TABCHA1)

     D TABDEC2         S              2  0 DIM(36) CTDATA PERRCD(1) ASCEND      Hex Cnv Tbl
     D TABCHA2         S              1    DIM(36) ALT(TABDEC2)

     D tmpStr          S             52

     C                   eval      *InLr = *On

     C                   eval      currCode  = 'ZZ'
     C                   eval      code = currCode
     C                   exSr      GetCodeNbr
     C     codeNbr       dsply

      * code list
     C                   For       idx = 0     to 1295
     C                   eval      currNbr = idx
     C                   eval      tmpStr = %Char(currNbr)
     C                   exSr      GetCode
     C                   eval      tmpStr = %trim(tmpStr) + ' ' +
     C                                      Code
     C                   eval      currCode = Code
     C                   exSr      GetCodeNbr
     C                   eval      tmpStr = %trim(tmpStr) + ' ' +
     C                                      %Char(codeNbr)
     C                   except    output1
     C                   EndFor
      * next code list
     C                   eval      keyCode = '00'
     C                   For       idx = 0     to 1295
     C                   exSr      GetNextCode
     C                   eval      tmpStr = %char(idx) +' '+currCode + ' ' +
     C                                      nextCode
     C                   except    output1
     C                   eval      keyCode = nextCode
     C                   EndFor

     C                   return

     C*=====================================================================
     C     GetNextCode   BegSr
     C                   eval      currCode = keyCode
     C                   exSr      GetCodeNbr
     C                   eval      codeNbr = codeNbr + 1
     C                   eval      currNbr = codeNbr
     C                   exSr      GetCode
     C                   eval      nextCode = code
     C                   EndSr
     C*=====================================================================
     C     GetCodeNbr    BegSr

     C                   eval      code = currCode
      * convert to number base 36
     C                   eval      mul = 0
     C                   For       pos = CodeLen    downto 1
     C                   eval      oneChar = %SubSt(code:pos:1)
     C     oneChar       lookup    TabCha1       TabDec1                  50
     C   50              z-Add     TabDec1       tempNbr           2 0
     C                   If        pos <> CodeLen
     C                   If        pos =  (CodeLen    - 1)
     C                   eval      mul = 36
     C                   Else
     C                   eval      mul = mul * 36
     C                   EndIf
     C                   Else
     C                   eval      codeNbr = tempNbr
     C                   iter
     C                   EndIf
     C                   eval      codeNbr = codeNbr + mul * tempNbr
     C                   EndFor

     C                   EndSr

     C*=====================================================================
     C     GetCode       BegSr

     C                   eval      codeNbr = currNbr
     C                   eval      divBase = 36
     C                   For       pos = CodeLen downto 1

     C                   eval      divNbr = %DIV(codeNbr: divBase)
     C                   eval      remNbr = %REM(codeNbr: divBase)

     C     remNbr        lookup    TABDEC2       TABCHA2                  50
     C                   move      TabCha2       oneChar
     C                   eval      %SubSt(Code :pos:1) = oneChar
     C                   eval      codeNbr = divNbr

     C                   EndFor

     C                   EndSr
      *
     O
     OQSYSPRT   E            OUTPUT1        1
     O                       TmpStr

      *
**
000
101
202
303
404
505
606
707
808
909
A10
B11
C12
D13
E14
F15
G16
H17
I18
J19
K20
L21
M22
N23
O24
P25
Q26
R27
S28
T29
U30
V31
W32
X33
Y34
Z35
**
000
011
022
033
044
055
066
077
088
099
10A
11B
12C
13D
14E
15F
16G
17H
18I
19J
20K
21L
22M
23N
24O
25P
26Q
27R
28S
29T
30U
31V
32W
33X
34Y
35Z



範例執行結果:
前段為編碼列表如下:
第一欄為數字序號,第二欄為數字序號編碼結果,第三欄為第二欄編碼解回為數字與第一欄檢核一致。
0 00 0  
1 01 1  
2 02 2  
3 03 3  
4 04 4  
5 05 5  
6 06 6  
7 07 7  
8 08 8  
9 09 9  
10 0A 10
11 0B 11
12 0C 12
13 0D 13
14 0E 14
15 0F 15
16 0G 16
17 0H 17
18 0I 18
19 0J 19
20 0K 20
21 0L 21
22 0M 22
23 0N 23
24 0O 24
25 0P 25
26 0Q 26
27 0R 27
28 0S 28
29 0T 29
30 0U 30
31 0V 31
32 0W 32
33 0X 33
34 0Y 34
35 0Z 35
36 10 36
37 11 37
38 12 38
39 13 39
40 14 40
41 15 41
42 16 42
43 17 43
44 18 44
45 19 45
46 1A 46
47 1B 47
....
1287 ZR 1287
1288 ZS 1288
1289 ZT 1289
1290 ZU 1290
1291 ZV 1291
1292 ZW 1292
1293 ZX 1293
1294 ZY 1294
1295 ZZ 1295

後段為使用初始編號去取下一位編號,
第一欄為序號,第二欄為初始編號,第三欄為下一位編號。
0 00 01 
1 01 02 
2 02 03 
3 03 04 
4 04 05 
5 05 06 
6 06 07 
7 07 08 
8 08 09 
9 09 0A 
10 0A 0B
11 0B 0C
12 0C 0D
13 0D 0E
14 0E 0F
15 0F 0G
16 0G 0H
17 0H 0I
18 0I 0J
19 0J 0K
20 0K 0L
21 0L 0M
22 0M 0N
23 0N 0O
24 0O 0P
25 0P 0Q
26 0Q 0R
27 0R 0S
28 0S 0T
29 0T 0U
30 0U 0V
31 0V 0W
32 0W 0X
33 0X 0Y
34 0Y 0Z
35 0Z 10
36 10 11
37 11 12
38 12 13
39 13 14
40 14 15
........
1280 ZK ZL
1281 ZL ZM
1282 ZM ZN
1283 ZN ZO
1284 ZO ZP
1285 ZP ZQ
1286 ZQ ZR
1287 ZR ZS
1288 ZS ZT
1289 ZT ZU
1290 ZU ZV
1291 ZV ZW
1292 ZW ZX
1293 ZX ZY
1294 ZY ZZ
1295 ZZ 00





沒有留言: