如何於 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
A blog about IBM i (AS/400), MQ and other things developers or Admins need to know.
星期四, 11月 09, 2023
2012-12-27 如何於 AS400 系統中建立一個文字型態的序號產生器?(NumericToAlpha sequence generator)
訂閱:
張貼留言 (Atom)
沒有留言:
張貼留言