如何於 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
沒有留言:
張貼留言