6.1用QCMDEXC备份LIBRARYS到一个FILE的子例程
6.3.1 用API获取工作站的IP地址（QDCRDEVD）
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C* $Backup - Backup
the libraries/files from the system
C* SAVLIB LIB(LIBRARY) DEV(&DEVICE) ENDOPT(&REWIND)
C* SAVF(&SAVFLIB/&SAVF)
SAVACT(*LIB) ACCPTH(*YES)
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $Backup Begsr
C*
C KeyName Setll BCKLIB03P
C KeyName Reade BCKLIB03P
C
Dow
Not%Eof(BCKLIB03P)
C*
C* save command always
use SAV command.
C*
C
Select
C
When
TYPE = '*LIB'
C
Eval SaveCmd = 'SAVLIB LIB('
C
When
TYPE = '*FIL'
C
Eval SaveCmd = 'SAVOBJ OBJ('
C
When
TYPE = '*DOC'
C
Eval SaveCmd = 'SAV'
C
Endsl
C*
C* SAVLIB LIB(JUNK) DEV(*SAVF) SAVF(JJFLIB/SAVF)
C*
C
Eval Device = 'DEV(' +
%Trim(TAPEDRIVE)
C
+ %Trim(')')
C
Eval EndOpt = %Trim('ENDOPT(')
C
+ %trim(ENDOFTAPE) + %Trim(')')
C*
C* write record for start of backup -
Start Date And Time
C*
C
If
Not%Open(BCKLIB04P)
C
Open
BCKLIB04P
C
Endif
C*
C
If
Not%Eof(BCKLIB03P)
C*
C
Time
SAVESTIME
C
Time
KeyTime
C
Move
*DATE
SAVESDATE
C
Move
*DATE
KeyDate
C
Write
BCK04R
C*
C
Endif
C*
C
If
%Open(BCKLIB04P)
C
Close
BCKLIB04P
C
Endif
C*
C
Eval CmdString = %Trim(SaveCmd) + %Trim('@@')
C
+ %Trim(OBJECT) + %Trim(')@')
C
+ %Trim(Device)+ %trim('@')+%Trim(EndOpt)
C
+ %Trim('@SAVACT(*LIB) ACCPTH(*YES)')
C*
C '@':' ' Xlate CmdString CmdString
C
Call
'QCMDEXC'
99
C
Parm
CmdString
C
Parm 256.
CmdLength
C*
C* write record for start of backup -
End Date And Time - Total run
C*
C Back04Key Klist
C
Kfld
LISTNAME
C
Kfld
OBJECT
C Kfld
KeyDate
C
Kfld
KeyTime
C*
C
If
Not%Open(BCKLIB04P)
C
Open
BCKLIB04P
C
Endif
C*
C Back04Key Chain BCKLIB04P
C
If
%Found(BCKLIB04P)
C
Time
SAVEETIME
C
Move
*DATE
SAVEEDATE
C*
C*DiffDays
= %Diff(ToISO:FromISO:*DAYS)
C*
C SAVEETIME Subdur SAVESTIME DiffSec:*S
C*
C
Eval RunHours
= (DiffSec/3600)
C
Eval RunMinutes = (DiffSec/60 - RunHours
* 60)
C
Eval RunSeconds
= (DiffSec -((RunHours * 3600)+
C
(RunMinutes * 60)))
C*
C
Exsr $LibInfo
C*
C
Update BCK04R
C
Endif
C*
C
If
%Open(BCKLIB04P)
C
Close
BCKLIB04P
C
Endif
C*
C KeyName Reade BCKLIB03P
C
Enddo
C*
C* if there is a program to run then
run it.
C*
C
If
ENDPGM <> *Blanks
C
Eval CmdString = 'CALL@@' + %Trim(ENDPGMLIB)
C
+ %Trim('/') + %Trim(ENDPGM)
C '@':' ' Xlate CmdString CmdString
C
Call
'QCMDEXC'
99
C
Parm
CmdString
C
Parm 256.
CmdLength
C
Endif
C*
C
Endsr
FRUSF
D PRMDTA
DS
D @PRDG1
1 5
D @PRDG2
6 10
D @LOW_MI_DSM
11 13
D @HIGH_MI_DSM
14 16
D @PRIME1
17 22
D @PRIME2
23 28
D @PRIME3
29 34
D @PRIME4
35 40
D @THANDLER
41 41
D @TMREP1
42 44
D @TMREP2
45 47
D SRLDA
E DS
EXTNAME(SRDLDA)
D XXFDAT
6 0
OVERLAY(LDUSR1:16)
D XXTDAT
6 0
OVERLAY(LDUSR1:22)
D
SDS
D PGMNAME
1 10
DINVDETL E
DS
EXTNAME(SROISDPL)
D ISO
S
D
D @FDATE
S
8 0
D @TDATE
S
8 0
C
EXSR
SQLOPEN
C EXSR GETDETAIL
C
EXSR
SQLCLOSE
C
MOVE
*ON
*INLR
C/EJECT
C GETDETAIL BEGSR
* Read selected
invoice detail records
C
EXSR
GET
C SQLCOD
DOWEQ 0
C
IF
IDAMOU <> 0
C
CLEAR
TYPE
C
SELECT
C
WHEN
IDCCA1 = @PRIME1 OR IDCCA1 = @PRIME2 OR
C
IDCCA1 = @PRIME3 OR IDCCA1 = @PRIME4
C
EVAL
TYPE = '2'
C
WHEN
%SUBST(IDHAND:1:1) <> @THANDLER AND
C
IDSALE >= @LOW_MI_DSM AND
C
%SUBST(IDSALE:1:1) <> %SUBST(@TMREP1:1:1)
C
EVAL
TYPE = '3'
C
WHEN
%SUBST(IDHAND:1:1) = @THANDLER AND
C
IDSALE >= @LOW_MI_DSM AND
C
%SUBST(IDSALE:1:1) <> %SUBST(@TMREP1:1:1)
C
EVAL
TYPE = '4'
C
WHEN
%SUBST(IDHAND:1:1) = @THANDLER AND
C
IDSALE >= @TMREP1 AND IDSALE <= @TMREP2
C
EVAL
TYPE = '5'
C
ENDSL
* Reverse credit
memo amount
C
IF
IDTYPP = 2
C
EVAL
IDQTY =
IDQTY * -1
C
EVAL
IDAMOU = IDAMOU * -1
C
END
C
WRITE R
C
ENDIF
C
EXSR
GET
C
ENDDO
C
ENDSR
C/EJECT
C *INZSR
BEGSR
C *DTAARA
DEFINE *LDA
SRLDA
C
IN
SRLDA
* Convert
entered date range to CCYYMMD and report headings
C *MDY
MOVE
XXFDAT ISO
C
MOVE ISO
@FDATE
C *MDY
MOVE
XXTDAT ISO
C
MOVE
ISO
@TDATE
C KEY
KLIST
C
KFLD
PRMTYP
C
KFLD
PSARCH
C
EVAL
PRMTYP = 'RPGPGM'
C
EVAL
PSARCH = PGMNAME
* Get parameter
definition record
C KEY
CHAIN
XABCTLPM
C
ENDSR
C/EJECT
C SQLOPEN BEGSR
* Execute SQL
prepare and open statement
C/EXEC SQL
C+ DECLARE A CURSOR
FOR
C+ SELECT *
C+ FROM SR3ISD
C+ WHERE IDIDAT BETWEEN :@FDATE AND
:@TDATE AND
C+ IDPGRP
BETWEEN :@PRDG1 AND :@PRDG2 AND
C+
IDSALE <= :@HIGH_MI_DSM
AND
C+
IDFOCC <> 'Y'
C/END-EXEC
C/EXEC SQL
C+ OPEN A
C/END-EXEC
C
ENDSR
C/EJECT
C GET
BEGSR
* Get invoice
detail records using dealer cursor
C/EXEC SQL
C+ FETCH A INTO
:INVDETL
C/END-EXEC
C
ENDSR
C/EJECT
C SQLCLOSE BEGSR
* Execute close
of cursor
C/EXEC SQL
C+ CLOSE A
C/END-EXEC
C
ENDSR
C/EJECT
1．2 SUBFILES
AND DATA QUEUES
—A PERFECT COMBINATION
* 该部分的内容来自一份不完整的PDF英文文档，关于data queue和subfile结合的应用挺少见的，不过我觉得很实在（因为前段时间刚好遇到这样的情况，用data queue结合subfile可以很容易帮我解决问题）。尤其是有时候为了提高程序的速度，使用 a page-at-time的用法，处理用户pagesown/up的操作会非常简单。例子中只是为了用data queue存储用户的操作信息，画面的records都是直接从data
file读取。个人认为，这样用有点小题大做了，但是，如果实际的运用中，一个画面上的数据不能直接从数据库文件中读取，而是要经过大量的数据处理的时候，可以用data
queue存储整个画面的信息。Pageup的处理就变得非常简单了。
下面的例子中介绍了一种类似AS/400上的PDM工具的subfile的应用。用过PDM工具之后，你会觉得它是一个非常酷的Subfile应用，非常灵活。你可以把光标定位在subfile画面的任何位置,以这个位置的数据做为一个起点上下翻页，在任何页面的subfile上更改栏位值，在按下enter键的时候，所有用户做过的改动都将被处理。每个特性都可以简单的通过rpg的subfile应用来实现。但只有将他们都联合起来应用才会如此灵活。
下面是典型的PDM画面
Work with Members Using PDM
&nb