如何於 AS400 系統中建立一個文字型態的序號產生器？(NumericToAlpha sequence generator)
下列範例為二位文字型態的序號產生器，其產生順序為
00,01,...,09,0A,...0Z,10,11...,A0,A1,...,ZZ
二位文字型態的序號可以產生 1296 個序號。
File : QRPGLESRCMember: 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
沒有留言:
張貼留言