400中显示在线用户操作记录的方法（用User Space API 实现）
首先，祝福所有CU中AS400的朋友 元宵节快乐！
[quote:3fb980c39a]╭ ╯╭╯╭╯╭╭ ╯╭╯╭
◥█□█□█□█□█□█◤
█○●○●○●○●○█
█○●○●○●○●○█ Andrewleading_he 送湯圓來哦 ！
◥█□█□█□█□█◤ 团团园园，和和气气，一起成长！
▆█████████▆
[/quote:3fb980c39a]
其次，感谢CU提供机会让我认识这么多的朋友，大家都那么热心，那么坦诚！
最后，跟大家交流一个讨论了好久的问题，就是400中api的使用。有人可能不是很习惯用400中的api,也许因为我之前玩过一段时间的java吧,感觉使用java的api真的很方便，思想中一直有这种想法吧，这不就有了下面的这个议题（真的很感谢那些提供消息的cu中的朋友）。
[code:1:3fb980c39a]
A* 位置 : TEST_LIB QDDSSRC_FILE USERACTFM_MEMBER
A* 功能 : 显示在线用户的操作记录
A* 使用 : <- USERACTRPG DSPF
A* 適用 :
A* 開發 : ANDREW HE
A* 時間 : 2004 02 05
A* 備注 :
A*
A*************************************************************
A PRINT
A CA03 CA05 CA06 CA09 CA10
A R SCREEN03 SFL
A S3SEL 1 B 4 2 DSPATR(CS)
A 35 DSPATR(PR)
A S3STATION 10 O 4 4
A 30 DSPATR(HI)
A 35 DSPATR(BL)
A
A S3ID 10 O 4 15
A 30 DSPATR(HI)
A S3ACTIVITY 10 O 4 26
A S3PROGRAM 10 O 4 37
A S3NUMBER 6 O 4 48
A S3NAME 24 O 4 55
A 31 DSPATR(HI)
A R SCREEN02 SFLCTL(SCREEN03)
A* CA03 CA05 CA06 CA09
A OVERLAY
A SFLSIZ(19)
A SFLPAG(18)
A 70 SFLDSP
A 71 SFLDSPCTL
A 72 SFLCLR
A 70 SFLEND(*MORE)
A SFLPOS 4S 0H SFLRCDNBR
A CURPAG 5S 0H SFLSCROLL
A 1 3UserLOG
A COLOR(WHT)
A 1 25 Users Signed On:
a DSPATR(UL)
A COLOR(WHT)
A SIGNEDON 5 0O 1 43 EDTWRD( , 0 )
A 1 72DATE
A EDTCDE(Y)
A TIMEX 6 0O 2 72EDTWRD( : : )
A 03 04 Dsply Stn
a DSPATR(UL)
A COLOR(WHT)
A 03 15 User Id
a DSPATR(UL)
A COLOR(WHT)
A 03 26 Activity
a DSPATR(UL)
A COLOR(WHT)
A 03 37 Program
a DSPATR(UL)
A COLOR(WHT)
A 03 48 Job No
a DSPATR(UL)
A COLOR(WHT)
A 03 55 User Name
a DSPATR(UL)
A COLOR(WHT)
A R SCREEN04 OVERLAY
A MESSAGE 70 O 23 2
A 99 DSPATR(RI)
A 24 03F3=Exit F5=Refresh F6=SORT BY +
A Name F9=Command Line
A COLOR(BLU)
A R SCREEN06 SFL
A S6DAYTIM 11 O 3 01
A S6COMD49 49 O 3 13
A S6COMD160 160 H
A R SCREEN05 SFLCTL(SCREEN06)
A WINDOW(3 15 19 61)
A WDWBORDER((*COLOR YLW) (*DSPATR RI))
A OVERLAY KEEP
A SFLSIZ(15)
A SFLPAG(14)
A 80 SFLDSP
A 81 SFLDSPCTL
A 82 SFLCLR
A 80 SFLEND(*MORE)
A SFLPOS2 4S 0H SFLRCDNBR
A 01 02 JOB:
A COLOR(WHT)
A 02 01 Day/time
A COLOR(WHT)
a DSPATR(UL)
A 02 13 Request (Abbrev)
A COLOR(WHT)
a DSPATR(UL)
A S3STATION 10 O 01 07
A S3ID 10 O 01 19
A S3NUMBER 6 O 01 31
A R SCREEN07 WINDOW(SCREEN05)
A OVERLAY
A 18 03F3=Return F10=Print
A COLOR(BLU)
[/code:1:3fb980c39a]
[code:1:3fb980c39a]*************************************************************
* 位置: TEST_LIB QRPGLESRC_FILE USERACTPGM_MEMBER
* 功能: 显示在线用户的操作记录
* 使用: <- USERACTCMD OR CALL USERACTPGM
* 適用:
* 開發: ANDREW HE
* 時間: 2004 02 05
* 備注:
*
F****************************************************************
FUSERACTFM CF E WORKSTN
F SFILE(SCREEN03:RRN)
F SFILE(SCREEN06:RRN2)
FQSYSPRT O F 195 PRINTER OFLIND(*INOA)
D SDS
D S1SWID 244 253
D S1USER 254 263
D GENERALDS DS
D INPUTSIZE 113 116B 0
D LISTOFFSET 125 128B 0
D LISTNBR 133 136B 0
D ENTRYSIZE 137 140B 0
D ERRORDS DS INZ
D BYTESPROVD 1 4B 0 INZ(116)
D BYTESAVAIL 5 8B 0
D MESSAGEID 9 15
D ERR### 16 16
D MESSAGEDTA 17 116
D* API ERROR DATA STRUCTURE
D API_ERR2 DS
D ERRBYTES2 1 4B 0
D ERRBYTESAVA2 5 8B 0
D EXCEPTION2 9 15
D RESERVE2 16 16
D DATA2 17 271
D DS INZ
D STARTPOSIT 1 4B 0
D STARTLEN 5 8B 0
D SPACELEN 9 12B 0
D NBRENTRIES 29 32B 0
D LENENTRY 37 40B 0
D NBRRETURN 41 44B 0
D MAXENTRIES 45 48B 0
D SPACEATRIB S 10
D SPACEVALUE S 1
D SPACEAUTH S 10
D SPACETEXT S 50
D SPACEREPLC S 10
D FORMATNAME S 8
D USERNAME S 10 INZ(*ALL )
D DSPSTATION S 10 INZ(*ALL )
D DISCONNECT S 10 INZ(*NO )
D SIGNEDOFF S 10 INZ(*NO )
D SPACESPACE2 S 10 INZ(JOBMSGS)
D SPACEPTR S * INZ(*NULL)
D BASEPTR S * INZ(*NULL)
D INF_LEN1 S 10I 0 INZ(%LEN(MSGSELECT))
D DETAILS S 10I 0
D DETAILSIZE S 10I 0 INZ(%LEN(LJOB01DS))
D LINESTART S 10I 0
D LINESIZE S 10I 0 INZ(%LEN(MSGENTRYDS))
D USERSPACE S 20
D USERSPACE2 S 20
D LINE1 S 110
D LINE2 S 110
D******************************************************************
D*STRUCTURE FOR SGNU0200 FORMAT
D******************************************************************
DQEZU0200 DS
D* QEZ SGNU0200
D QEZDSN00 1 10
D* DISPLAY STATION NAME
D QEZUN01 11 20
D* USER NAME
D QEZJNBR00 21 26
D* JOB NUMBER
D QEZIVITY00 27 36
D* ACTIVITY
D QEZAN00 37 46
D* ACTIVITY NAME
D QEZDJ00 47 47
D* DISCONNECT JOB
D QEZERVED00 48 64
D* RESERVED
D QEZDSD 65 114
D* DISPLAY STATION DESCRIPTION
D QEZUD 115 164
D* USER DESCRIPTION
D* ERROR CODE DATA
D ERRDATA DS
D BYTESPROV 1 4B 0 INZ( 272 )
D BYTESAVAL 5 8B 0
D EXCPID 9 15A
D RESERVED 16 16A
D EXCPDATA 17 272A
D*
D STRING S 71
D ARRAY S 71 DIM(5000)
D INPUTDS DS
D MSGSELECT DS
D MAXREQUESTED 10I 0 INZ(-1)
D DIRECTION 10A INZ(*NEXT )
D QJOBNAME 10A
D QUSRNAME 10A
D QJOBNUMB 6A
D INTERNALJOBID 16A
D STARTMSGKEY 4A INZ(X00000000)
D MAXLENGTH 10I 0 INZ(160)
D MAXHELP 10I 0 INZ(4)
D OFFTOFIELD1 10I 0 INZ(84)
D NUMTORTRN 10I 0 INZ(1)
D OFFTOMSG 10I 0 INZ(88)
D LENGTHMSG 10I 0 INZ(4)
D QMHIFR00 10I 0 INZ(0302)
D QMHCMQ00 4A INZ(*)
* GENERIC HEADER DATA STRUCTURE
D GENHEADDS DS BASED(BASEPTR)
D USERAREA 64
D SIZEGENHED 10I 0
D STRRELLVL 4A
D FMTNAME 8A
D APINAME 10A
D DATETIME 13A
D INFSTATUS 1A
D USERSPCSIZE 10I 0
D IPSECOFFSET 10I 0
D IPSECSIZE 10I 0
D HSECOFFSET 10I 0
D HSECSIZE 10I 0
D LDSECOFFSET 10I 0
D LDSECSIZE 10I 0
D ENTRYNUMBER 10I 0
D ENTRYSIZEI 10I 0
D CCSID 10I 0
* FORMAT LJOB0100 WITH MESSAGE ENTRY DATA
D LJOB01DS DS
D NXTENTOFFSET 10I 0
D FLDRETOFFSET 10I 0
D FLDRETNUMBER 10I 0
D MSGSEV 10I 0
D MSGID 7A
D MSGTYPE 2A
D MSGKEY 4A
D MSGFILENAME 10A
D MSGFILELIB 10A
D DATESENT 7A
D TIMESENT 6A
D* RESERVED1 32000A
* MESSAGE ENTRY FORMAT AT END OF LJOB0100 FORMAT
D MSGENTRYDS DS
D NXTFLDOFFSET 10I 0
D FLDINFLEN 10I 0
D FIELDID 10I 0
D DATATYPE 1A
D DATASTATUS 1A
D RESERVED2 14A
D DATALEN 10I 0
D DATATEXT 160A
C TIME TIMEX 6 0
C EXSR CLEAR
C EVAL USERSPACE = (USERS QTEMP)
* CREATE USER SPACE FOR ONLINE USERS
C CALL QUSCRTUS
C PARM USERSPACE
C PARM *BLANKS SPACEATRIB
C PARM 2048 SPACELEN
C PARM *BLANKS SPACEVALUE
C PARM *CHANGE SPACEAUTH
C PARM *BLANKS SPACETEXT
C PARM *YES SPACEREPLC
C PARM ERRORDS
C* CREATE USER SPACE 2
C EVAL USERSPACE2 = (JOBMSGS QTEMP)
C CALL QUSCRTUS
C PARM USERSPACE2
C PARM *BLANKS SPACEATRIB
C PARM 2048 SPACELEN
C PARM *BLANKS SPACEVALUE
C PARM *CHANGE SPACEAUTH
C PARM *BLANKS SPACETEXT
C PARM *YES SPACEREPLC
C PARM API_ERR2
C* RETRIEVE POINTER (INFO ABOUT USER SPACE)
C CALL QUSPTRUS
C PARM USERSPACE2
C PARM BASEPTR
C EXSR GETINFO
C *INLR DOWEQ *OFF
C EXSR POSITION
C WRITE SCREEN04
C EXFMT SCREEN02
C KC SETON LR
C KC LEAVE
C KI CALL QUSCMDLN
C *INKE IFEQ *ON
C KE Z-ADD CURPAG HOLDPAGE 5 0
C EXSR CLEAR
C EXSR GETINFO
C LEAVE
C ENDIF
C *INKF IFEQ *ON
C SIGNEDON IFGT 5000
C EVAL MESSAGE = LIMIT OF 5000 FOR SORT
C SETON 99
C ELSE
C EXSR SORT
C ENDIF
C ENDIF
C* GO GET REQUEST MESSAGES (COMMANDS ENTERED) FOR THIS JOB
C READC SCREEN03
C DOW NOT %EOF
C S3STATION IFNE LIST EMPTY
C EXSR GETMSGS
C ENDIF
C MOVE S3SEL
C SETON 30
C UPDATE SCREEN03
C SETOFF 3035
C READC SCREEN03
C ENDDO
C*
C ENDDO
C*********************************************************
C* GET INFO
C*********************************************************
C GETINFO BEGSR
C TIME TIMEX 6 0
C Z-ADD 0 SIGNEDON 5 0
* LIST ALL OBJECTS IN FILE
C EVAL USERSPACE = (USERS QTEMP)
C CALL QEZLSGNU
C PARM USERSPACE
C PARM SGNU0200 FORMATNAME
C PARM USERNAME
C PARM DSPSTATION
C PARM DISCONNECT
C PARM SIGNEDOFF
C PARM ERRORDS
C EVAL STARTPOSIT = 1
C EVAL STARTLEN = 140
* RETRIEVE USER SPACE GENERAL INFORMATION
C EVAL USERSPACE = (USERS QTEMP)
C CALL QUSRTVUS
C PARM USERSPACE
C PARM STARTPOSIT
C PARM STARTLEN
C PARM GENERALDS
* RETRIEVE THE LIST BY WALKING THROUGH THE USER SPACE
C EVAL STARTPOSIT = 1
C EVAL STARTLEN = INPUTSIZE
C EVAL USERSPACE = (USERS QTEMP)
C EVAL STARTPOSIT = LISTOFFSET + 1
C EVAL STARTLEN = ENTRYSIZE
C EXSR CLEAR
C Z-ADD 0 INDX 4 0
C EVAL ARRAY = ZZZZZZZZZZ
C LISTNBR IFGT 0
C DO LISTNBR
C EVAL USERSPACE = (USERS QTEMP)
C CALL QUSRTVUS
C PARM USERSPACE
C PARM STARTPOSIT
C PARM STARTLEN
C PARM QEZU0200
C EVAL STARTPOSIT = STARTPOSIT + ENTRYSIZE
C ADD 1 RRN
C ADD 1 SIGNEDON
C MOVE QEZDSN00 S3STATION
C MOVE QEZUN01 S3ID
C MOVE QEZIVITY00 S3ACTIVITY
C MOVE QEZAN00 S3PROGRAM
C MOVE QEZJNBR00 S3NUMBER
C MOVEL QEZUD S3NAME
C WRITE SCREEN03
C INDX IFLT 5000
C EVAL STRING = S3NAME + S3STATION + S3ID +
C S3ACTIVITY + S3PROGRAM + S3NUMBER
C ADD 1 INDX
C MOVE STRING ARRAY(INDX)
C ENDIF
C ENDDO
C ENDIF
C*
C RRN IFEQ 0
C Z-ADD 1 RRN
C MOVEL LIST EMPTY S3STATION
C WRITE SCREEN03
C ENDIF
C SETON 70
C Z-ADD 1 SFLPOS
C*
C ENDSR
C******************************************************
C* CLEAR SUBFILE # 1 *
C******************************************************
C CLEAR BEGSR
C SETOFF 707131
C SETOFF 99
C MOVE *BLANKS MESSAGE 70
C SETON 72
C WRITE SCREEN02
C SETOFF 72
C SETON 71
C Z-ADD 0 RRN 5 0
C Z-ADD 0 RRNH 5 0
C Z-ADD 0 CURPAG 5 0
C Z-ADD 0 HIGH 5 0
C ENDSR
C******************************************************
C* CLEAR SUBFILE # 2 *
C******************************************************
C CLEAR2 BEGSR
C SETOFF 8081
C SETON 82
C WRITE SCREEN05
C SETOFF 82
C SETON 8081
C Z-ADD 0 RRN2 5 0
C Z-ADD 0 CURPAG2 5 0
C ENDSR
C******************************************************
C* SORT THE SUBFILE *
C******************************************************
C SORT BEGSR
C*
C EXSR CLEAR
C SETON 31
C SETOFF 30
C SORTA ARRAY
C*
C 1 DO INDX X 5 0
C EVAL S3NAME = %SUBST(ARRAY(X):1:24)
C EVAL S3STATION = %SUBST(ARRAY(X):25:10)
C EVAL S3ID = %SUBST(ARRAY(X):35:10)
C EVAL S3ACTIVITY = %SUBST(ARRAY(X):45:10)
C EVAL S3PROGRAM = %SUBST(ARRAY(X):55:10)
C EVAL S3NUMBER = %SUBST(ARRAY(X):65:6)
C ADD 1 RRN
C WRITE SCREEN03
C ENDDO
C*
C SETON 70
C RRN IFEQ 0
C Z-ADD 1 RRN
C MOVEL LIST EMPTY S3STATION
C WRITE SCREEN03
C ENDIF
C Z-ADD 1 SFLPOS
C*
C
C ENDSR
C*********************************************************
C* KEEP CORRECT POSITIONING OF SUBFILE SCREEN *
C*********************************************************
C POSITION BEGSR
C KEHOLDPAGE IFGT HIGH
C Z-ADD HIGH CURPAG
C ELSE
C Z-ADD HOLDPAGE CURPAG
C ENDIF
C HIGH IFNE 0
C CURPAG ANDGT HIGH
C Z-ADD HIGH CURPAG
C ENDIF
C CURPAG IFNE 0
C Z-ADD CURPAG SFLPOS
C ENDIF
C ENDSR
C*********************************************************
C* GET REQUEST MESSAGES
C*********************************************************
C GETMSGS BEGSR
C EXSR CLEAR2
C EVAL QUSRNAME = S3ID
C EVAL QJOBNAME = S3STATION
C EVAL QJOBNUMB = S3NUMBER
C EVAL API_ERR2 = *BLANKS
C CALL QMHLJOBL
C PARM USERSPACE2
C PARM LJOB0100 API_FORMAT3 8
C PARM MSGSELECT
C PARM INF_LEN1
C PARM JSLT0100 API_FORMAT2 8
C PARM API_ERR2
C EXCEPTION2 IFEQ *BLANKS
C EVAL DETAILS = LDSECOFFSET + 1
C DO ENTRYNUMBER
C CALL QUSRTVUS
C PARM USERSPACE2
C PARM DETAILS
C PARM DETAILSIZE
C PARM LJOB01DS
C PARM API_ERR2
C EVAL LINESTART = FLDRETOFFSET +1
C CALL QUSRTVUS
C PARM USERSPACE2
C PARM LINESTART
C PARM LINESIZE
C PARM MSGENTRYDS
C PARM API_ERR2
C IF %SUBST(DATATEXT:1:DATALEN) <> *BLANKS AND
C MSGTYPE = 08 OR MSGTYPE = 09
C ADD 1 RRN2
C EVAL S6DAYTIM = %SUBST(DATESENT:6:2) + +
C %SUBST(TIMESENT:1:2) + : +
C %SUBST(TIMESENT:3:2) + : +
C %SUBST(TIMESENT:5:2)
C EVAL S6COMD49 = %SUBST(DATATEXT:1:DATALEN)
C EVAL S6COMD160 = %SUBST(DATATEXT:1:DATALEN)
C WRITE SCREEN06
C ENDIF
C EVAL DETAILS = + NXTENTOFFSET +1
C EVAL LINESTART = FLDRETOFFSET +1
C ENDDO
C*
C RRN2 IFEQ 0
C Z-ADD 1 RRN2
C EVAL S6DAYTIM = *BLANKS
C EVAL S6COMD49 = LIST EMPTY OR NOT AVAILABLE
C EVAL S6COMD160 = LIST EMPTY OR NOT AVAILABLE
C WRITE SCREEN06
C ENDIF
C*
C Z-ADD 1 SFLPOS2
C WRITE SCREEN05
C WRITE SCREEN07
C READ SCREEN05
C KJ EXSR PRINTLIST
C ELSE
C SETON 35
C ENDIF
C ENDSR
C*********************************************************
C* PRINT LIST
C*********************************************************
C PRINTLIST BEGSR
C Z-ADD 0 PAGE
C Z-ADD RRN2 TOTMSGS 6 0
C EXCEPT HEADING
C DO TOTMSGS COUNTER 6 0
C COUNTER CHAIN SCREEN06 50
C *IN50 IFEQ *OFF
C EVAL LINE1 = %SUBST(S6COMD160:1:110)
C EVAL LINE2 = %SUBST(S6COMD160:111:50)
C LINE1 IFNE *BLANKS
C OA EXCEPT HEADING
C OA SETOFF OA
C EXCEPT DETAIL1
C ENDIF
C LINE2 IFNE *BLANKS
C OA EXCEPT HEADING
C OA SETOFF OA
C EXCEPT DETAIL2
C ENDIF
C*
C ENDIF
C*
C ENDDO 1
C*
C OA EXCEPT HEADING
C OA SETOFF OA
C EXCEPT THATSIT
C ENDSR
OQSYSPRT E HEADING 2 01
O 7 USERLOG
O TIMEX 20 : :
O S1USER 35
O 122 DATE:
O