- 论坛徽章:
- 0
|
rpg的小问题谁能解决一下，先谢了！（新手）
原程序是这样的，但是不能编译，是40的错误：
大概初学者都是这样的程序是抄完了，但是一旦出错就不会找了。请再看看。
DDS文件
CUST PF CUST
.....A..........T.Name++++++RLen++TDpB......Functions++++++++
*************** Beginning of data ***************************
A R CUSTR TEXT('CUSTOMER')
A CUS# 6S 0 TEXT('CUST #')
A CUSNAM 30A TEXT('NAME')
A CUSAD1 30A TEXT('ADDRESS 1')
A CUSAD2 30A TEXT('ADDRESS 2')
A CUSCTY 20A TEXT('CITY')
A CUSSTA 2A TEXT('STATE')
A CUSZIP 5S 0 TEXT('ZIP')
A K CUS#
****************** End of data ******************************
CUSTD01 DSPF CUSTD01
.....AAN01N02N03T.Name++++++RLen++TDpBLinPosFunctions++++++++++++++++++
*************** Beginning of data *************************************
A REF(CUST)
A CA03(03 'F3=EXIT')
A R SCR1
A 1 2USER
A O 1 28'ADD/UPDATE/DELETE/INQUIRE'
A DSPATR(HI)
A 1 72DATE
A EDTCDE(Y)
A 2 2'CUSTR01'
A 2 72TIME
A O 6 8'(A)DD, (U)PDATE, (D)ELETE'
A O 6 34'(I)NQUIRE, (N)EXT'
A ACTION 1 B 6 53DSPATR(HI)
A O 8 28'CUST#'
A CUS# R B 8 35DSPATR(HI) EDTCDE(4)
A ERRLIN 78 O 22 2
A 2 2'CUSTR01'
A 2 72TIME
A O 6 8'(A)DD, (U)PDATE, (D)ELETE'
A O 6 34'(I)NQUIRE, (N)EXT'
A ACTION 1 B 6 53DSPATR(HI)
A O 8 28'CUST#'
A CUS# R B 8 35DSPATR(HI) EDTCDE(4)
A ERRLIN 78 O 22 2
A 90 DSPATR(RI)
A O 23 14'F3=EXIT'
A*----------------------------------------------------------------
A R SCR2
A CA09(09 'F9=DELETE')
A 1 2USER
A 1 28'CUSTOMER FILE MAINTENANCE'
A 1 72DATE
A EDTCDE(Y)
A O 23 14'F3=EXIT'
A*----------------------------------------------------------------
A R SCR2
A CA09(09 'F9=DELETE')
A 1 2USER
A 1 28'CUSTOMER FILE MAINTENANCE'
A 1 72DATE
A EDTCDE(Y)
A 2 2'CUSTR01'
A MODE 7 O 2 37
A 2 72TIME
A 3 28'CUST#'
A CUS# R O 3 37EDTCDE(4) DSPATR(RI)
A 8 28'NAME'
A CUSNAM R B 8 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A MODE 7 O 2 37
A 2 72TIME
A 3 28'CUST#'
A CUS# R O 3 37EDTCDE(4) DSPATR(RI)
A 8 28'NAME'
A CUSNAM R B 8 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 9 28'ADDRESS 1'
A CUSAD1 R B 9 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 10 28'ADDRESS 2'
A CUSAD2 R B 10 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 11 28'CITY'
A CUSAD1 R B 9 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 10 28'ADDRESS 2'
A CUSAD2 R B 10 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 11 28'CITY'
A CUSCTY R B 11 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 12 28'STATE'
A CUSSTA R B 12 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 13 28'ZIP'
A CUSZIP R Y B 13 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 12 28'STATE'
A CUSSTA R B 12 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 13 28'ZIP'
A CUSZIP R Y B 13 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A ERRLIN 78 O 22 2
A 90 DSPATR(RI)
A O 23 14'F3=EXIT'
RPG 程序
CUSTR01 RPG CUSTR01
FCUSTD01 CF E WORKSTN
FCUST UF E K DISK A
*----------------------------------------------------------------
* Define error messages here
I 'RECORD ALREADY ON FI-C ERR1
I 'LE'
I 'RECORD IS NOT ON FIL-C ERR2
I 'E'
I 'NO MORE RECORDS' C ERR3
I 'ZIP CANNOT BE ZERO' C ERR6
I 'NAME MUST NOT BE BL-C ERR7
I 'ANK'
I 'STATE MUST NOT BE BL-C ERR8
I 'ANK'
I 'ACTION MUST BE A, U,-C ERR9
I ' D OR I'
I 'RECORD ADDED SUCCE- C MSG1
I 'SSFULLY'
I 'RECORD UPDATED SUC- C MSG2
I 'CESSFULLY'
I 'RECORD DELETED SUC- C MSG3
I 'CESSFULLY'
I 'HIT F9 TO DELETE' C MSG4
I 'NO ACTION TAKEN' C MSG9
*----------------------------------------------------------------
* Key List for customer file
* (a key list is not needed since this file has only 1 key
* field, but this makes the program easier to modify if
* the file has multiple key fields)
C KEYLST KLIST
C KFLD CUS#
*----------------------------------------------------------------
* Stay in Main DO LOOP until F3 is hit from SCR1
*----------------------------------------------------------------
C *IN03 DOWEQ*OFF
* Show main ADD/UPD/INQ/DLT screen
C EXFMTSCR1
C CLEARERRLIN
C MOVE *OFF *IN90
* If user didn't hit F3, process screen based on action
C *IN03 IFEQ *OFF
C SELEC
C ACTION WHEQ 'A'
C EXSR ADDREC
C ACTION WHEQ 'D'
C EXSR DLTREC
C ACTION WHEQ 'I'
C EXSR INQREC
C ACTION WHEQ 'N'
C EXSR NXTREC
C ACTION WHEQ 'U'
C EXSR UPDREC
C OTHER
C CLEARERRLIN
C MOVELERR9 ERRLIN
C MOVE *ON *IN90
C ENDSL
C ENDIF
C ENDDO
*
C MOVE *ON *INLR
C RETRN
*----------------------------------------------------------------
C ADDREC BEGSR
* Unprotect fields but setting *in80 off
C MOVE *OFF *IN80
C MOVE ' ADD ' MODE
* See if customer # is already in CUST file
C KEYLST CHAINCUST 91
C *IN91 IFEQ *OFF
* If customer # is already in cust file, load up ERR MSG
C CLEARERRLIN
C MOVELERR1 ERRLIN
C MOVE *ON *IN90
C ELSE
C EXSR ADDSCR
C ENDIF
C ENDSR
*----------------------------------------------------------------
* SHOW ADD SCREEN
*----------------------------------------------------------------
C ADDSCR BEGSR
* Clear customer record except for key field(s)
C *NOKEY CLEARCUSTR
C MOVE 'N' RECOK 1
* Keep showing screen until record passes edit or F3 is hit
C RECOK DOWEQ'N'
C *IN03 ANDEQ*OFF
C EXFMTSCR2
*
C *IN03 IFEQ *OFF
C EXSR EDTCUS
C RECOK IFEQ 'Y'
C WRITECUSTR
* Show messaage that ADD was successful
C CLEARERRLIN
C MOVELMSG1 ERRLIN
C ENDIF
C ELSE
* Show message that no action was taken because F3 was hit
C CLEARERRLIN
C MOVELMSG9 ERRLIN
C ENDIF
C ENDDO
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C DLTREC BEGSR
* Disable fields for entry by setting *IN80 on
C MOVE *ON *IN80
C MOVE 'DELETE' MODE
C CLEARERRLIN
C MOVELMSG4 ERRLIN
C MOVE *ON *IN90
* See if customer # is in CUST file
C KEYLST CHAINCUST 91
C *IN91 IFEQ *ON
* If customer # is not in CUST file, show ERR MSG
C CLEARERRLIN
C MOVELERR2 ERRLIN
C MOVE *ON *IN90
C ELSE
C EXFMTSCR2
C MOVE *OFF *IN90
C *IN09 IFEQ *ON
C DELETCUSTR
C CLEARERRLIN
C MOVELMSG3 ERRLIN
C ELSE
C CLEARERRLIN
C MOVELMSG9 ERRLIN
C ENDIF
C ENDIF
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C INQREC BEGSR
* Disable fields for entry by setting *IN80 on
C MOVE *ON *IN80
C MOVE 'INQUIRY' MODE
* See if customer # is in CUST file
C KEYLST CHAINCUST 91
C *IN91 IFEQ *ON
* If customer # is not in CUST file, show ERR MSG
C CLEARERRLIN
C MOVELERR2 ERRLIN
C MOVE *ON *IN90
C ELSE
* Show Inquiry Screen
C EXFMTSCR2
C ENDIF
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C NXTREC BEGSR
*
C MOVE *ON *IN80
C MOVE 'INQUIRY' MODE
C CLEARERRLIN
* Go forward in the file to the next record
C KEYLST SETLLCUST 92 93
* If *in92 is on, we have reached end of file
C *IN92 IFEQ *ON
C MOVELERR3 ERRLIN
C MOVE *ON *IN90
C ENDIF
* Read next record
C ERRLIN IFEQ *BLANKS
C READ CUST 90
* If *in90 is on, we have reached end of file
C *IN92 IFEQ *ON
C MOVELERR3 ERRLIN
C MOVE *ON *IN90
C ENDIF
C ENDIF
* If *in93 is on, we are at an existing record and we need
* to read past it
C ERRLIN IFEQ *BLANKS
C *IN93 IFEQ *ON
C READ CUST 90
* If *in90 is on, we have reached end of file
C *IN90 IFEQ *ON
C MOVELERR3 ERRLIN
C MOVE *ON *IN90
C ENDIF
C ENDIF
C ENDIF
*
C ERRLIN IFEQ *BLANKS
C EXFMTSCR2
C ENDIF
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C UPDREC BEGSR
* Unprotect fields but setting *in80 off
C MOVE *OFF *IN80
C MOVE 'UPDATE ' MODE
* See if customer # is already in CUST file
C KEYLST CHAINCUST 91
C *IN91 IFEQ *ON
* If customer # is not in cust file, load up ERR MSG
C CLEARERRLIN
C MOVELERR2 ERRLIN
C MOVE *ON *IN90
C ELSE
C EXSR UPDSCR
C ENDIF
C ENDSR
*----------------------------------------------------------------
* SHOW UPDATE SCREEN
*----------------------------------------------------------------
C UPDSCR BEGSR
C MOVE 'N' RECOK 1
* Keep showing screen until record passes edit or F3 is hit
C RECOK DOWEQ'N'
C *IN03 ANDEQ*OFF
C EXFMTSCR2
*
C *IN03 IFEQ *OFF
C EXSR EDTCUS
C RECOK IFEQ 'Y'
C UPDATCUSTR
* Show messaage that UPDATE was successful
C CLEARERRLIN
C MOVELMSG2 ERRLIN
C ENDIF
C ELSE
* Show message that no action was taken because F3 was hit
C CLEARERRLIN
C MOVELMSG9 ERRLIN
C ENDIF
C ENDDO
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C EDTCUS BEGSR
* First, set error switch that record is OK
C MOVE 'Y' RECOK
* Now, perform each edit
C CUSNAM IFEQ *BLANKS
C MOVE 'N' RECOK
C CLEARERRLIN
C MOVELERR7 ERRLIN
C MOVE *ON *IN90
C ENDIF
*
C CUSSTA IFEQ *BLANKS
C MOVE 'N' RECOK
C CLEARERRLIN
C MOVELERR8 ERRLIN
C MOVE *ON *IN90
C ENDIF
*
C CUSZIP IFEQ *ZERO
C MOVE 'N' RECOK
C CLEARERRLIN
C MOVELERR6 ERRLIN
C MOVE *ON *IN90
C ENDIF
*
C ENDSR
*---------------------------------------------------------------- |
|
免费注册
发表于 2004-07-30 12:03
发表于 2004-07-30 15:42
