如何處理由資料庫中數字欄位含有非數字字元,所引起的程式錯誤?(Command FIXDECERR)
於執行應用程式時, 有時會遇到數字性(Decimal error), 此時程式會當掉, 這是由於
程式中的數字變數或資料庫中數字欄位含有非數字字元, 例如最常見數字變數或數字
欄位含有空白字元, 程式中的數字變數需要除蟲. 但是資料庫中的數字性錯誤要如何
解決, 因為資料庫中的資料要當程式讀到該筆錯誤資料成適當掉時,才能知道哪一筆資
料錯誤, 對於資料維護非常麻煩, 因為你不知道程式何時會當掉, 特別是當鉅量資料
需要作分析時, 若該資料可能是從其他平台轉入更為常見, 而當轉入程式寫的不周延
或該檔案擴增欄位時, 與該檔案相關程式未同時修改及編譯時, 這種數字性錯誤就會
時常發生. 那要如何掃描整個檔案資料是先查出哪幾筆資料是錯誤的呢?
1. 我先產生一個內含數字錯誤資料的測試檔.
File : QDDSSRC
Member: DAMPF
Type : PF
Usage : CRTPF DAMPF
A R DAMR TEXT('TEST 數字錯誤 ')
A CHAR 3
A NUMP 3 0
A NUMS 3S 0
2. 接著產生錯誤資料
File : QRPGLESRC
Member: DAMR
Type : RPGLE
Usage : CRTBNDRPG DAMR
CALL DAMR
H debug
FDAMPF O A F 8 Disk
D idx S 3 0
D xxa DS
D nump 3p 0
D xxxa DS
D nums 3S 0
D OutputData DS
D CHAR 3A
D XX 2A
D XXX 3A
C Eval idx = 1
C For idx =1 to 10
C Eval char = %char(idx)
C If %rem(idx:2) <> 0
C Eval nump = idx
C Eval nums = idx
C eval xx = xxa
C eval xxx = xxxa
c dump
C Else
C move ' ' xx
C move ' ' xxx
C EndIf
C WRITE DAMPF OutputData
C EndFor
C Eval *InLr = *on
3. 當呼叫上述程式後, DAMPF 已存在錯誤性數字資料, 可以下令 RUNQRY *N DAMPF
可得如下結果:
Display Report
Report width . . . . . : 18
Position to line . . . . . Shift to column . . . . . .
Line ....+....1....+...
CHAR NUMP NUMS
000001 1 1 1
000002 2 ++++ ++++
000003 3 3 3
000004 4 ++++ ++++
000005 5 5 5
000006 6 ++++ ++++
000007 7 7 7
000008 8 ++++ ++++
000009 9 9 9
000010 10 ++++ ++++
****** ******** End of report ********
其中 ++++ 即表示該數字欄位含有錯誤數字資料, 若其他應用程式讀取該錯誤資料時, 程式就會當掉,
若資料有數萬筆, 管資料的人可就累死了.
所以我提供一個工具 FIXDECERR 來解決這個問題.
File : QCLSRC
Member: DEC001CL
Type : CLP
Usage : CRTCLPGM DEC001CL
DEC001CL: +
PGM PARM(&QF &MBR &LSTERR &UPDOPT &CHKSIGNED &CHKPACKED)
DCL VAR(&CHKPACKED) TYPE(*CHAR) LEN(4)
DCL VAR(&CHKSIGNED) TYPE(*CHAR) LEN(4)
DCL VAR(&EXTDEF) TYPE(*CHAR) LEN(1)
DCL VAR(&FILNAM) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&LSTERR) TYPE(*CHAR) LEN(4)
DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
DCL VAR(&QF) TYPE(*CHAR) LEN(20)
DCL VAR(&UPDOPT) TYPE(*CHAR) LEN(7)
DCLF QAFDBASI
/* Break qualified name */
CHGVAR VAR(&FILNAM) VALUE(%SST(&QF 1 10))
CHGVAR VAR(&LIB) VALUE(%SST(&QF 11 10))
/* Check for file and member existence */
CHKOBJ OBJ(&LIB/&FILNAM) OBJTYPE(*FILE) MBR(&MBR)
MONMSG MSGID(CPF9801) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('File' *BCAT +
&FILNAM *BCAT 'not found in' *BCAT &LIB) MSGTYPE(*ESCAPE)
RETURN
ENDDO
MONMSG MSGID(CPF9810) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Library' *BCAT +
&LIB *BCAT 'not found') MSGTYPE(*ESCAPE)
RETURN
ENDDO
MONMSG MSGID(CPF9815) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Member' *BCAT +
&MBR *BCAT 'not found') MSGTYPE(*ESCAPE)
RETURN
ENDDO
/* Verify that the file is externally described */
CLRPFM FILE(QTEMP/FILEATR)
MONMSG MSGID(CPF0000)
DSPFD FILE(&LIB/&FILNAM) TYPE(*BASATR) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/FILEATR)
OVRDBF FILE(QAFDBASI) TOFILE(QTEMP/FILEATR)
/* READ FOR CHECK FILE EXTERNAL DESCRIPTED OR NOT */
RCVF
IF COND(&ATFLS *NE 'Y') THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('File' *BCAT +
&FILNAM *BCAT 'is not externally described') MSGTYPE(*ESCAPE)
RETURN
ENDDO
/* Output the file field definitions */
CLRPFM FILE(QTEMP/FILEFFD)
MONMSG MSGID(CPF0000)
DSPFFD FILE(&LIB/&FILNAM) OUTPUT(*OUTFILE) OUTFILE(QTEMP/FILEFFD)
OVRDBF FILE(QADSPFFD) TOFILE(QTEMP/FILEFFD)
OVRDBF FILE(DATAIN) TOFILE(&LIB/&FILNAM) MBR(&MBR)
CALL PGM(DEC001RGA) PARM(&CHKSIGNED &CHKPACKED &UPDOPT &LSTERR)
ENDPGM
File : QDDSSRC
Member: DEC001P1
Type : PRTF
Usage : CRTPRTF DEC001P1
A R HEADINGS SKIPB(6)
A 1DATE EDTCDE(Y)
A 14TIME EDTWRD(' . . ')
A 26'File:'
A WHFILE 10A O 32
A 47'Update Option:'
A USUPOP 7A O 62
A 77'Check S/P:'
A USSIGN 4A O 88
A USPACK 4A O 93
A 122'Page:'
A 129PAGNBR EDTCDE(3)
A SPACEA(1)
A 1'FIXDECERR'
A 24'Format:'
A WHNAME 10A O 34
A 47'Length:'
A WHRLEN 5S 0O 55EDTCDE(3)
A 77'Text:'
A WHTEXT 50O O 83
A SPACEA(2)
A 11'Field'
A 23'Start'
A 30'Length'
A 38'Field'
A SPACEA(1)
A 3'Record'
A 11'Name'
A 23'Pos.'
A 30'Bytes'
A 38'Type'
A 45'Value'
A 77'Description'
A SPACEA(2)
*
A R DETAIL SPACEA(1)
A RECNO 8S 0O 1EDTCDE(3)
A FLDNAM 10A O 11
A FLDBEG 5S 0O 23EDTCDE(3)
A FLDLEN 5S 0O 31EDTCDE(3)
A FLDTYP 1A O 40
A FLDHEX 30A O 45
A FLDDSC 50A O 77
File : QRPGLESRC
Member: DEC001RGA
Type : RPGLE
Usage : CRTBNDRPG DEC001RGA
FDATAIN UP F 9999 DISK INFDS(INFDS)
FQADSPFFD IF E DISK
FDEC001P1 O E PRINTER OFLIND(*IN99)
*
D REC S 1 DIM(9999) Input record
D REX S 1 DIM(9999) Sav Rec/Hex Dsp
D TABHEX S 2 0 DIM(16) CTDATA PERRCD(1) ASCEND Hex Cnv Tbl
D TABCHA S 1 DIM(16) ALT(TABHEX)
D INFDS DS
* Relative Record #
D RECNOX 397 400B 0
* Field information
D FLDINF DS OCCURS(300)
D FLDBEG 1 5 0
D FLDLEN 6 10 0
D FLDTYP 11 11
D FLDDSC 12 61
D FLDNAM 62 71
* Convert array to field for printer file
D DS
D HX 1 30
D DIM(30) Hex Value
D FLDHEX 1 30
* Constants
D ON C CONST('1')
D OFF C CONST('0')
*
IDATAIN NS
I 1 9999 REC
*=====================================================
C *ENTRY PLIST
C PARM USSIGN 4
C PARM USPACK 4
C PARM USUPOP 7
C PARM USLSER 4
*
C MOVE OFF ERRREC 1
C Z-ADD RECNOX RECNO 8 0
C MOVEL REC REX
*
C 1 DO S X 5 0
C X OCCUR FLDINF
C EXSR CHKNUM
C END
*
C USUPOP IFNE '*NONE'
C ERRREC ANDEQ ON
C EXCEPT UDATA
C END
*=====================================================
C CHKNUM BEGSR
* Validate Numeric Data
* ERRPOS is on if indiviudal position is in error
* and is off for the next position test
* ERRFLD is on when any error occurs in the filed test
* and is off when the next field is tested
C Z-ADD FLDBEG ST 5 0
C MOVE OFF ERRFLD 1
*
C 1 DO FLDLEN Y 5 0
C MOVEL REC(ST) WKD 1
C MOVE OFF ERRPOS 1
*
C FLDTYP IFEQ 'P'
C EXSR VALPCK
C END
*
C FLDTYP IFEQ 'S'
C EXSR VALDEC
* Initialize field position to zero - Signed decimal only
C USUPOP IFEQ '*INZDGT'
C ERRPOS ANDEQ ON
C MOVEL OFF REC(ST)
C END
C END
*
C ERRPOS IFEQ ON
C MOVE ON ERRFLD
C END
*
C ADD 1 ST
C END
* Initialize field to zeros and calculate hex value
C ERRFLD IFEQ ON
C MOVE ON ERRREC
C Z-ADD 1 H 5 0
C Z-ADD FLDBEG ST 5 0
C MOVEL *BLANKS HX
*
C 1 DO FLDLEN Y
C MOVEA REX(ST) HEXCNV 1
C EXSR HEXCNX
C H IFLE 30
C MOVEA HEXCHA HX(H)
C END
C ADD 2 H
*
C USUPOP IFEQ '*INZFLD'
C FLDTYP ANDEQ 'S'
C MOVEL OFF REC(ST)
C END
*
C USUPOP IFNE '*NONE'
C FLDTYP ANDEQ 'P'
C MOVEL X00 REC(ST)
*
C Y IFEQ FLDLEN
C MOVEL X0F REC(ST)
C END
C END
*
C ADD 1 ST
C END
C END
* Print Error Report
C USLSER IFEQ '*YES'
C ERRFLD ANDEQ ON
C *IN99 IFEQ ON
C WRITE HEADINGS
C MOVE OFF *IN99
C END
C WRITE DETAIL
C END
C ENDSR
*=====================================================
C VALDEC BEGSR
* Validate single signed numeric characters (WKD)
C WKD IFGT '9'
C WKD ORLT '0'
* Test digit portion first
C MOVEL WKD CNVDIG 1
C EXSR CNVDIX
*
C DIGIT IFGT 9
C MOVE ON ERRPOS
C END
* Test zone portion next
C MOVEL WKD CNVZON 1
C EXSR CNVZOX
*
C ZONE IFNE 15 Sign +
C ZONE ANDNE 13 Sign -
C MOVE ON ERRPOS
C END
* Sign valid on last character only
C ZONE IFEQ 13
C Y ANDNE FLDLEN
C MOVE ON ERRPOS
C END
C END
C ENDSR
*=====================================================
C VALPCK BEGSR
* Validate packed numeric characters (WKD)
* Test zone portion first
C MOVEL WKD CNVZON 1
C EXSR CNVZOX
*
C ZONE IFGT 9
C MOVE ON ERRPOS
C END
* Test digit portion next
C MOVEL WKD CNVDIG 1
C EXSR CNVDIX
* Not last digit must be value 0-9
C Y IFNE FLDLEN
C DIGIT ANDGT 9
C MOVE ON ERRPOS
C END
* Last digit must be sign value
C Y IFEQ FLDLEN
C DIGIT ANDNE 13 Sign -
C DIGIT ANDNE 15 Sign +
C MOVE ON ERRPOS
C END
C ENDSR
*=====================================================
C HEXCNX BEGSR
* Convert character to hex value (Display purposes)
C MOVEL *BLANKS HEXCHA 2
C MOVEL HEXCNV CNVZON
C EXSR CNVZOX
*
C ZONE LOOKUP TABHEX TABCHA 50
C 50 MOVEL TABCHA HEXCHA
*
C MOVEL HEXCNV CNVDIG
C EXSR CNVDIX
*
C DIGIT LOOKUP TABHEX TABCHA 50
C 50 MOVE TABCHA HEXCHA
C ENDSR
*=====================================================
C CNVDIX BEGSR
* Convert digit portion of character to number
C Z-ADD 0 DIGIT 2 0
C TESTB '4' CNVDIG 50
C 50DIGIT ADD 8 DIGIT
C TESTB '5' CNVDIG 50
C 50DIGIT ADD 4 DIGIT
C TESTB '6' CNVDIG 50
C 50DIGIT ADD 2 DIGIT
C TESTB '7' CNVDIG 50
C 50DIGIT ADD 1 DIGIT
C ENDSR
*=====================================================
C CNVZOX BEGSR
* Convert zone portion of character to number
C Z-ADD 0 ZONE 2 0
C TESTB OFF CNVZON 50
C 50ZONE ADD 8 ZONE
C TESTB ON CNVZON 50
C 50ZONE ADD 4 ZONE
C TESTB '2' CNVZON 50
C 50ZONE ADD 2 ZONE
C TESTB '3' CNVZON 50
C 50ZONE ADD 1 ZONE
C ENDSR
*=====================================================
C *INZSR BEGSR
C BITOFF '01234567' X00 1
C BITOFF '01234567' X0F 1
C BITON '4567' X0F
* Initialization - Get field definitions
C READ QWHDRFFD 40
C *IN40 DOWEQ OFF
C WHFLDT IFEQ 'S'
C USSIGN ANDEQ '*YES'
C WHFLDT OREQ 'P'
C USPACK ANDEQ '*YES'
C ADD 1 S 5 0
C S OCCUR FLDINF
C MOVEL WHFLDE FLDNAM
C MOVEL WHFLDT FLDTYP
C Z-ADD WHFLDB FLDLEN
C Z-ADD WHIBO FLDBEG
C MOVEL WHFTXT FLDDSC
C END
C READ QWHDRFFD 40
C END
C WRITE HEADINGS
C ENDSR
*=====================================================
ODATAIN E UDATA
O REC 9999
**
000
011
022
033
044
055
066
077
088
099
10A
11B
12C
13D
14E
15F
File : QCMDSRC
Member: FIXDECERR
Type : CMD
Usage : CRTCMD CMD(FIXDECERR) PGM(DEC001CL)
FIXDECERR: CMD PROMPT('Fix Decimal Data Errors')
PARM KWD(FILE) TYPE(QUAL1) MIN(1) PROMPT('File to +
check')
PARM KWD(MBR) TYPE(*NAME) DFT(*FIRST) +
SPCVAL((*FIRST)) EXPR(*YES) PROMPT('Member')
PARM KWD(LSTERR) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) EXPR(*YES) +
PROMPT('List fields in error')
PARM KWD(UPDOPT) TYPE(*CHAR) LEN(7) RSTD(*YES) +
DFT(*NONE) VALUES(*NONE *INZFLD *INZDGT) +
EXPR(*YES) PROMPT('Field update option')
PARM KWD(CHKSIGNED) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) EXPR(*YES) +
PROMPT('Check signed decimal')
PARM KWD(CHKPACKED) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) EXPR(*YES) +
PROMPT('Check packed decimal')
QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) EXPR(*YES) +
PROMPT('Library')
FIXDECERRusage:
Fix Decimal Data Errors (FIXDECERR)
Type choices, press Enter.
File to check . . . . . . . . . DAMPF Name <== 欲修正的檔案
Library . . . . . . . . . . . *LIBL Name, *LIBL
Member . . . . . . . . . . . . . *FIRST Name, *FIRST
List fields in error . . . . . . *YES *YES, *NO <== 印出錯誤報表
Field update option . . . . . . *NONE *NONE, *INZFLD, *INZDGT
Check signed decimal . . . . . . *YES *YES, *NO
Check packed decimal . . . . . . *YES *YES, *NO
Field update option : 執行時是否修正錯誤
*NONE : 不修正
*INZDGT: 修正為 0, 保留正負號
*INZFLD: 修正為 0(建議使用此值)
星期二, 11月 07, 2023
2006-04-19 如何處理由資料庫中數字欄位含有非數字字元,所引起的程式錯誤?(Command FIXDECERR)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言