Url: http://bbs.chinaunix.net/forum.php?mod=viewthread&tid=1485886
SC = Session Copy
复制当前行到内存空间
SCC = Session Copy Block
复制两个SCC之间的一段到内存空间
SA = Session After
将内存里用SC/SCC复制的源代码粘贴到SA标记的行后面
SB = Session Before
将内存里用SC/SCC复制的源代码粘贴到SB标记的行前面
SC/SCC/SA/SB的用法类似SEU自带的C/CC/A/B用法，但是SEU自带的拷贝粘贴功能只能用在一个SEU窗口内，而SC/SCC/SA/SB可以在多个窗口间互相使用，例如一个窗口浏览源代码并使用SC/SCC命令拷贝，另外一个窗口则可以编辑源代码并使用SA/SB命令粘贴。
* = 注释
将一行注释，支持CLP/CLLE/CBL/CBLLE/SQLCBL/RPG/RPGLE/SQLRPG/PF/LF/PRTF/DSPF/ICFF/MNUDDS/TXT。
可以在*后面加上字母表示注释行颜色：R/RED/红色、W/WHITE/白色、B/BLUE/蓝色、Y/YELLOW/黄色、P/PINK/粉色、T/Turquoise/青绿色、G/GREEN/绿色。
如*R *B。
** = 注释
将两个**之间的段落注释，类似*的用法，也可加上颜色注释，如**B **R。
/ = 取消注释
将使用*命令注释掉的行去除注释标记。
// = 取消注释
在两个//之间的段落中去除注释标记。
T = Date Tag
仅支持Cobol格式的源代码，将代码行前6位覆盖成以YYMMDD为格式的当前日期。
TT = Date Tag
将两个TT之间的段落，标记上当前日期。
N = Name Tag
仅支持Cobol格式的源代码，将代码行前6位覆盖成当前用户名字的前6位。
NN = Name Tag
将两个NN之间的段落，标记上当前用户。
*************** Beginning of data *****************************************
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Title .......: User-Defined SEU Function Keys and Line Commands.
* Programmer ..: Tongxx
* Description .: Function Grop 01 : Copy Sources Between Sessions.
* 'SC' : Copy a line Source
* 'SCC' : Use a pair of 'SCC' to copy a block of
* Source
* 'SA' : Paste sources after this line
* 'SB' : Paste sources before this line
* Function Grop 02 : Comment or NonComment the Source
* '*' , '/' , '**' , '//'
* How to Use ..: Method 1. in SEU interface, press F13 to change
* session defaults, input 'XXSEUCMDR' in 'User exit
* program' and then input 'QGPL' in 'Library'
* Method 2. use ADDEXITPGM command.
* ADDEXITPGM EXITPNT(QIBM_QSU_LCMD) FORMAT(EXTP0100)
* PGMNBR(*HIGH) PGM(QGPL/XXSEUCMDR)
* then in SEU press F13, input '*REGFAC' in 'User
* exit program'.
*
* Compile Stmt.: CRTBNDRPG PGM(QGPL/XXSEUCMDR)
* SRCFILE(SRCTONGXX/YYSEUCMD) SRCMBR(XXSEUCMDR)
*
* Update His ..: 1. 2007/06/01 by Tongxx
* Creat Source.
* 2. 2007/06/04 by Tongxx
* Fix cpy&pst for all record length files.
* Change User Space naming method & position.
* Change User Space Attributes - Size and Extension
* 3. 2007/06/19 by Tongxx
* Add Function Grop 2 : Comment or NonComment
* Supportting format RPG/CLP/CBL/RPGLE/CLLE/CBLLE
* 4. 2007/11/14 by Tongxx
* Fix some bugs
* 5. 2008/03/30 by Tongxx
* add colorful comment function.(R/G/B/Y/T/P/W)
* 5. 2008/05/26 by Tongxx
* add Function Key
* F7 - Log Memo
* F8 - Dsp Memo
* 5. 2009/06/17 by Tongxx
* add Date/Name Tag Function for Cobol source
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
H Debug(*yes) DateDit(*YMD)
HCopyright('written by Tongxx')
/COPY QsysInc/QRpgLeSrc,QUSEC
D SDS
D SysDte 191 198
D UserID 254 263
D SEUspc S 20 Inz('QSUSPC QTEMP ')
D SesUspNam S 10
D SesUsp S 20 Inz(' QGPL ')
D c_CPFMsgF C Const('QCPFMSG QSYS ')
D c_EDTMsgF C Const('QEDTMSG QPDA ')
* // the first 20 bytes of LinInf
D c_LinHdrLen C Const(20)
* // the first 3 pointers are parameters passed in by SEU session
D pHdrInf S *
D pRtnCod S *
D pLinInf S *
D pLinCmd S *
D pLinTxt S *
D pSesUsp S *
D pSesUspTmp S *
D HdrInf DS Based(pHdrInf)
D HdrRcdLen 1 4B 0
D HdrCsrRrn 5 8B 0
D HdrCsrPos 9 12B 0
D HdrCCSID 13 16B 0
D HdrRcdNbI 17 20B 0
D HdrMbrNam 21 30
D HdrFilNam 31 40
D HdrLibNam 41 50
D HdrMbrTyp 51 60
D HdrFunKey 61 61
D HdrSeuMod 62 62
D HdrSplSes 63 63
D HdrReserv 64 64
D RtnCod DS Based(pRtnCod)
D RtnRtnCod 1 1
D RtnResrv1 2 4
D RtnRcdNbO 5 8B 0
D RtnSeqNbI 9 15
D RtnResrv2 16 37
D LinInf DS Based(pLinInf)
D LinLinCmd 1 7
D LinRtnCod 8 8
D LinSeqNbr 9 14
D LinChgDte 15 20
D LinLinTxt 21 100
D LinCmd S 7 Based(pLinCmd)
D wInputRcd S 9 0
D wLinCpyed S 9 0
D wColor S 1
* // Parameters for QMHSNDPM Api which function like SNDPGMMSG CL-cmd
D DS
D MsgID 1 7 Inz(' ')
D MsgF 8 27 Inz(' ')
D MsgDta 28 28 Inz(' ')
D MsgLen 29 32B 0 Inz(1)
D MsgTyp 33 42 Inz('*INFO')
D MsgEnt 43 52 Inz('*')
D MsgCnt 53 56B 0 Inz(2)
D MsgKey 57 60
D MsgErr 61 84
D UspAttr S 10 Inz('SEUSPC ')
D UspSize S 9B 0 Inz(150000)
D UspInit S 1 Inz(X'00')
D UspAut S 10 Inz('*ALL')
D UspTxt S 50 Inz(' ')
D UspReplac S 10 Inz('*NO')
D UspDomain S 10 Inz('*USER')
D ChgAttr DS
D ChgCnt 1 4B 0 Inz(2)
D ChgAttr1Key 5 8B 0 Inz(1)
D ChgAttr1Len 9 12B 0 Inz(4)
D ChgAttr1Dta 13 16B 0 Inz(150000)
D ChgAttr2Key 17 20B 0 Inz(3)
D ChgAttr2Len 21 24B 0 Inz(1)
D ChgAttr2Dta 25 25 Inz('1')
D CpyLinLen S 4 0
D PstLinLen S 4 0
*
*
*=====================================================================
*
*
C Exsr #Init
C Exsr #Proc
C Exsr #Exit
*
*
*
CSR #Init BEGSR
C *Entry PList
C Parm pHdrInf
C Parm pRtnCod
C Parm pLinInf
C
C Exsr #CrtUsrSpc
C Exsr #AsgUspPtr
CSR ENDSR
*
*
*
CSR #Exit BEGSR
C Move *ON *InLR
C Return
CSR ENDSR
*
*
*
CSR #Proc BEGSR
C
C Exsr #FunKeyPrc
C
C Exsr #LinCmdPrc
C
CSR ENDSR
*
* Process Function Key
*
CSR #FunKeyPrc BEGSR
C Select
* when Press F7
C When HdrFunKey = '7'
C* Exsr #LogMem
C
* when Press F8
C When HdrFunKey = '8'
C* Exsr #DspMem
C
* when Press all other Function Keys
C When HdrFunKey = '0'
C* Exsr #Exit
C
C EndSl
C
CSR ENDSR
*
* Process Line Commands
*
CSR #LinCmdPrc BEGSR
C Eval pLinCmd = pLinInf
C
C Select
C When LinCmd = 'SCC'
C Exsr #SesCpyBlk
C
C When LinCmd = 'SC'
C Exsr #SesCpy
C
C When LinCmd = 'SA'
C Exsr #SesPstAft
C
C When LinCmd = 'SB'
C Exsr #SesPstBfr
C
C When LinCmd = 'T'
C Exsr #AddDteTag
C
C When LinCmd = 'TT'
C Exsr #AddDteTagBlk
C
C When LinCmd = 'N'
C Exsr #AddNamTag
C
C When LinCmd = 'NN'
C Exsr #AddNamTagBlk
C
C When %Subst(LinCmd:1:1) = '*' and
C %Subst(LinCmd:1:2) <> '**'
C Exsr #RmvAstLin
C Exsr #AddAstLin
C
C When LinCmd = '/'
C Exsr #RmvAstLin
C
C When %Subst(LinCmd:1:2) = '**'
C Exsr #AddAstBlk
C
C When LinCmd = '//'
C Exsr #RmvAstBlk
C
C Other
C Exsr #UnSuppCmd
C
C EndSl
CSR ENDSR
*
* Session Copy - Line Command 'SC'
*
CSR #SesCpy BEGSR
C Eval pSesUspTmp = pSesUsp
C Eval %Str(pSesUsp:%size(HdrInf)) = HdrInf
C Eval pSesUsp = pSesUsp + %size(HdrInf)
C Eval %Str(pSesUsp:%size(RtnCod)) = RtnCod
C Eval pSesUsp = pSesUsp + %size(RtnCod)
C
C Eval wInputRcd = 0
C Eval wLinCpyed = 0
C Dow wInputRcd < HdrRcdNbI - 1
C Eval pLinTxt = pLinInf + c_LinHdrLen
C
C If LinLinCmd = 'SC'
C Eval %Str(pSesUsp:(HdrRcdLen+c_LinHdrLen+1))
C = %Str(pLinInf:c_LinHdrLen) +
C %Str(pLinTxt:HdrRcdLen)
C Eval wLinCpyed = wLinCpyed + 1
C Eval LinLinCmd = *Blank
C Eval pSesUsp = pSesUsp + HdrRcdLen
C + c_LinHdrLen
C EndIf
C
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval HdrRcdNbI = wLinCpyed + 1
C Eval %Str(pSesUspTmp:%size(HdrInf)) = HdrInf
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = 0
C Move LinSeqNbr RtnSeqNbI
C Eval LinLinCmd = *Blanks
C Eval RtnRtnCod = '3'
C
C Exsr #Exit
CSR ENDSR
*
* Session Copy Block - Line Command 'SCC' must using in PAIRs
*
CSR #SesCpyBlk BEGSR
* Check if the Line Command 'SCC' is enclosed
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 2
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C If LinLinCmd <> LinCmd or
C HdrRcdNbI <= 2
C Move 'EDT1005' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C Eval LinLinCmd = *Blanks
C Eval pLinInf = pLinCmd
C Eval LinLinCmd = *Blanks
C
C Eval %Str(pSesUsp:%size(HdrInf)) = HdrInf
C Eval pSesUsp = pSesUsp + %size(HdrInf)
C Eval %Str(pSesUsp:%size(RtnCod)) = RtnCod
C Eval pSesUsp = pSesUsp + %size(RtnCod)
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C Eval pLinTxt = pLinInf + c_LinHdrLen
C Eval %Str(pSesUsp:(HdrRcdLen+c_LinHdrLen+1))
C = %Str(pLinInf:c_LinHdrLen) +
C %Str(pLinTxt:HdrRcdLen)
C
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval pSesUsp = pSesUsp + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = 0
C Move LinSeqNbr RtnSeqNbI
C Eval RtnRtnCod = '3'
C
C Exsr #Exit
CSR ENDSR
*
* Session Paste After - Line Command 'SA'
*
CSR #SesPstAft BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
C Eval PstLinLen = HdrRcdLen
C
C Eval pHdrInf = pSesUsp
C Eval pSesUsp = pSesUsp + %size(HdrInf)
C Eval pSesUsp = pSesUsp + %size(RtnCod)
C Eval CpyLinLen = HdrRcdLen
C
C Eval RtnRtnCod = '0'
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Move LinSeqNbr RtnSeqNbI
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C Eval pLinTxt = pSesUsp + c_LinHdrLen
C Eval %Str(pLinInf:(PstLinLen+c_LinHdrLen+1))
C = %Str(pSesUsp:c_LinHdrLen) +
C %Str(pLinTxt:CpyLinLen)
C
C Eval pLinInf = pLinInf + PstLinLen
C + c_LinHdrLen
C Eval pSesUsp = pSesUsp + CpyLinLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C
C Exsr #Exit
CSR ENDSR
*
* Session Paste Before - Line Command 'SB'
*
CSR #SesPstBfr BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
C Eval PstLinLen = HdrRcdLen
C
C Eval pHdrInf = pSesUsp
C Eval pSesUsp = pSesUsp + %size(HdrInf)
C Eval pSesUsp = pSesUsp + %size(RtnCod)
C Eval CpyLinLen = HdrRcdLen
C
C Eval RtnRtnCod = '0'
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Move LinSeqNbr RtnSeqNbI
C MoveL 'B' RtnSeqNbI
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C Eval pLinTxt = pSesUsp + c_LinHdrLen
C Eval %Str(pLinInf:(PstLinLen+c_LinHdrLen+1))
C = %Str(pSesUsp:c_LinHdrLen) +
C %Str(pLinTxt:CpyLinLen)
C
C Eval pLinInf = pLinInf + PstLinLen
C + c_LinHdrLen
C Eval pSesUsp = pSesUsp + CpyLinLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C
C Exsr #Exit
CSR ENDSR
*
* Add Date Tag on the Front of Line ( Only for Cobol Source )
*
CSR #AddDteTag BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C If %Subst(LinLinCmd:1:1) = 'T'
C*
C Select
C When HdrMbrTyp = 'CBL' or
C HdrMbrTyp = 'CBLLE' or
C HdrMbrTyp = 'SQLCBL' or
C HdrMbrTyp = 'SQLCBLLE'
C Eval %Subst(LinLinTxt:1:6) =
C %Subst(SysDte:3:6)
C Other
C EndSl
C*
C Eval LinLinCmd = *Blank
C EndIf
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Eval RtnRtnCod = '0'
CSR ENDSR
*
* Add Date Tag at the Front of a Block Lines ( Only for Cobol Source )
*
CSR #AddDteTagBlk BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
* Check if Line Command 'TT' is Enclosed
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 2
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C If LinLinCmd <> LinCmd or
C HdrRcdNbI <= 2
C Move 'EDT1005' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C*
C Eval LinLinCmd = *Blanks
C Eval pLinInf = pLinCmd
C Eval LinLinCmd = *Blanks
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C*
C Select
C When HdrMbrTyp = 'CBL' or
C HdrMbrTyp = 'CBLLE' or
C HdrMbrTyp = 'SQLCBL' or
C HdrMbrTyp = 'SQLCBLLE'
C Eval %Subst(LinLinTxt:1:6)
C = %Subst(SysDte:3:6)
C Other
C EndSl
C*
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Eval RtnRtnCod = '0'
CSR ENDSR
*
* Add Name Tag on the Front of Line ( Only for Cobol Source )
*
CSR #AddNamTag BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C If %Subst(LinLinCmd:1:1) = 'N'
C*
C Select
C When HdrMbrTyp = 'CBL' or
C HdrMbrTyp = 'CBLLE' or
C HdrMbrTyp = 'SQLCBL' or
C HdrMbrTyp = 'SQLCBLLE'
C Eval %Subst(LinLinTxt:1:6)
C = %Subst(UserID:1:6)
C Other
C EndSl
C*
C Eval LinLinCmd = *Blank
C EndIf
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Eval RtnRtnCod = '0'
CSR ENDSR
*
* Add Name Tag at the Front of a Block Lines ( Only for Cobol Source )
*
CSR #AddNamTagBlk BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
* Check if Line Command 'NN' is Enclosed
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 2
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C If LinLinCmd <> LinCmd or
C HdrRcdNbI <= 2
C Move 'EDT1005' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C*
C Eval LinLinCmd = *Blanks
C Eval pLinInf = pLinCmd
C Eval LinLinCmd = *Blanks
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C*
C Select
C When HdrMbrTyp = 'CBL' or
C HdrMbrTyp = 'CBLLE' or
C HdrMbrTyp = 'SQLCBL' or
C HdrMbrTyp = 'SQLCBLLE'
C Eval %Subst(LinLinTxt:1:6)
C = %Subst(UserID:1:6)
C Other
C EndSl
C*
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Eval RtnRtnCod = '0'
CSR ENDSR
*
* Comment a Line - Line Command '*'
*
CSR #AddAstLin BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C If %Subst(LinLinCmd:1:1) = '*'
C*
C Select
C* RED
C When %Subst(LinLinCmd:2:1) = 'R'
C Move X'28' wColor
C* WHITE
C When %Subst(LinLinCmd:2:1) = 'W'
C Move X'22' wColor
C* BLUE
C When %Subst(LinLinCmd:2:1) = 'B'
C Move X'3A' wColor
C* YELLOW
C When %Subst(LinLinCmd:2:1) = 'Y'
C Move X'32' wColor
C* PINK
C When %Subst(LinLinCmd:2:1) = 'P'
C Move X'38' wColor
C* TRQ
C When %Subst(LinLinCmd:2:1) = 'T'
C Move X'34' wColor
C* GREEN
C When %Subst(LinLinCmd:2:1) = 'G'
C Move X'20' wColor
C Other
C Move ' ' wColor
C EndSl
C*
C Select
C When HdrMbrTyp = 'CBL' or
C HdrMbrTyp = 'CBLLE' or
C HdrMbrTyp = 'SQLCBL' or
C HdrMbrTyp = 'SQLCBLLE' or
C HdrMbrTyp = 'RPG' or
C HdrMbrTyp = 'RPGLE' or
C HdrMbrTyp = 'SQLRPG' or
C HdrMbrTyp = 'SQLRPGLE' or
C HdrMbrTyp = 'PF' or
C HdrMbrTyp = 'LF' or
C HdrMbrTyp = 'DSPF' or
C HdrMbrTyp = 'ICFF' or
C HdrMbrTyp = 'PRTF' or
C HdrMbrTyp = 'MNUDDS'
C Eval %Subst(LinLinTxt:7:1) = '*'
C If wColor <> ' '
C Eval %Subst(LinLinTxt:6:1) = wColor
C EndIf
C When HdrMbrTyp = 'CLP' or
C HdrMbrTyp = 'CLLE'
C Eval %Subst(LinLinTxt: 1:2) = '/*'
C If wColor <> ' '
C Eval %Subst(LinLinTxt: 3:1) = wColor
C EndIf
C Eval %Subst(LinLinTxt:70:2) = '*/'
C When HdrMbrTyp = 'TXT'
C If wColor <> ' '
C Eval %Subst(LinLinTxt: 1:1) = wColor
C EndIf
C Other
C EndSl
C*
C Eval LinLinCmd = *Blank
C EndIf
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Eval RtnRtnCod = '0'
CSR ENDSR
*
* NonComment a Line - Line Command '/'
*
CSR #RmvAstLin BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C If LinLinCmd = '/'
C*
C Select
C When HdrMbrTyp = 'CBL' or
C HdrMbrTyp = 'CBLLE' or
C HdrMbrTyp = 'SQLCBL' or
C HdrMbrTyp = 'SQLCBLLE' or
C HdrMbrTyp = 'RPG' or
C HdrMbrTyp = 'RPGLE' or
C HdrMbrTyp = 'SQLRPG' or
C HdrMbrTyp = 'SQLRPGLE' or
C HdrMbrTyp = 'PF' or
C HdrMbrTyp = 'LF' or
C HdrMbrTyp = 'DSPF' or
C HdrMbrTyp = 'ICFF' or
C HdrMbrTyp = 'PRTF' or
C HdrMbrTyp = 'MNUDDS'
C Eval %Subst(LinLinTxt:7:1) = ' '
C If %Subst(LinLinTxt:6:1) = X'20' or
C %Subst(LinLinTxt:6:1) = X'22' or
C %Subst(LinLinTxt:6:1) = X'28' or
C %Subst(LinLinTxt:6:1) = X'32' or
C %Subst(LinLinTxt:6:1) = X'34' or
C %Subst(LinLinTxt:6:1) = X'38' or
C %Subst(LinLinTxt:6:1) = X'3A'
C Eval %Subst(LinLinTxt:6:1) = ' '
C EndIf
C When HdrMbrTyp = 'CLP' or
C HdrMbrTyp = 'CLLE'
C Move 0 i 3 0
C Move 0 j 3 0
C Eval i = %Scan('/*' : LinLinTxt )
C Eval j = %Scan('*/' : LinLinTxt )
C If i > 0
C Eval %Subst(LinLinTxt:i:2) = ' '
C If %Subst(LinLinTxt:i+2:1) = X'20' or
C %Subst(LinLinTxt:i+2:1) = X'22' or
C %Subst(LinLinTxt:i+2:1) = X'28' or
C %Subst(LinLinTxt:i+2:1) = X'32' or
C %Subst(LinLinTxt:i+2:1) = X'34' or
C %Subst(LinLinTxt:i+2:1) = X'38' or
C %Subst(LinLinTxt:i+2:1) = X'3A'
C Eval %Subst(LinLinTxt:i+2:1) = ' '
C EndIf
C EndIf
C If j > 0
C Eval %Subst(LinLinTxt:j:2) = ' '
C EndIf
C When HdrMbrTyp = 'TXT'
C Eval %Subst(LinLinTxt:1:1) = ' '
C Other
C EndSl
C*
C Eval LinLinCmd = *Blank
C EndIf
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Eval RtnRtnCod = '0'
CSR ENDSR
*
* Comment a Block of Lines - Line Command '**'
*
CSR #AddAstBlk BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
* Check if Line Command '**' is Enclosed
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 2
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C If LinLinCmd <> LinCmd or
C HdrRcdNbI <= 2
C Move 'EDT1005' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C*
C Select
C* RED
C When %Subst(LinLinCmd:3:1) = 'R'
C Move X'28' wColor
C* WHITE
C When %Subst(LinLinCmd:3:1) = 'W'
C Move X'22' wColor
C* BLUE
C When %Subst(LinLinCmd:3:1) = 'B'
C Move X'3A' wColor
C* YELLOW
C When %Subst(LinLinCmd:3:1) = 'Y'
C Move X'32' wColor
C* PINK
C When %Subst(LinLinCmd:3:1) = 'P'
C Move X'38' wColor
C* TRQ
C When %Subst(LinLinCmd:3:1) = 'T'
C Move X'34' wColor
C* GREEN
C When %Subst(LinLinCmd:3:1) = 'G'
C Move X'20' wColor
C Other
C Move ' ' wColor
C EndSl
C*
C Eval LinLinCmd = *Blanks
C Eval pLinInf = pLinCmd
C Eval LinLinCmd = *Blanks
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C*
C Select
C When HdrMbrTyp = 'CBL' or
C HdrMbrTyp = 'CBLLE' or
C HdrMbrTyp = 'SQLCBL' or
C HdrMbrTyp = 'SQLCBLLE' or
C HdrMbrTyp = 'RPG' or
C HdrMbrTyp = 'RPGLE' or
C HdrMbrTyp = 'SQLRPG' or
C HdrMbrTyp = 'SQLRPGLE' or
C HdrMbrTyp = 'PF' or
C HdrMbrTyp = 'LF' or
C HdrMbrTyp = 'DSPF' or
C HdrMbrTyp = 'ICFF' or
C HdrMbrTyp = 'PRTF' or
C HdrMbrTyp = 'MNUDDS'
C Eval %Subst(LinLinTxt:7:1) = '*'
C If wColor <> ' '
C Eval %Subst(LinLinTxt:6:1) = wColor
C EndIf
C When HdrMbrTyp = 'CLP' or
C HdrMbrTyp = 'CLLE'
C Eval %Subst(LinLinTxt: 1:2) = '/*'
C If wColor <> ' '
C Eval %Subst(LinLinTxt: 3:1) = wColor
C EndIf
C Eval %Subst(LinLinTxt:70:2) = '*/'
C When HdrMbrTyp = 'TXT'
C If wColor <> ' '
C Eval %Subst(LinLinTxt: 1:1) = wColor
C EndIf
C Other
C EndSl
C*
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Eval RtnRtnCod = '0'
CSR ENDSR
*
* NonComment a Block of Lines - Line Command '//'
*
CSR #RmvAstBlk BEGSR
C If HdrSeuMod <> 'U'
C Move 'EDT1202' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C
* Check if Line Command '//' is Enclosed
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 2
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C If LinLinCmd <> LinCmd or
C HdrRcdNbI <= 2
C Move 'EDT1005' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C Eval LinLinCmd = *Blanks
C Eval pLinInf = pLinCmd
C Eval LinLinCmd = *Blanks
C
C Eval wInputRcd = 0
C Dow wInputRcd < HdrRcdNbI - 1
C
C Select
C When HdrMbrTyp = 'CBL' or
C HdrMbrTyp = 'CBLLE' or
C HdrMbrTyp = 'SQLCBL' or
C HdrMbrTyp = 'SQLCBLLE' or
C HdrMbrTyp = 'RPG' or
C HdrMbrTyp = 'RPGLE' or
C HdrMbrTyp = 'SQLRPG' or
C HdrMbrTyp = 'SQLRPGLE' or
C HdrMbrTyp = 'PF' or
C HdrMbrTyp = 'LF' or
C HdrMbrTyp = 'DSPF' or
C HdrMbrTyp = 'ICFF' or
C HdrMbrTyp = 'PRTF' or
C HdrMbrTyp = 'MNUDDS'
C Eval %Subst(LinLinTxt:7:1) = ' '
C If %Subst(LinLinTxt:6:1) = X'20' or
C %Subst(LinLinTxt:6:1) = X'22' or
C %Subst(LinLinTxt:6:1) = X'28' or
C %Subst(LinLinTxt:6:1) = X'32' or
C %Subst(LinLinTxt:6:1) = X'34' or
C %Subst(LinLinTxt:6:1) = X'38' or
C %Subst(LinLinTxt:6:1) = X'3A'
C Eval %Subst(LinLinTxt:6:1) = ' '
C EndIf
C When HdrMbrTyp = 'CLP' or
C HdrMbrTyp = 'CLLE'
C Move 0 i 3 0
C Move 0 j 3 0
C Eval i = %Scan('/*' : LinLinTxt )
C Eval j = %Scan('*/' : LinLinTxt )
C If i > 0
C Eval %Subst(LinLinTxt:i:2) = ' '
C If %Subst(LinLinTxt:i+2:1) = X'20' or
C %Subst(LinLinTxt:i+2:1) = X'22' or
C %Subst(LinLinTxt:i+2:1) = X'28' or
C %Subst(LinLinTxt:i+2:1) = X'32' or
C %Subst(LinLinTxt:i+2:1) = X'34' or
C %Subst(LinLinTxt:i+2:1) = X'38' or
C %Subst(LinLinTxt:i+2:1) = X'3A'
C Eval %Subst(LinLinTxt:i+2:1) = ' '
C EndIf
C EndIf
C If j > 0
C Eval %Subst(LinLinTxt:j:2) = ' '
C EndIf
C When HdrMbrTyp = 'TXT'
C Eval %Subst(LinLinTxt:1:1) = ' '
C Other
C EndSl
C*
C Eval pLinInf = pLinInf + HdrRcdLen
C + c_LinHdrLen
C Eval wInputRcd = wInputRcd + 1
C EndDo
C
C Eval pLinInf = pLinCmd
C Eval RtnRcdNbO = HdrRcdNbI - 1
C Eval RtnRtnCod = '0'
CSR ENDSR
*
* Un-Supported Commands
*
CSR #UnSuppCmd BEGSR
C Move 'EDT1001' MsgID
C Move c_EDTMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
CSR ENDSR
*
*
*
CSR #LogMem BEGSR
C Call 'XXSEUMADR'
C Parm HdrLibNam
C Parm HdrFilNam
C Parm HdrMbrNam
C Eval RtnRcdNbO = 1
C Eval RtnRtnCod = '1'
C Exsr #Exit
CSR ENDSR
*
*
*
CSR #DspMem BEGSR
C Call 'XXSEUMLSR'
C Parm HdrLibNam
C Parm HdrFilNam
C Parm HdrMbrNam
C Eval RtnRcdNbO = 1
C Eval RtnRtnCod = '1'
C Exsr #Exit
CSR ENDSR
*
* Create User Space for Session Copy and Paste
*
CSR #CrtUsrSpc BEGSR
C Eval %Subst(SesUspNam:1:4) = 'SESP'
C Eval %Subst(SesUspNam:5:6) = UserID
C MoveL SesUspNam SesUsp
C
C Call 'QUSCRTUS'
C Parm SesUsp
C Parm UspAttr
C Parm UspSize
C Parm UspInit
C Parm UspAut
C Parm UspTxt
C Parm UspReplac
C Parm QUsEc
C Parm UspDomain
C
* // CPF9870 means the expecting user space already exists.
C If QUSBAVL > 0
C If QUSEI <> 'CPF9870'
C Move QUSEI MsgID
C Move c_CPFMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
C EndIf
C
C Call 'QUSCUSAT'
C Parm RtnLib 10
C Parm SesUsp
C Parm ChgAttr
C Parm QUsEc
C
C Call 'QUSCUSAT'
C Parm RtnLib 10
C Parm SEUspc
C Parm ChgAttr
C Parm QUsEc
CSR ENDSR
*
* Assign a Pointer to Session User Space
*
CSR #AsgUspPtr BEGSR
C Call 'QUSPTRUS'
C Parm SesUsp
C Parm pSesUsp
C Parm QUsEc
C
C If QUSBAVL > 0
C Move QUSEI MsgID
C Move c_CPFMsgF MsgF
C Exsr #SndMsg
C Exsr #Exit
C EndIf
CSR ENDSR
*
* Send Message When Occurs Error
*
CSR #SndMsg BEGSR
C Call 'QMHSNDPM'
C Parm MsgID
C Parm MsgF
C Parm MsgDta
C Parm MsgLen
C Parm MsgTyp
C Parm MsgEnt
C Parm MsgCnt
C Parm MsgKey
C Parm MsgErr
CSR ENDSR
****************** End of data ********************************************
扫一扫
2128
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
