如何於 RPG 中取得 Member 的Text Description 及其他相關資訊？（使用 API QUSRMBRD）
File : QRPGLESRC
Member : RTVMBRDR
Type : RPGLE
Usage : CRTBNDRPG RTVMBRDR
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO)
H DFTACTGRP(*NO) ACTGRP(*CALLER)
D SrcChanged PR 13P 0
D peSrcFile 10A const
D peSrcLib 10A const
D peSrcMbr 10A const
D RtnNBR S 13P 0
C Eval RtnNBR = SrcChanged('QRPGLESRC' :
C 'CHANCY' :
C 'RTVMBRDR' )
C Eval *InLr = *On
P SrcChanged B
D SrcChanged PI 13P 0
D peSrcFile 10A const
D peSrcLib 10A const
D peSrcMbr 10A const
D dsEC DS
D dsECBytesP 1 4I 0 Inz(256)
D dsECBytesA 5 8I 0 Inz(0)
D dsECMsgID 9 15
D dsECReserv 16 16
D dsECMsgDta 17 256
D RtvMbrD PR ExtPgm('QUSRMBRD')
D RcvVar 1A
D RcvVarLen 10I 0 Const
D Format 8A Const
D QualDBF 20A Const
D Member 10A Const
D UseOvrDbf 1A Const
D ErrorCode 1A
D dsSM ds
D dsSMBytRtn 10I 0
D dsSMBytAvl 10I 0
D dsSMFilNam 10A
D dsSMFilLib 10A
D dsSMFilMbr 10A
D dsSMFilAtr 10A
D dsSMSrcTyp 10A
D dsSMCrtDat 13A
D dsSMChgDat 13A
D dsSMText 50A
D dsSMSrcFil 1A
D wkReturn s 13P 0
C callp RtvMbrD(dsSM: %size(dsSM): 'MBRD0100':
C (peSrcFile+peSrcLib):peSrcMbr: '0': dsEC)
c if dsECBytesA>0
c return -1
c endif
c testn dsSMChgDat 99
c if *in99 = *off
c return -2
c endif
c Dsply dsSMText
c Dsply dsSMChgDat
c move dsSMChgDat wkReturn
c return wkReturn
P E
參考資訊
Retrieve Member Description (QUSRMBRD) API
http://publib.boulder.ibm.com/pubs/html/as400/v4r5/ic2924/info/apis/qusrmbrd.htm
星期二, 10月 31, 2023
2001-09-24 如何於 RPG 中取得 Member 的Text Description 及其他相關資訊？（使用 API QUSRMBRD）
2001-09-14 如何於 RPG 中檢核使用者密碼？
如何於 RPG 中檢核使用者密碼？
檢核使用者密碼的程序 VRYUSRPWD
File : QRPGLESRC
Member : VRYUSRPWD
Type : RPGLE
* ===================================================================
* = Service Program... VRYUSRPWD =
* = Description....... Verify User Password =
* = =
* = Compile........... CrtRPGMod Module(YourLib/VRYUSRPWD) =
* = SrcFile(YourLib/YourSrcFile) =
* ===================================================================
H NoMain
* ===================================================================
* = Prototypes =
* ===================================================================
* -------------------------------------------------------------------
* - VfyUsrPwd - Veryify user password -
* -------------------------------------------------------------------
D VfyUsrPwd PR 1N
D 10 Value
D 10 Value
D 272 Options( *NoPass )
* -------------------------------------------------------------------
* - GetProfileHdl - Get profile handle API -
* -------------------------------------------------------------------
D GetProfileHdl PR ExtPgm( 'QSYGETPH' )
D 10
D 10
D 12
D 272
* -------------------------------------------------------------------
* - RlsProfileHdl - Release profile handle API -
* -------------------------------------------------------------------
D RlsProfileHdl PR ExtPgm( 'QSYRLSPH' )
D 12
D 272
* ===================================================================
* = Procedure..... VfyUsrPwd =
* = Description... Verify user password =
* ===================================================================
P VfyUsrPwd B Export
D PI 1N
D UsrPrf 10 Value
D Password 10 Value
D APIError 272 Options( *NoPass )
* -------------------------------------------------------------------
* - Data definitions -
* -------------------------------------------------------------------
D Hdl S 12
D NoAPIError C Const( *Zero )
D APIErrorPassed S 1N
D APIErrorDS DS
D BytesProvided 10I 0 Inz( %Size( APIErrorDS ) )
D BytesAvail 10I 0 Inz( *Zero )
D MsgID 7 Inz( *Blanks )
D Reserved 1 Inz( X'00' )
D MsgDta 256 Inz( *Blanks )
* -------------------------------------------------------------------
* - Determine whether API error parameter was passed -
* -------------------------------------------------------------------
C If %Parms > 2
C Eval APIErrorPassed = *On
C EndIf
* -------------------------------------------------------------------
* - Retrieve profile handle -
* -------------------------------------------------------------------
C Reset APIErrorDS
C CallP GetProfileHdl(
C UsrPrf :
C Password :
C Hdl :
C APIErrorDS
C )
C If BytesAvail <> NoAPIError
C ExSr ReturnError
C EndIf
* -------------------------------------------------------------------
* - Release profile handle -
* -------------------------------------------------------------------
C Reset APIErrorDS
C CallP RLSProfileHdl(
C Hdl :
C APIErrorDS
C )
C If BytesAvail <> NoAPIError
C ExSr ReturnError
C EndIf
C Return *Off
* -------------------------------------------------------------------
* - Subroutine.... ReturnError -
* - Description... Return error condition to caller -
* -------------------------------------------------------------------
C ReturnError BegSr
C If APIErrorPassed
C Eval APIError = APIErrorDS
C EndIf
C Return *On
C EndSr
P VfyUsrPwd E
檢核使用者密碼程序的使用範例
File : QRPGLESRC
Member : VRYUSRPWDT
Type : RPGLE
Usage : 此範例程式包含三種呼叫方式，可擇一使用，
但最好使用有包含錯誤訊息的呼叫方式（方式二及方式三）。
可在應用程式某些中有需要再次確認密碼時，要求使用者再次輸入密碼，並呼叫
確認密碼程序 VRYUSRPWD 以檢核使用者密碼輸入正確與否。
* ===================================================================
* = Program....... VRYUSRPWDT =
* = Description... Sample demonstrating use of procedure =
* = VRYUSRPWD in applications =
* = =
* = Compile....... CrtRPGMod Module(YourLib/VRYUSRPWDT) =
* = SrcFile(YourLib/YourSrcFile) =
* = CrtPgm Pgm(YourLib/VRYUSRPWDT) =
* = Module(YourLib/VRYUSRPWDT VRYUSRPWD) =
* = ActGrp(*New) =
* ===================================================================
D VfyUsrPwd PR 1N
D 10 Value
D 10 Value
D 272 Options( *NoPass )
D UsrPrf S 8
D Password S 10
D RtnCode S 1N
D PSDS SDS
D User 254 263
D APIErrorDS DS
D BytesProvided 10I 0 Inz( %Size( APIErrorDS ) )
D BytesAvail 10I 0 Inz( *Zero )
D MsgID 7 Inz( *Blanks )
D Reserved 1 Inz( X'00' )
D MsgDta 256 Inz( *Blanks )
C Eval UsrPrf = User
* call method 1 without API Error Structure
C Eval RtnCode = VfyUsrPwd(
C UsrPrf :
C Password
C )
* call method 2 with API Error Structure
C Eval RtnCode = VfyUsrPwd(
C UsrPrf :
C Password :
C APIErrorDS
C )
* call method 3 use procedure
C If VfyUsrPwd(
C UsrPrf :
C Password :
C APIErrorDS
C )
* Insert error handling code for failed verification
C EndIf
C Eval *InLr = *On
參考資料
檢核使用者密碼程序所使用的 API
1. Get Profile Handle (QSYGETPH)
This API obtains a profile handle.
You can find documentation for API QSYGETPH at
http://publib.boulder.ibm.com/pubs/html/as400/v5r1/ic2924/index.htm?info/apis/QSYGETPH.htm
2. Release Profile Handle (QSYRLSPH)
This API releases a profile handle.
You can find documentation for API QSYRLSPH at
http://publib.boulder.ibm.com/pubs/html/as400/v5r1/ic2924/index.htm?info/apis/QSYRLSPH.htm
2001-09-03 如何將 10 進位數字轉換成 16 進位文字輸出？(C function sprintf)
如何將 10 進位數字轉換成 16 進位文字輸出？(C function sprintf)
1. 例如 RGB 顏色碼 10 進位數字為 : (128:255:192) 轉換為 16 進位文字輸出 (80:FF:C0)
2. 呼叫 C 函數 "sprintf" 是最快的方式，呼叫方式如下：
int sprintf( char *buffer, const char *format [, argument] ...);
範例程式 SPRINTFR
File : QRPGLESRC
Member : SPRINTFR
Type : RPGLE
Usage : CRTBNDRPG SPRINTFR
Call SPRINTFR
H DftActGrp(*No) BndDir('QC2LE')
D nRed S 5I 0 INZ(128)
D nGreen S 5I 0 INZ(255)
D nBlue S 5I 0 INZ(192)
D sprintf3 PR 10I 0 ExtProc('sprintf')
D szRecvVar * VALUE
D szFormat * VALUE Options(*STRING)
D Red 10I 0 Value Options(*NoPass)
D Green 10I 0 Value Options(*NoPass)
D Blue 10I 0 Value Options(*NoPass)
D szBuffer S 20A
D szColor S 256A
D pColor S *
C Eval pColor = %addr(szColor)
C CallP sprintf3(pColor : '%X:%X:%X' :
C nRed:nGreen:nBlue )
C Eval szBuffer = %str(pColor)
C szBuffer Dsply
C MOVE *ON *INLR
2001-08-30 如何於 RPG 中將畫面文字性欄位值向右靠？
如何於 RPG 中將畫面文字性欄位值向右靠？
1.於 RPGIV 中，V4R4 可使用 EVALR opcode ;
2. 於 RPGIII 或 V4R3以下之 RPGIV 中可使用下列 4 行程式碼，
假設有一欄位長度 8,要注意第四行數字 9 為欄位長 + 1，
RPGIII
C MOVE '1234 'FIELD 8
C 'FIELD' DSPLY FIELD
C ' ' SCAN FIELD X 20 99
C 9 SUB X Y 10
C CAT FIELD:Y RESET 8 P
C MOVE RESET FIELD P
C 'FIELD' DSPLY FIELD
*
C MOVE '1' *INLR
RPGIV
C MOVE '1234 ' FIELD 8
C 'FIELD' DSPLY FIELD
C ' ' SCAN FIELD X 2 0 99
C 9 SUB X Y 1 0
C CAT(P) FIELD:Y RESET 8
C MOVE(P) RESET FIELD
C 'FIELD' DSPLY FIELD
*
C MOVE '1' *INLR
2001-08-30 如何於 RPG 中做到 Recursive Call 的功能？
如何於 RPG 中做到 Recursive Call 的功能？
Recursive Call Driver UTRCPGM
File : QRPGLESRC
Member: UTRCPGM
Type : RPGLE
Note : Recursive Call Driver
* Program UTRCPGM
*=====================================================================
* DATA STRUCTURES
*=====================================================================
D #cmd S 256A
D #Num_Pgm S 2S 0
*---------------------------------------------------------------------
* Program Name
*---------------------------------------------------------------------
D PgmDS DS
D #Char1 1 inz('@')
D #Chr_Pgm 2
D #1st_Name 7
*===============================================================
* Prototypes
*===============================================================
* OS/400 commands
*---------------------------------------------------------------------
D command PR EXTPGM('QCMDEXC')
D @cmd 256A OPTIONS(*VARSIZE)
D CONST
D @cmdlen 15P 5 CONST
*=====================================================================
* Program Parameters
*=====================================================================
C *ENTRY PLIST
C Parm @Program 10
C parm @Library 10
*=====================================================================
* Main Program
*=====================================================================
*---------------------------------------------------------------------
* If program name is not specified, ends program
*---------------------------------------------------------------------
C if @Program = *BLANKS
C eval *inlr = *ON
C else
*---------------------------------------------------------------------
* If program does not exist in library QTEMP, it must be the original
* program who's going to call itself for the first time
*---------------------------------------------------------------------
C exsr ChkObj
C if %ERROR
C eval #Num_Pgm = 0
C eval #1st_Name = %SUBST(@Program : 1 : 7)
C else
*---------------------------------------------------------------------
* If program exists in library QTEMP, it must be already a
* duplication of the original program; another copy has to be made
*---------------------------------------------------------------------
C eval #Chr_Pgm = %SUBST(@Program : 2 : 2)
C move #Chr_Pgm #Num_Pgm
C eval #Num_Pgm = #Num_Pgm + 1
C endif
C move #Num_Pgm #Chr_Pgm
C exsr ChkObj
C if %ERROR
C exsr CrtDupObj
C endif
*---------------------------------------------------------------------
* If program already exists in library QTEMP or if it has been
* sucessfully duplicated, returns name and location of that copy
* of the program
*---------------------------------------------------------------------
C if NOT %ERROR
C eval @Program = PgmDs
C eval @Library = 'QTEMP'
C endif
C endif
C return
*=====================================================================
* SUBROTINES
*=====================================================================
*****************************************************************
* Check the existence of the specified object
*****************************************************************
C ChkObj BEGSR
C eval #cmd = 'CHKOBJ OBJ(QTEMP/' +
C %TRIMR(PgmDS) + ') OBJTYPE(*PGM)'
C callp (e) command( #cmd : %LEN(%TRIMR(#cmd)) )
C ENDSR
*****************************************************************
* Create duplicate object
*****************************************************************
C CrtDupObj BEGSR
C eval #cmd = 'CRTDUPOBJ OBJ(' + %TRIM(@PROGRAM)
C ') FROMLIB(' + %TRIM(@LIBRARY)
C ') OBJTYPE(*PGM) TOLIB(QTEMP) NEWOBJ('
C %TRIM(PgmDS) + ')'
C callp (e) command( #cmd : %LEN(%TRIMR(#cmd)) )
C ENDSR
============================================================================
File : QRPGLESRC
Member: UTRKFACT
Type : RPGLE
Note : Factorial Demo
* Program UTRKFACT
*****************************************************************
*
* FACTORIAL MATHEMATICAL DEFINITION
*
* n! = 1 for n = 0
*
* n! = n (n - 1)! for n > 0
*
*****************************************************************
*=====================================================================
* Variables and Data Structures
*=====================================================================
D RecursCall S 21
*---------------------------------------------------------------------
* PROGRAM STATUS DATA STRUCTURE
*---------------------------------------------------------------------
D SDS
D $$Library 81 90
D $$Program 334 343
*=====================================================================
* Program Parameters
*=====================================================================
C *ENTRY plist
C parm @Argument 3 0
C parm @Factorial 30 0
C parm @Error 3 0
*=====================================================================
* Main Program
*=====================================================================
C eval @Error = 0
*---------------------------------------------------------------------
* 0! = 1 ; 1! = 1 x 0! = 1
*---------------------------------------------------------------------
C if @Argument <= 1
C eval @Factorial = 1
C else
*---------------------------------------------------------------------
* If new copy of this program could not be created, returns n
* else calculates n!
*---------------------------------------------------------------------
C call (e) 'UTRCPGM'
C parm $$Program @Program 10
C parm $$Library @Library 10
C if @Program = $$Program and @Library = $$Lib
C eval @Error = @Argument
C else
C exsr CalcFact
C endif
C endif
C eval *inlr = *ON
*---------------------------------------------------------------------
* Closes program
*---------------------------------------------------------------------
C call (e) 'UTRCPGM'
C parm *BLANKS @Program
C Parm @Library
*=====================================================================
* SUBROUTINES
*=====================================================================
*****************************************************************
* Calculates factorial of @Argument
*****************************************************************
C CalcFact BEGSR
*---------------------------------------------------------------------
* Calls newly created copy of this program to calculate (n - 1)!
*---------------------------------------------------------------------
C eval RecursCall = %TRIM(@Library) + '/'
C + %TRIM(@Program)
C eval @Argument2 = @Argument - 1
C call (e) RecursCall
C parm @Argument2 3 0
C parm *ZEROS @Factorial
C parm *ZEROS @Error
*---------------------------------------------------------------------
* If error occurred returns argument that originated the error
* else returns n!
*---------------------------------------------------------------------
C if %ERROR
C eval @Error = @Argument
C else
C if @Error = 0
C eval @Factorial = @Factorial * @Argument
C endif
C endif
C ENDSR
============================================================================
File : QRPGLESRC
Member: TESTRFACT
Type : RPGLE
Note : Test Factorial Demo
* PROGRAM TESTRFACT
**********************************************************************
*
* Calculates factorial of the number introduced by the user
*
* until he presses F3
*
**********************************************************************
*=====================================================================
* FILES
*=====================================================================
FTestDFact CF E WORKSTN
*=====================================================================
* Main Program
*=====================================================================
C exfmt (e) D$001
C dow NOT *in03
C exsr CalcFact
C exfmt (e) D$001
C enddo
C eval *inlr = *ON
*=====================================================================
* SUBROTINES
*=====================================================================
**********************************************************************
* Calculates factorial of n
**********************************************************************
C CalcFact BEGSR
C call (e) 'UTRKFACT'
C parm $Argument @Argument 3 0
C $Factorial parm *ZEROS @Factorial 30 0
C parm *ZEROS @Error 3 0
C eval *in60 = (@Error <> 0)
C ENDSR
============================================================================
File : QDDSSRC
Member: TESTDFACT
Type : DSPF
Note : Test Factorial Demo
* DISPLAY FILE TESTDFACT
A*================================================================
A DSPSIZ(24 80 *DS3)
A*================================================================
A* FACTORIAL WINDOW
A*================================================================
A R D$001
A*%%TS SD 20010821 192931 ROLDAO REL-V4R4M0 5769-PW1
A WINDOW(9 23 5 39 *NOMSGLIN)
A CA03(03 'Exit')
A BLINK
A FRCDTA
A OVERLAY
A PROTECT
A $ARGUMENT 2Y 0B 2 2RANGE(0 99)
A DSPATR(HI)
A EDTWRD('0 ')
A 2 5'! ='
A DSPATR(HI)
A $FACTORIAL 30Y 0O 2 9DSPATR(HI)
A EDTCDE(Z)
A 4 2'F3=Exit'
A 60 5 2'Error during calculations.'
A DSPATR(HI)
*================================================================
* JUST TO AVOID CLEARING THE SCREEN
*================================================================
A R DUMMY ASSUME
A 1 2' '
使用方法
1. CRTBNDRPG UTRCPGM
2. CRTBNDRPG UTRKFACT
3. CRTDSPF TESTDFACT
4. CRTBNDRPG TESTRFACT
5. CALL TESTRFACT
2001-08-23 如何於執行同一支 RPG 報表程式時，能動態的更改報表名稱？
如何於執行同一支 RPG 報表程式時，能動態的更改報表名稱？
在此所指的報表名稱，不是印在報表上的報表名稱，而是存在於系統中以供
辨別的報表名稱（Spooled File)，即是執行 WRKSPLF (Work with Spooled Files)
指令畫面中的 File 欄位，系統的預設值是 *FILE，即是您程式中所開啟的報表
檔名(Printer File)，若您的程式均是使用 QSYSPRT 為報表檔案，則系統中所產生的
報表檔案均為 QSYSPRT，您可使用如下方式將之區分開來：
WRKSPLF 指令畫面如下：
Work with All Spooled Files
Type options, press Enter.
1=Send 2=Change 3=Hold 4=Delete 5=Display 6=Release 7=Messages
8=Attributes 9=Work with printing status
Device or Total Cur
Opt File User Queue User Data Sts Pages Page Copy
QSYSPRT CHANCY QPRINT RDY 1 1
QSYSPRT CHANCY QPRINT 統計表 RDY 11 1
QSYSPRT CHANCY QPRINT 統計表 RDY 18 1
QSYSPRT CHANCY QPRINT RDY 24 1
QSYSPRT CHANCY QPRINT RDY 9 1
QSYSPRT CHANCY QPRINT RDY 3 1
QSYSPRT CHANCY QPRINT RDY 1 1
TAIPEI CHANCY QPRINT 統計表 RDY 2 1
QSYSPRT CHANCY QPRINT RDY 1 1
More...
Parameters for options 1, 2, 3 or command
===>
F3=Exit F10=View 4 F11=View 2 F12=Cancel F22=Printers F24=More keys
在開啟報表檔案之前執行下列指令：
OVRPRTF FILE(QSYSPRT) USRDTA(統計表)
--> 報表檔案名稱 QSYSPRT , 但可透過 User Data 欄位值辨別您的報表。
OVRPRTF FILE(QSYSPRT) SPLFNAME(TAIPEI) USRDTA(統計表)
--> 報表檔案名稱 X123456 , 可透過 File 及 User Data 欄位值辨別您的報表。
透過以上指令的執行，讓使用者能更快速的找到他們自己的報表。
OVRPRTF 指令可以在 CLP 及 RPG 中使用，
如 CLP：
PGM
OVRPRTF FILE(QSYSPRT) SPLFNAME(TAIPEI) USRDTA(統計表)
CALL STATRPTR
DLTOVR FILE(*PRTF)
ENDPGM
如 RPG：
FQSYSPRT O F 132 PRINTER UC
*
INAMCMD DS 60
I 50 59 NAME
I 'OVRPRTF -C OVRCMD
I 'FILE(QSYSPRT) -
I 'SPLFNAME( )'
*
C MOVELOVRCMD NAMCMD
*
* Assign first name ********************************************
*
C MOVEL'RPT01' NAME
* OVRPRTF FILE(QSYSPRT) SPLFNAME(&NAME)
C Z-ADD60 CMDLEN 155
C CALL 'QCMDEXC'
C PARM NAMCMD
C PARM CMDLEN
C OPEN QSYSPRT
C EXCPTEX40
C CLOSEQSYSPRT
*
* Assign second name ********************************************
*
C MOVEL'RPT02' NAME
C Z-ADD60 CMDLEN 155
C CALL 'QCMDEXC'
C PARM NAMCMD
C PARM CMDLEN
C OPEN QSYSPRT
C EXCPTEX40
C CLOSEQSYSPRT
C SETON LR
*
OQSYSPRT E 203 EX40
O 50 'HEADER POSITION'
O E 1 EX40
O NAME 50
O E 1 EX40
O 50 'END OF LIST'
2001-08-23 如何刪除檔案中所有欄位值一樣的重複記錄(DUPLICATE RECORDS)？
如何刪除檔案中所有欄位值一樣的重複記錄(DUPLICATE RECORDS)？
1. 複製包含重複記錄的 DBFILE 至一 WRKFILE，但不複製資料。
CRTDUPOBJ DBFILE MYLIB *FILE TOLIB(MYLIB) +
NEWOBJ(WRKFILE) DATA(*NO)
2. 啟動 SQL，從 DBFILE 複製資料至 WRKFILE。
STRSQL
===> INSERT INTO MYLIB/WRKFILE
SELECT DISTINCT * FROM MYLIB/DBFILE
3. 從 WRKFILE 複製資料回至 DBFILE 。
CPYF FROMFILE(MYLIB/WRKFILE) +
TOFILE(MYLIB/DBFILE) MBROPT(*REPLACE)
2001-08-20 如何於 RPG 中取得工作站狀態？（利用 Retrieve Configuration Status (QDCRCFGS) API）
如何於 RPG 中取得工作站狀態？（利用 Retrieve Configuration Status (QDCRCFGS) API）
File : QRPGLESRC
Member : RTVCFGSTSR
Type : RPGLE
Usage : CRTBNDRPG PGM(RTVCFGSTSR) SRCFILE(XXX/xxx) DBGVIEW(*LIST)
run with: CALL RTVCFGSTSR PARM('*DEVD' 'DSP01') (or whatever you like)
H DFTACTGRP(*NO) ACTGRP(*NEW) OPTION(*SRCSTMT)
D RtvCfgSts PR ExtPgm('QDCRCFGS')
D RcvVar 32766A options(*varsize)
D RcvVarLen 10I 0 const
D Format 8A const
D CfgDType 10A const
d CfgDName 10A const
D ErrorCode 32766A options(*varsize)
D p_ds1 S *
D ds1 DS based(p_ds1)
D ds1BytesRtn 10I 0
D ds1BytesAvl 10I 0
D ds1Status 10I 0
D ds1DateRtv 7A
D ds1TimeRtv 6A
D ds1StatusTxt 20A
D ds1JobName 10A
D ds1JobUser 10A
D ds1JobNbr 6A
D ds1PassThr 10A
D ds1Reserv1 3A
D ds1OffActCnv 10I 0
D ds1NbrActCnv 10I 0
D ds1LenActCnv 10I 0
D ds1OffMulJob 10I 0
D ds1NbrMulJob 10I 0
D ds1LenMulJob 10I 0
D p_ds2 S *
D ds2 DS based(p_ds2)
D ds2CnvSts 10I 0
D ds2CnvStsTxt 20A
D ds2CnvStsMod 10A
D ds2CnvStsJob 10A
D ds2CnvStsUsr 10A
D ds2CnvStsNbr 6A
D p_ds3 S *
D ds3 DS based(p_ds3)
D ds3MultJob 10A
D ds3MultUser 10A
D ds3MultNbr 6A
D dsEC DS
D dsECBytesP 1 4I 0 inz(256)
D dsECBytesA 5 8I 0 inz(0)
D dsECMsgID 9 15
D dsECReserv 16 16
D dsECMsgDta 17 256
D p_workspace S *
D workspace S 1A based(p_workspace)
D size S 10I 0
D Msg S 52A
D X S 10I 0
D pause S 1A
c *entry plist
c parm CfgType 10
c parm CfgName 10
c eval *inlr = *on
C* Reserve space for up to 200 active convs & 200 multjobs...
c eval size = %size(ds1) + (%size(ds2)*200) +
c (%size(ds3)*200)
c alloc size p_workspace
C* Call Retrieve Cfg Status API:
c callp RtvCfgSts(workspace: size: 'CFGS0100':
c CfgType: CfgName: dsEC)
c if dsECBytesA > 0
c eval Msg = 'QDCRCFGS failed with ' +
c dsECMsgID
c dsply Msg
c return
c endif
c eval p_ds1 = p_workspace
C** Show status of cfg descr:
c eval Msg = 'Status = ' + ds1StatusTxt
c Msg dsply
C** Show job using cfg descr:
c if ds1JobName <> *blanks
c eval Msg = 'Job = ' + %trimr(ds1JobName) +
c '/' + %trimr(ds1JobUser) + '/' +
c ds1JobNbr
c Msg dsply
c endif
C** Show any active conversations:
c do ds1NbrActCnv X
c eval p_ds2 = p_workspace + ds1OffActCnv +
c ((X-1) * ds1LenActCnv)
c eval Msg = 'ActCnv ' + %trim(%editc(X:'Z'))
c + ' status = ' + ds2CnvStsTxt
c Msg dsply
c eval Msg = 'ActCnv ' + %trim(%editc(X:'Z')) +
c ' job = ' + %trimr(ds2CnvStsJob) +
c '/' + %trimr(ds2CnvStsUsr) + '/' +
c ds2CnvStsNbr
c Msg dsply
c enddo
C** If this device can be used by multiple jobs,
C** show them all now:
c do ds1NbrMulJob X
c eval p_ds2 = p_workspace + ds1OffMulJob +
c ((X-1) * ds1LenMulJob)
c eval Msg = 'MultJob ' + %trim(%editc(X:'Z')) +
c ' = ' + %trimr(ds3MultJob) +
c '/' + %trimr(ds3MultUser) + '/' +
c ds3MultNbr
c Msg dsply
c enddo
c dsply pause
c return
Retrieve Configuration Status (QDCRCFGS) API參考資訊
https://www.ibm.com/docs/api/v1/content/ssw_ibm_i_75/apis/QDCRCFGS.htm
2001-08-01 如何於 RPG 中取得系統名稱？
如何於 RPG 中取得系統名稱？
File : QRPGLESRC
Member : RTVSYSNMR
Type : RPGLE
Usage : CRTBNDRPG RTVSYSNMR
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO)
H DFTACTGRP(*NO) ACTGRP(*CALLER)
D RtvSysName PR 10I 0
D SystemName 8A
c if RtvSysName(MyName) < 0
c eval Msg = 'RtvSysName ended in error!'
c dsply Msg 40
c else
c eval Msg = 'Systen Name'
c Msg dsply MyName 8
c endif
c eval *inlr = *on
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Retrieve System Name procedure: RtvSysName
*
* Parm: SysName = name of system returned.
*
* Returns: 0 = Success
* negative value if an error occurred. See below
* for a list of possible negative values.
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P RtvSysName B Export
D RtvSysName PI 10I 0
D SysName 8A
D QWCRNETA PR ExtPgm('QWCRNETA')
D RcvVar 32766A OPTIONS(*VARSIZE)
D RcvVarLen 10I 0 const
D NbrNetAtr 10I 0 const
D AttrNames 10A const
D ErrorCode 256A
D* Error code structure
D EC DS
D* Bytes Provided (size of struct)
D EC_BytesP 1 4B 0 INZ(256)
D* Bytes Available (returned by API)
D EC_BytesA 5 8B 0 INZ(0)
D* Msg ID of Error Msg Returned
D EC_MsgID 9 15
D* Reserved
D EC_Reserve 16 16
D* Msg Data of Error Msg Returned
D EC_MsgDta 17 256
D* Receiver variable for QWCRNETA with only one attribute
D RV ds
D* Number of Attrs returned
D RV_Attrs 10I 0
D* Offset to first attribute
D RV_Offset 10I 0
D* Add l data returned.
D RV_Data 1A DIM(1000)
D* Network attribute structure
D p_NA S *
D NA ds based(p_NA)
D* Attribute Name
D NA_Attr 10A
D* Type of Data. C=Char, B=Binary
D NA_Type 1A
D* Status. L=Locked, Blank=Normal
D NA_Status 1A
D* Length of Data
D NA_Length 10I 0
D* Actual Data (in character)
D NA_DataChr 1000A
D* Actual Data (in binary)
D NA_DataInt 10I 0 overlay(NA_DataChr:1)
C* Call API to get system name
C* -1 = API returned an error
C callp QWCRNETA(RV: %size(RV): 1: 'SYSNAME': EC)
c if EC_BytesA > 0
c return -1
c endif
C* -2 = RcvVar contained data that we
C* dont understand :(
c if RV_Attrs <> 1
c or RV_Offset < 8
c or RV_Offset > 1000
c return -2
c endif
C* Attach NetAttr structure
c eval RV_Offset = RV_Offset - 7
c eval p_NA = %addr(RV_Data(RV_Offset))
C* -3 = NetAttr structure had data
C* that we don't understand :(
c if NA_Attr <> 'SYSNAME'
c or NA_Length < 1
c or NA_Length > 8
c return -3
c endif
C* -4 = Network attributes are locked
c if NA_Status = 'L'
c return -4
c endif
C* Ahhh... we got it!
c eval SysName = %subst(NA_DataChr:1:NA_Length)
c return 0
P E
2001-07-24 如何監控 Job Status 為 MSGW 的 Job 並以 e-Mail 自動通知相關人員？
如何監控 Job Status 為 MSGW 的 Job 並以 e-Mail 自動通知相關人員？
1. 請參閱電子報
“如何從 AS/400 直接傳送 E-Mail to Internet ?“
設定 AS/400 e-mail 相關設定。
2. FILE : QCLSRC
Member: ALERTC
Type : CLP
在這個程式中，我並沒有使用 System API，而是
使用 TFRCTL 指令，讓 CLP 能重複讀取 PF
檔案資料的技巧，才能省略另一支專門讀取檔案
資料的程式。
/* JOB STATUS MONITORING */
/* PROGRAM : ALERTC */
/* STATUS : MSGW */
/* DLYW */
/* HLD */
/* Usage: */
/* BEFORE COMPILED, CRTPF QTEMP/ALERTJOB RCDLEN(132) */
/* */
/* SBMJOB CMD(CALL ALERTC 'MSGW') JOB(ALERTJOB) JOBQ(QCTL) */
/* */
PGM PARM(&STS)
DCL VAR(&STS) TYPE(*CHAR) LEN(4)
DCL VAR(&TXT) TYPE(*CHAR) LEN(60)
DCLF FILE(QTEMP/ALERTJOB)
START: OVRPRTF FILE(QPDSPAJB) HOLD(*YES)
WRKACTJOB OUTPUT(*PRINT)
DLTOVR FILE(QPDSPAJB)
CHKOBJ OBJ(QTEMP/ALERTJOB) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(DO)
CRTPF FILE(QTEMP/ALERTJOB) RCDLEN(132)
ENDDO
CPYSPLF FILE(QPDSPAJB) TOFILE(QTEMP/ALERTJOB) +
SPLNBR(*LAST)
DLTSPLF FILE(QPDSPAJB) SPLNBR(*LAST)
READ: RCVF RCDFMT(ALERTJOB)
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOF))
IF COND(%SST(&ALERTJOB 111 4) *EQ &STS) +
THEN(DO)
CHGVAR VAR(&TXT) VALUE(&STS *CAT ' STATUS : ' *CAT +
%SST(&ALERTJOB 29 6) *CAT '/' *CAT +
%SST(&ALERTJOB 17 10) *TCAT '/' *CAT +
%SST(&ALERTJOB 4 10) *CAT '!!!')
SNDDST TYPE(*LMSG) +
TOINTNET((your-email@your-domain.com)) +
DSTD('ALERT') LONGMSG(&TXT) SUBJECT(&TXT)
SNDBRKMSG MSG(&TXT) TOMSGQ(DSP01 your-console)
ENDDO
GOTO READ
EOF:
DLYJOB DLY(180)
/* RERUN ALERTC FOR REREAD ALERTJOB PF */
TFRCTL PGM(ALERTC) PARM(&STS)
END: ENDPGM
2001-07-20 如何於 batch（批次） 環境中 debug（除蟲） RPG 程式？
如何於 batch（批次） 環境中 debug（除蟲） RPG 程式？
如何於 batch（批次） 環境中 debug（除蟲） RPG 程式？
1. Submit 你的程式至批次環境中並確認該程式是被 Hold 著。
有二種方式可讓被 Submit 的程式 Hold 著：
Submit 程式前將 Job Queue hold 著，再Submit 程式或
Submit 程式時使用 HOLD(*YES) 參數 。
2. 使用 WRKUSRJOB 指令，並使用選項 5 顯示你所要 debug 的 Job。
3. 記下該 Job 的 user name, job name and number 。
4. 使用 STRSRVJOB 指令，輸入前一步驟記下的 user name, job name
and number，啟動一個 service job。
5. 使用 STRDBG PGM(你的程式名稱) - 按 F12 跳出顯示原始檔畫面
（此步驟尚不能設定除錯中斷點）。
6. 使用 WRKUSRJOB 或 WRKSBMJOB 指令，並使用選項 6 Release 步驟 1
所 submitted 的 job。
7. 接著會顯示一個畫面通知你的 Job 已經啟動，並要求你按 F10 功能鍵，
在按 F10 功能鍵後，會進入 QCMD 指令行的畫面。
8. 輸入指令 DSPMODSRC 及 設定除錯中斷點（breakpoints）。
9. 按 F3 功能鍵離開 DSPMODSRC source display。
10. 按 F3 功能鍵離開 QCMD 指令行的畫面。
11. 接著 Job 開始執行至第一個除錯中斷點，接著除錯（debug）。
12. 在除錯（debug）後，下指令 ENDDBG結束除錯器，
然後再下指令 ENDSRVJOB 結束 service job。
2001-07-19 如何使用 System API 列出 Subsystem Description 的相關資訊 ?
如何使用 System API 列出 Subsystem Description 的相關資訊 ?
File : QRPGLESRC
Member: ANZSBSDR
Type : RPGLE
利用 System API 函數或
下指令 DSPSBSD sunsystem *Print
因指令 DSPSBSD 輸出太複雜，所以我使用
System API 函數，列出 Active subsystem
的相關設定資料
*/ Upload to QRPGLESRC member 112 long
*/ CRTBNDRPG
*----------------------------------------------------------------
* anzsbsdr - generate report for subsystem related entries.
*
* Created by Vengoal Chang, 7/18/2001
*
*----------------------------------------------------------------
* program summary:
*
* executes api to load all active subsystem names into array.
* sort the array in ascending sequence for printing.
* execute api to get pool id..
* execute api to pool id of routing entries
* print report
*
*----------------------------------------------------------------
* api (application program interface) calls:
* quscrtus create user space
* qwclasbs list active subsystems
* qsdrsbsd retrieve subsystem info - get pool ids
* qwdlsbse list subsystem entries
* The following formats can be used:
*
* SBSE0100 Routing entry list.
* SBSE0200 Communications entry list.
* SBSE0300 Remote locations entry list.
* SBSE0400 Autostart job entry list.
* SBSE0500 Prestart job entry list.
* SBSE0600 Workstation name entry list.
* SBSE0700 Workstation type entry list.
*
* qwdlsjbq list subsystem entries - get jobq entries
* qwcrneta retrieve network attribute - get system name
*
* see system programmer's INTERFACE REFERENCE for API detail.
*----------------------------------------------------------------
Fqsysprt o f 198 printer Oflind(*InOV)
*
D psds sds
D JobDate 270 275S 0
*----------------------------------------------------------------
* Get user space list info from header section.
*----------------------------------------------------------------
D ds based(uHeadPtr)
D uOffSetToList 125 128i 0 offset to list
D uNumOfEntrys 133 136i 0 number list entries
D uSizeOfEntry 137 140i 0 list entry size
*
*----------------------------------------------------------------
* Field to move through user space by pointer.
*----------------------------------------------------------------
D uListEntry ds Based(uListPtr) sbs lib
D uSbsLib 20 sbs lib
* for Rounting Entry format SBSE0100
D uSquenceNO 10i 0 overlay(uListEntry:1)
D uRoutingPgm 10 overlay(uListEntry:5)
D uRoutingPgmLib 10 overlay(uListEntry:15)
D uRoutingClass 10 overlay(uListEntry:25)
D uRoutingClsLib 10 overlay(uListEntry:35)
D uMaxRoutingStp 10i 0 overlay(uListEntry:45)
D uRoutingPoolId 10i 0 overlay(uListEntry:49)
D uCmpStrPos 10i 0 overlay(uListEntry:53)
D uCmpValue 80 overlay(uListEntry:57)
* for AutoStart Job format SBSE0400
D uAutostartJob 10 overlay(uListEntry:1)
D uAutostartJobD 10 overlay(uListEntry:11)
D uAutostartJobL 10 overlay(uListEntry:21)
* for Rounting Entry format SBSE0500
D uPreJobPgm 10 overlay(uListEntry:1)
D uPreJobPgmLib 10 overlay(uListEntry:11)
D uUsrPrf 10 overlay(uListEntry:21)
D uStartJob 1 overlay(uListEntry:31)
D uWaitJob 1 overlay(uListEntry:32)
D uIniNumJobs 10i 0 overlay(uListEntry:33)
D uThreshold 10i 0 overlay(uListEntry:37)
D uAdditionalJob 10i 0 overlay(uListEntry:41)
D uMaxNumJobs 10i 0 overlay(uListEntry:45)
D uMaxNumUse 10i 0 overlay(uListEntry:49)
D uPoolId 10i 0 overlay(uListEntry:53)
D uPreJobName 10 overlay(uListEntry:57)
D uPreJobD 10 overlay(uListEntry:67)
D uPreJobDLib 10 overlay(uListEntry:77)
D uFirstClsName 10 overlay(uListEntry:89)
D uFirstClsLib 10 overlay(uListEntry:99)
D uNumJobsUseFst 10i 0 overlay(uListEntry:109)
D uSecClassName 10 overlay(uListEntry:113)
D uSecClassLib 10 overlay(uListEntry:123)
D uNumJobsUseSec 10i 0 overlay(uListEntry:133)
* for Workstation Entrys format name SBSE0600 , type SBSE0700
D uWorkStationNM 10 overlay(uListEntry:1)
D uWorkStationJD 10 overlay(uListEntry:11)
D uWorkStationJL 10 overlay(uListEntry:21)
D uControlJob 10 overlay(uListEntry:31)
D uMaxActJob 10i 0 overlay(uListEntry:41)
* for Jobq Entrys format name SJQL0100
D uJobqName 10 overlay(uListEntry:1)
D uJobqLib 10 overlay(uListEntry:11)
D uSeqNo 10i 0 overlay(uListEntry:21)
D uAllocInd 10 overlay(uListEntry:25)
D ureserved 2 overlay(uListEntry:35)
D uMaxAct 10i 0 overlay(uListEntry:37)
D uMaxActPri1 10i 0 overlay(uListEntry:41)
D uMaxActPri2 10i 0 overlay(uListEntry:45)
D uMaxActPri3 10i 0 overlay(uListEntry:49)
D uMaxActPri4 10i 0 overlay(uListEntry:53)
D uMaxActPri5 10i 0 overlay(uListEntry:57)
D uMaxActPri6 10i 0 overlay(uListEntry:61)
D uMaxActPri7 10i 0 overlay(uListEntry:65)
D uMaxActPri8 10i 0 overlay(uListEntry:69)
D uMaxActPri9 10i 0 overlay(uListEntry:73)
D MaxPri 10i 0 overlay(uListEntry:41) dim(9)
*
D MaxPriDs ds sbs lib
D MaxActPri1C 10
D MaxActPri2C 10
D MaxActPri3C 10
D MaxActPri4C 10
D MaxActPri5C 10
D MaxActPri6C 10
D MaxActPri7C 10
D MaxActPri8C 10
D MaxActPri9C 10
D MaxPriC 10 overlay(MaxPriDs:1) dim(9)
*
*----------------------------------------------------------------
* Define various numeric counters, indexes and such.
*----------------------------------------------------------------
D aa s 5u 0
D bb s 5u 0
D cc s 5u 0
D xx s 5u 0
D yy s 5u 0
D zz s 10u 0
D ii s 10u 0
*
*----------------------------------------------------------------
* array of subsystem names to allow alpha sorting for report.
* array of routing entry pool IDs so only unique IDs will print.
*----------------------------------------------------------------
D ArryOfSBS s 20 dim(999) ascend sort array
D ArryOfRtg s 10i 0 dim(50) ascend inz unique only
*
*----------------------------------------------------------------
* Get pool ID and names into print string.
*----------------------------------------------------------------
D vrcvar ds 1000
D vNumPools 10i 0 overlay(vrcvar:77)
*
D vrcvarlen s 10i 0 inz(%size(vrcvar))
D vQualSbsName s 20
*
D PoolDSAPI ds based(ptr_pool) get from API
D PNumAPI 10i 0
D PNameAPI 10
*
D PoolDSPRT ds 15 load print string
D PNumPrt 1 2
D PNamePrt 4 14
*
D PoolString s 75 print string
D RtgString s 30 print string
D PRtgPrt s 3
*
*----------------------------------------------------------------
* Define parms for Create User space API.
*----------------------------------------------------------------
D ExtndAttrb s 10 inz('TEST ')
D Hex0Init s 1 inz(x'00')
D UseAthrity s 10 inz('*ALL ')
D SpaceText s 50 inz('User command space')
D ReplaceObj s 10 inz('*NO ')
D LenOfSpace s 10i 0 inz(1000000)
D Domain s 10 inz('*DEFAULT')
D TransferSize s 10i 0 inz(32)
D OptimumAlign s 1 inz('1')
*
*----------------------------------------------------------------
* These field are defined to retrieve system name from QWCRNETA
*----------------------------------------------------------------
D vsysnm s 8 EXTRACT SYSNAM
*
* Load number of attributes to retrieve and attribute name
D vapiky ds
D vnkfld 10i 0 inz(1)
D vkarry 11 inz('SYSNAME')
*
* Number of keys returned and offset to attribute data
D vrcvr1 ds 200 inz
D vnkyrt 10i 0
D voffna 10i 0
D vrcvln s 10i 0 inz
*
* Network Attribute Information Table returned
D vnait ds inz
D vrtatt 1 10
D vrttyp 11 11
D vrtsta 12 12
D vrtlen 10i 0
*
*----------------------------------------------------------------
* Error return code parm for APIs.
*----------------------------------------------------------------
D vApiErrDs ds
D vbytpv 10i 0 inz(%size(vApiErrDs)) bytes provided
D vbytav 10i 0 inz(0) bytes returned
D vmsgid 7 error msgid
D vresvd 1 reserved
D vexdta 50 replacement data
*
*----------------------------------------------------------------
* load the active subsystem names to the the user space.
*----------------------------------------------------------------
C call 'QWCLASBS' LOAD ACTIVE SBS
C parm uSpaceName USER SPACE
C parm 'SBSL0100' vfornm 8 TYPE FORMAT
C parm vApiErrDs
*
*----------------------------------------------------------------
* Move through user space to get the subsystem name and library.
* load into array for sorting.
*----------------------------------------------------------------
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
1B C do uNumOfEntrys PROCESS LOOP
*
C add 1 xx
C eval ArryOfSBS(xx)=uSbsLib
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
1E C enddo
*
*---------------------------------------------------------------------------------------------
* Sort the array and position the element counter to beginning of loaded entries.
*---------------------------------------------------------------------------------------------
C sorta ArryOfSBS
C eval xx=1000-xx skip to data
*
*---------------------------------------------------------------------------------------------
* Spin though the sorted array
*---------------------------------------------------------------------------------------------
1B C xx do 999 yy
C eval vQualSbsName=ArryOfSBS(yy)
*
*---------------------------------------------------------------------------------------------
* Get POOL id number and names. Load up to 5 entries into string for printing.
*---------------------------------------------------------------------------------------------
C call 'QWDRSBSD' retrieve Sbs Info
C parm vrcvar
C parm vrcvarlen
C parm 'SBSI0100' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
*
C eval ptr_pool = %addr(vrcvar)+80
C clear PoolString
C z-add 1 aa
*
2B C do vNumPools zz
3B C if zz>5
2L C leave
3E C endif
*
C evalr PNumPrt=%editc(PNumAPI:'4')
C eval PNamePrt = PNameAPI
C eval %subst(PoolString:aa)= PoolDsPrt
C add 15 aa
C eval ptr_pool=ptr_pool+28 next offset
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the routing entries for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0100' vfornm 8 TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
*
* -----------------------------------------------------------------------------------------
* This is a little complicated. The same routing pool entry ID could be in many
* of the routing entries. We only want to show one . I will
* use an array to lookup and see if the entry is used yet.
* -----------------------------------------------------------------------------------------
C clear aa
C clear ArryOfRtg
C eval RtgString=*all'- '
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
C except heading
C except routingh
C if uNumOfEntrys = 0
C except nodata
C endif
2B C do uNumOfEntrys PROCESS LOOP
C
C except routingd
C if *InOV = *On
C except heading
C except routingh
C eval *InOV = *Off
C endif
C
C uRoutingPoolIDlookup ArryOfRtg 81
3B C if *in81=*off
C add 1 aa
C eval ArryOfRtg(aa)=uRoutingPoolID
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
2E C enddo
*
* -------------------------------------------------------------------------------------
* Sort the array and load it into print string.
* -------------------------------------------------------------------------------------
C sorta ArryOfRTG
C eval aa=51-aa
*
*---------------------------------------------------------------------------------------------
* Spin through the array loading the print string
*---------------------------------------------------------------------------------------------
C z-add 1 cc
2B C aa do 50 bb
C evalr PRtgPrt=%editc(ArryOfRtg(bb):'4')
C eval %subst(RtgString:cc:3)=PRtgPrt
C add 3 cc
2E C enddo
*
C except poolidh
C except poolidd
*
*---------------------------------------------------------------------------------------------
* load the JobQueue entries for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSJBQ' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SJQL0100' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except jobqh
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C
C clear MaxPriC
C for ii = 1 to 9
C if MaxPri(ii) = -1
C eval MaxPriC(ii)= '*NOMAX'
C else
C eval MaxPriC(ii)= %editc(MaxPri(ii): '4')
C endif
C endfor
C except jobqd
3B C if *InOV = *On
C except heading
C except jobqh
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the Autostart entries for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0400' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except autostarth
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C
C except autostartd
3B C if *InOV = *On
C except heading
C except autostarth
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the prestart entries for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0500' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except prestarth
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C z-add uIniNumJobs IniNumJobs 5 0
C z-add uThreshold Threshold 5 0
C z-add uAdditionalJobAdditionalJob 5 0
C z-add uMaxNumJobs MaxNumJobs 5 0
C z-add uMaxNumUse MaxNumUse 5 0
C z-add uPoolId PoolId 5 0
C z-add uNumJobsUseFstNumJobsUseFst 5 0
C z-add uNumJobsUseSecNumJobsUseSec 5 0
C
C except prestartd
3B C if *InOV = *On
C except heading
C except prestarth
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the WorkStation entrys for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0600' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except workstnnmh
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C
C move *blanks MaxActJobC 10
C if uMaxActJob = -1
C eval MaxActJobC = '*NOMAX'
C else
C eval MaxActJobC = %editc(uMaxActJob : '4')
C endif
C except workstnnmd
3B C if *InOV = *On
C except heading
C except workstnnmh
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the workStation entrys for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0700' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except workstntyh
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C
C move *blanks MaxActJobC 10
C if uMaxActJob = -1
C eval MaxActJobC = '*NOMAX'
C else
C eval MaxActJobC = %editc(uMaxActJob : '4')
C endif
C except workstnnmd
3B C if *InOV = *On
C except heading
C except workstntyh
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
1E C enddo
C eval *inlr=*on
*
*---------------------------------------------------------------------------------------------
* Call API to retrieve network attributes.
* Use offset to extract Network Attribute Information Table.
* Extract system name from table.
*---------------------------------------------------------------------------------------------
C *inzsr begsr
C call 'QWCRNETA' RETRIEVE SPACE
C parm vrcvr1
C parm 200 vrcvln
C parm vnkfld NUMBER OF KEYS
C parm vkarry KEY ARRAY
C parm vApiErrDs
*
C voffna add 1 aa START OFFSET
C eval vnait = %subst(vrcvr1:aa:16) LOAD NAIT DST
*
C add 16 aa START OF DATA
C vrtlen subst vrcvr1:aa vsysnm EXTRACT SYSNAM
C clear aa
C* except Headin
C* except heading
C* except routingh
*
* -CREATE USER SPACE-----------------------------------------------------------------------
C eval uSpaceName = 'JCRCMDS QTEMP '
C call 'QUSCRTUS' CREATE USER SPC
C parm uSpaceName 20 SPACE LIB
C parm ExtndAttrb EXTENDED ATRIB
C parm LenOfSpace SIZE IN BYTES
C parm Hex0Init INITIAL VALUE
C parm UseAthrity AUTHORITY
C parm SpaceText
C parm ReplaceObj
C parm vApiErrDs
*** parm Domain
*** parm TransferSize
*** parm OptimumAlign
*
* -GET POINTER TO USER SPACE---------------------------------------------------------------
C call 'QUSPTRUS' GET POINTER TO SPACE
C parm uSpaceName SPACE LIB
C parm uHeadPtr
C endsr
*
*---------------------------------------------------------------------------------------------
*
Oqsysprt e heading 1 01
O 10 'ANZSBSDR '
O 72 'ANALYZE SUBSYSTEM INFO'
O 198 'JCR'
O e heading 1
O 109 'SYSTEM:'
O vsysnm 120
O e heading 2
O 109 'Date :'
O JobDate Y 120
O e nodata 1
O vQualSbsName
O +1 'No Entrys data!'
O e poolidh 2 1
O 4 'SBSD'
O 43 'ROUTING ENTRY POOLID'
O 58 'POOLS'
O e poolidd 1
O vQualSbsName
O RtgString +1
O PoolString +1
O e routingh 1
O 15 'Routing Entries'
O e routingh 1
O 4 'SBSD'
O 31 'SeqNO'
O 42 'RoutingPgm'
O 66 'RoutingClass'
O 86 'MaxStep'
O 97 'PoolID'
O 108 'StrPos'
O 117 'CmpValue'
O e routingd 1
O vQualSbsName
O uSquenceNo 4 +1
O uRoutingPgm +1
O uRoutingPgmLib +1
O uRoutingClass +1
O uRoutingClsLib +1
O uMaxRoutingStp4 +1
O uRoutingPoolID4 +1
O uCmpStrPos 4 +1
O uCmpValue +1
O e jobqh 1
O 12 'JobQ Entries'
O e jobqh 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 25 'Jobq'
O 41 'Library'
O 55 'SeqNo'
O 64 'AllocInd'
O 77 'MaxAct'
O 103 'Maximum by priority 1 - 9'
O e jobqd 1
O vQualSbsName
O uJobqName +1
O uJobqLib 44
O uSeqNo 4 55
O uAllocInd 66
O uMaxAct 4 77
O MaxActPri1C +1
O MaxActPri2C +1
O MaxActPri3C +1
O MaxActPri4C +1
O MaxActPri5C +1
O MaxActPri6C +1
O MaxActPri7C +1
O MaxActPri8C +1
O MaxActPri9C +1
O e autostarth 1
O 21 'Autostart Job Entries'
O e autostarth 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 33 'AutostartJob'
O 49 'Job Description'
O 57 'Library'
O e autostartd 1
O vQualSbsName
O uAutostartJob +1
O uAutostartJobD 44
O uAutostartJobL 60
O e prestarth 1
O 20 'Prestart Job Entries'
O e prestarth 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 28 'PROGRAM'
O 39 'LIBRARY'
O 47 'User'
O 55 'S'
O 57 'W'
O 63 'IniJob'
O 69 'Thres'
O 75 'AddJob'
O 81 'Max'
O 87 'Use'
O 93 'Pool'
O 104 'PreJobName'
O 112 'PreJobD'
O 123 'Library'
O 134 'Class 1'
O 145 'Library'
O 154 'Use'
O 162 'Class 2'
O 173 'Library'
O 182 'Use'
O e prestartd 1
O vQualSbsName
O uPreJobPgm +1
O uPreJobPgmLib +1
O uUsrPrf +1
O uStartJob +1
O uWaitJob +1
O IniNumJobs 4 +1
O Threshold 4 +1
O AdditionalJob 4 +1
O MaxNumJobs 4 +1
O MaxNumUse 4 +1
O PoolId 4 +1
O uPreJobName +1
O uPreJobD +1
O uPreJobDLib +1
O uFirstClsName +1
O uFirstClsLib +1
O NumJobsUseFst 4 +1
O uSecClassName +1
O uSecClassLib +1
O NumJobsUseSec 4 +1
O e workstnnmh 1
O 24 'Workstation Name Entries'
O e workstnnmh 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 32 'WorkStation'
O 49 'Job Description'
O 57 'Library'
O 71 'ControlJob'
O 82 'MaximumJob'
O e workstntyh 1
O 24 'Workstation Type Entries'
O e workstntyh 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 37 'WorkStation Type'
O 54 'Job Description'
O 62 'Library'
O 76 'ControlJob'
O 87 'MaximumJob'
O e workstnnmd 1
O vQualSbsName
O uWorkstationNM +1
O uWorkstationJD 49
O uWorkstationJL 65
O uControlJob 76
O MaxActJobC 87
2001-07-17 如何讓你的 SQL 輸出讓人一目了然更有意義？
如何讓你的 SQL 輸出讓人一目了然更有意義？
使用 SQL Case 語法：
範例：
select tm01, tm02, tm10,
case
when tm10 <=1000
then 'Little'
when tm10 > 1000 and tm10 <=10000
then 'Midium'
when tm10 > 10000
then 'Large'
else ' '
end as flag
from imtmpf
其中 TM01,TM02 欄位是料號，TM10 是數量，
利用 CASE 函數將 TM10 依數值區間分類給一文字性敘述輸出，是不是較明白呢!
以下是輸出範例：
PART NO. FREQUENCY ACTUAL QTY FLAG
ATXN6058A 16.8 29,414.00 Large
ATXN6058A 16.8 11,389.00 Large
ATXN6062A 19.2 19,163.00 Large
KFN6237A 109.65 10,000.00 Midium
ATXN6059B 14.85 28,770.00 Large
ATXN6059B 14.85 24,287.00 Large
ATXN6059A 14.85 11,872.00 Large
ATFN6000A 45.1 10,000.00 Midium
ATFN6000A 45.1 6,000.00 Midium
KFN6138AB 73.35 6,000.00 Midium
KXN1476A 17.85 7,200.00 Midium
2001-07-13 如何於 SQL 中比較系統的 CURRENT DATE 與數字或文字性欄位？
如何於 SQL 中比較系統的 CURRENT DATE 與數字或文字性欄位？
SQL 的 CurDate 函數傳回一個 date 屬性的值，無法
直接拿來與數字或謂格式化的文字作比較，所以在比較
之前要先作型態轉換，有一個方法是使用 SQL/400
的 Year(),Month(),Day() 函數傳回數值，然後使用
數學運算式，產生數字性日期格式 YYYYMMDD，以下是
範例：
建立範例 Table TestDate：
Create Table TestDate (
PKCol Int Primary Key,
DecDate Decimal( 9,0 ),
CharDate Char( 8 ) )
輸入範例資料：
Insert Into TestDate Values ( 1, 20010711, '20010711' )
比較數字性欄位的ＳＱＬ語法：
Select *
From TestDate
Where DecDate =
100 * ( 100 * Year( CurDate() ) + Month( CurDate() ) ) +
Day( CurDate() )
比較文字性欄位的ＳＱＬ語法：
使用 CAST 函數將數字轉換為文字
Select *
From TestDate
Where CharDate = Cast(
100 * ( 100 * Year( CurDate() ) + Month( CurDate() ) ) +
Day( CurDate() ) As Char( 8 ) )
使用 CAST 函數時要注意 Month(),Day() 函數傳回
值若小於 10 時，CAST 函數轉換的結果會以 最後一
位為 空白，而非 0。
2001-07-02 如何於 SEU 中編輯 CLP 時直接執行 Command ？（不是按 F21 ㄡ）而是將 Command 輸入於 SEU 編輯區，按執行鍵，馬上執行 Command。
如何於 SEU 中編輯 CLP 時直接執行 Command ？（不是按 F21 ㄡ）而是將 Command 輸入於 SEU 編輯區，按執行鍵，馬上執行 Command。
如何於 SEU 中編輯 CLP 時直接執行 Command ？（不是按 F21 ㄡ）
而是將 Command 輸入於 SEU 編輯區，按執行鍵，馬上執行 Command。
Step 1: Create Command Source
/* QCMDSRC for source CMD */
/* *************** Beginning of data ***********************/
/* 0001.00 CMD */
/* ****************** End of data **************************/
Step 2: Create Command Processing PGM
/* QCLSRC for source RETURN */
/* *************** Beginning of data ***********************/
/* 0001.00 RETURN */
/* ****************** End of data **************************/
Step 3: Create '@' Command 使用 QSYS/QCMD 當成 Command 的檢核程式
Validity checking program
/* Create Command (CRTCMD)
/*
/* Command . . . . . . . . . . . . . . . . . . . . . .>_@_________ Name
/* Library . . . . . . . . . . . . . . . . . . . . . . . . _*CURLIB___
/* Program to process command . . . . >_RETURN_____ Name, *REXX
/* Library . . . . . . . . . . . . . . . . . . . . . . . . . _*LIBL____
/* Source file . . . . . . . . . . . . . . . . . . . . . _QCMDSRC____ N
/* Library . . . . . . . . . .. . . . . . . . . . . . . . ._*LIBL____
/* Source member . . . . . . . . . . . . . . . . >_CMD________ Name, *C
/* Text 'description' . . . ._*SRCMBRTXT____________________
/*
/*
/*
/* Additional Parameters
/*
/* Validity checking program . . . >_QCMD_______ Name, *NONE
/* Library . . . . . . . . . . . . . . . . . . . . > _QSYS_______ Name,
附註: 你也可以 Create 自己含 CL Command 的 CLP 程式，例如 WAJ
技巧在於 利用Command 的檢核程式 Validity checking program。
/* QCMDSRC for source WAJ */
/* *************** Beginning of data ***********************/
/* 0001.00 WAJ */
/* ****************** End of data **************************/
Step 2: Create Command Processing PGM
/* QCLSRC for source WAJ */
/* *************** Beginning of data ***********************/
/* 0001.00 WRKACTJOB */
/* ****************** End of data **************************/
Step 3: Create 'WAJ' Command 使用 library/WAJ 當成 Command 的檢核程式
/* Create Command (CRTCMD)
/*
/* Command . . . . . . . . . . . . . . . . . . . . . .>_WAJ_______ Name
/* Library . . . . . . . . . . . . . . . . . . . . . . . . _*CURLIB___
/* Program to process command . . . . >_RETURN_____ Name, *REXX
/* Library . . . . . . . . . . . . . . . . . . . . . . . . . _*LIBL____
/* Source file . . . . . . . . . . . . . . . . . . . . . _QCMDSRC____ N
/* Library . . . . . . . . . .. . . . . . . . . . . . . . ._*LIBL____
/* Source member . . . . . . . . . . . . . . . . >_WAJ________ Name, *C
/* Text 'description' . . . ._*SRCMBRTXT____________________
/*
/*
/*
/* Additional Parameters
/*
/* Validity checking program . . . >_WAJ________ Name, *NONE
/* Library . . . . . . . . . . . . . . . . . . . . > _QSYS_______ Name,
2001-06-26 如何於 RPG 中檢核 Command 正確性及執行 Command？
如何於 RPG 中檢核 Command 正確性及執行 Command？
File : QRPGLESRC
Member: CHKRUNCMDR
Type : RPGLE
*--------------------------------------------------------------*
* Vengoal Chang Development Resource 2001.06 *
* *
* \\\\\\\ *
* ( o o ) *
*-------------------oOO----(_)----OOo--------------------------*
* *
* Description : Checking or running command in RPG *
* *
* ooooO Ooooo *
* ( ) ( ) *
*-----------------( )-------------( )----------------------*
* (_) (_) *
* *
*--------------------------------------------------------------*
* D E S C R I P T I O N *
*--------------------------------------------------------------*
* Define This BIF *
* *
* * Chk_Cmd Check command *
* * Run_Cmd Ejecutar mandato. *
* *
* And the internal function: *
* * Call_API call to QCAPCMD API *
* *
* This functions return the ID of error if there are. also, if the *
* user change some parm in th original, the final command is returned*
* *
* *
*http://publib.boulder.ibm.com/pubs/html/as400/v5r1/ic2924/info/apis/qcapcmd.htm
* *
* Process Commands (QCAPCMD) API *
* Required Parameter Group:
* *
* 1 Source command string Input Char(*)
* *
* 2 Length of source command string Input Binary(4)
* *
* 3 Options control block Input Char(*)
* The options that control the handling of the command string.
* The layout of this parameter is the CPOP0100 format.
* *
* 4 Options control block length Input Binary(4)
* The length of the options control block. A minimum length of
* 20 is required for the CPOP0100 format.
* *
* 5 Options control block format Input Char(8)
* The format of the options control block. CPOP0100 is the
* only valid value.
* *
* 6 Changed command string Output Char(*)
* *
* 7 Length available for changed Input Binary(4)
* command string
* *
* 8 Length of changed command Output Binnary(4)
* string available to return
* *
* 9 Error Code I/O Char(*)
* You can use the QCAPCMD API to:
* Check the syntax of a command string prior to running it
* Prompt the command and receive the changed command string
* Run a command from an HLL
* CPOP0100 Format
* The CPOP0100 format includes information on the contents of the
* options control block parameter.
* Offset Type Field
* Dec Hex
* 0 0 BINARY(4) Type of command processing
* 0: AS/400 1: S/38
* 4 4 CHAR(1) DBCS data handling
* 0: Ignore 1: Handle
* 5 5 CHAR(1) Prompter action
* 0: Never Propmt
* 1: Always Prompt
* 2: Prompt the command if selective
* prompting characters are present in the
* command string.
* 3:Show help. Provides help display
* 6 6 CHAR(1) Command string syntax
* 0 :Command running.
* 1 :Command syntax check.
* 2 :Command line running.
* 3 :Command line syntax check.
* 4 <--> 10
*
* 7 7 CHAR(4) Message retrieve key
* The message key is valid for processing
* command types 0, 1, 2, and 3.
*
* 11 B CHAR(9) Reserved
*--------------------------------------------------------------*
H Debug Option(*SRCSTMT:*NODEBUGIO)
* Compiler instructions
H Indent('|') Optimize(*Full)
H BndDir('*LIBL/BNDDIR')
H NoMain
D Chk_Cmd PR 7A
D Aux_Cmd 255A
D Aux_Tip 9B 0 Const Options(*NoPass)
D Aux_Prompt N Const Options(*NoPass)
D Run_Cmd PR 7A
D Aux_Cmd 255A
D Aux_Prompt N Const Options(*NoPass)
D Proc_Cmds PR ExtPgm('QCAPCMD')
D CA_Cmd 255A Const
D CA_CmdL 9B 0 Const
D CA_OCB 20A Const
D CA_OCBL 9B 0 Const
D CA_OCBF 8A Const
D CA_CmdC 255A
D CA_CmdCL 9B 0 Const
D CA_CmdCL1 9B 0
D CA_Err 16A
D Call_API PR 7A
D Aux_Cmd 255A
D Aux_Tip 9B 0 Const
D Aux_Prompt N Const
*-------------------------------------------------------------------* EUR
* Call_API Internal call to API * EUREUR
*-------------------------------------------------------------------* EUR
P Call_API B
D Call_API PI 7A
D Aux_Cmd 255A
D Aux_Tip 9B 0 Const
D Aux_Prompt N Const
* User space error code EUREUR
/Copy QSYSINC/QRPGLESRC,QUSEC
* EUREUR
D QCA_CMD S 255A
D QCA_CMDL S 9B 0 Inz(%Size(QCA_Cmd))
D QCA_OCB S 20A Based(pQCPOP0100)
D QCA_OCBL S 9B 0 Inz(%Size(QCA_OCB))
D QCA_OCBF S 8A Inz('CPOP0100')
D QCA_CMDR S 255A Inz(*Blanks)
D QCA_CMDRL S 9B 0 Inz(%Size(QCA_CMDR))
D QCA_CMDRL1 S 9B 0 Inz(%Size(QCA_CMDR))
D PQCPOP0100 S * Inz(%Addr(QCPOP0100))
D QCPOP0100 DS
D QCPO_TYPE 9B 0 Inz
D QCPO_DBCS 1A Inz('0')
D QCPO_PRMT 1A
D QCPO_STX 1A Inz('0')
D QCPO_MKEY 4A Inz(*Blanks)
D QCPO_RSV 9A Inz(x'000000000000000000')
c Eval QUsBPrv = %Size(QUSEC)
c Eval QCA_CMD = Aux_Cmd
c Eval QCPO_TYPE = Aux_Tip
c Eval QCPO_PRMT = Aux_Prompt
c CallP Proc_Cmds(QCA_CMD: QCA_CMDL:
c QCA_OCB: QCA_OCBL: QCA_OCBF:
c QCA_CMDR: QCA_CMDRL: QCA_CMDRL1:
c QUSEC)
c Eval Aux_Cmd = QCA_CMDR
c Return QUSEI
P Call_API E
*-------------------------------------------------------------------* EUR
* Chk_Cmd Check command * EUREUR
*-------------------------------------------------------------------* EUR
P Chk_Cmd B Export
D Chk_Cmd PI 7A
D Aux_Cmd 255A
D Aux_Tip 9B 0 Const Options(*NoPass)
D Aux_Prompt N Const Options(*NoPass)
* fields for the call EUREUR
D Cmd S 255A Inz
D Tip S 9B 0 Inz(1)
D Prompt S N Inz(*ON)
D Err S 7A Inz
c If %Parms > 1
c Eval Tip = Aux_Tip
c EndIf
c If %Parms > 2
c Eval Prompt = Aux_Prompt
c EndIf
c Eval Cmd = Aux_Cmd
c If (Tip < 0) OR (Tip > 9)
c Return 'CPF0008'
c EndIf
c Eval Err = Call_API(Cmd: Tip: Prompt)
c If Err <> *Blanks
c Return Err
c Else
c Eval Aux_Cmd = Cmd
c Return *Blanks
c EndIf
P Chk_Cmd E
*-------------------------------------------------------------------* EUR
* Run_Cmd Run the command * EUREUR
*-------------------------------------------------------------------* EUR
P Run_Cmd B Export
D Run_Cmd PI 7A
D Aux_Cmd 255A
D Aux_Prompt N Const Options(*NoPass)
* fields for the call EUREUR
D Cmd S 255A Inz
D Prompt S N Inz(*OFF)
D Err S 7A Inz
c If %Parms > 1
c Eval Prompt = Aux_Prompt
c EndIf
c Eval Cmd = Aux_Cmd
c Eval Err = Call_API(Cmd: 2: Prompt)
c If Err <> *Blanks
c Return Err
c Else
c Eval Aux_Cmd = Cmd
c Return *Blanks
c EndIf
P Run_Cmd E
用 法
1. CRTRPGMOD CHKRUNCMDR.
2. CRTBNDDIR BNDDIR.
3. ADDBNDDIRE BNDDIR(BNDDIR) OBJ((CHKRUNCMDR *MODULE))
4. Sample Usage pgm.
Copy the following to your Program, then define ErrCPFID CHAR(7) to receive ERROR Message ID using
ErrCPFID = Callp Chk_cmd (CMDStr) to check command, or
ErrCPFID = Callp Run_cmd (CMDStr) to run command.
D Chk_Cmd PR 7A
D Aux_Cmd 255A
D Aux_Tip 9B 0 Const Options(*NoPass)
D Aux_Prompt N Const Options(*NoPass)
D Run_Cmd PR 7A
D Aux_Cmd 255A
D Aux_Prompt N Const Options(*NoPass)
5. Compiled your program with
CRTBNDPGM PGM(your program) DFTACTGRP(*NO) BNDDIR(BNDDIR)
訂閱：
文章 (Atom)