6.1用QCMDEXC备份LIBRARYS到一个FILE的子例程
6.3.1 用API获取工作站的IP地址（QDCRDEVD）
6.样例分析
6.1用QCMDEXC备份LIBRARYS到一个FILE的子例程
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
6.2
RPGLE的应用
6.2.1
SQLRPGLE 处理数据样例
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
File . . . . . . QRPGLESRC
Library . . . . SRCA
Position to . . . . .
Type
options, press Enter.
2=Edit
3=Copy 4=Delete
5=Display
6=Print
7=Rename
8=Display description 9=Save 13=Change text 14=Compile 15=Create module..
Opt Member Type
Text
S3I13VR2 RPGLE SK-Inq of Prod. Schedule (13V DVLP) <A Apr> Phu
S
S3R13VR2 RPGLE
SK-Production Schedule (13V) (Developing) KHu
TAADBFCR RPGLE Create
print pgm - Call by TAADBFCC2
TAADBFCR2 RPGLE Display DB
def - Call by TAADBFCC4
TAADBFCR3 RPGLE PRTDBF
command 1st of 3 source skel
TAADBFCR4 RPGLE PRTDBF
command 2nd of 3 source skel
TAARPGAR RPGLE Binary
search in RPG sample - Call by TAARPGAC
More...
Parameters
or command
===>
F3=Exit
F4=Prompt
F5=Refresh
F6=Create
F9=Retrieve F10=Command
entry F23=More
options
F24=More keys
当然，如果你除了会用RPGLE,还对UIM很熟悉的话，PDM这样的功能是很容易实现的。但是，如果我们不知道UIM呢？（呵呵，至少我目前为止还没学过任何UIM的用法，只看到过一些样例代码。似乎很伤脑筋的说。）没问题，我们先了解一下data queue，利用它和subfile的完美结合，我们也能实现PDM的所有灵活特性。
关于DATA QUEUE
Data
queues 是as/400系统的一种对象类型（*DTAQ），你可以用OS/400的命令和API来创建维护。这种类型的对象用来发送接收多个记录，就像数据组成的字符串一样。Data
queue中的数据可以被多个程序，用户或工作来发送和接收，这中机制对数据共享很有用，因为它比数据库文件（database fiels），消息队列(message queues)或者data area占用的系统资源都要少，因此可以做为两个job间的非同步通信的一种方法。Data queues可以将没个发送数据者的标识（sender ID）一起保存在其中。发送数据者标识是当data
queue被创建的时候的一个属性，其中包含了该job的名字和当前用户描述文档信息。Data queue的另外一个好处是可以设置一个job从中读写数据的等待时间。等待时间可以设置成0~99，999，单位为秒。如果该参数设置为负数就表示这个job会无限制的等待完成一次数据传送才会继续下一步的操作。
HLL(High-level language)程序可以使用QSNDDTAQ和QRCVDTAQ来发送和接收数据。从data
queue读入数据的顺序可以是先入先出 FIFO,或者后入先出 LIFO，或者按照关键字段的索引顺序（keyed data queue）。要建立起PDM的subfile应用，就需要使用按照关键字段的索引顺序(keyed data queue),这样就允许程序从data
queue读出指定的某次特定的数据输入。比如我们可以从data queue中读取等于，或大于，或大于等于某个关键字段值的某次数据输入。
Subfile program
and Data queue
联合data queue 和subfile的功能，可以为用户提供最有效灵活的解决方法。
本例中使用a page-at-time来调用subfile,即：sflpag=sflsiz，这样，用户最后光标定位的地方就可以作为下一个页面的开始（move
by cursor position）,就像我们用SEU的时候，shift+f1,在下面的参数
Amount to roll . . . . . . . . . . . C
H=Half, F=Full
C=Cursor, D=Data
1-999
填入C的时候所达到的效果。
我们还希望用户在每个页面做的改动都被记录下来，直到按下ENTER键，再调用相关处理过程。使用data queue,能比data structure,files,arrays提供更多的灵活应用。交互式的作业中，data queue API的响应时间更快，占用的系统资源也更少，提高程序的性能。当你使用QRCVDTAQ命令接收数据的同时，这些数据也被从data
queue中自动删除。
程序代码分析
CL: 一般程序被调用的时候，都会先删除掉data queue,然后重新创建一个，即使你是创建在qtemp里面。首先，删掉data
queue是为了防止多次调用程序，data queue的容量变大，占用空间。在qtemp中创建，可以使得各个job的用户操作信息独立分开。当然如果你要开发以一个job间通信的应用，就是另外一回事了。
/*============================================================*/
/* To compile: */
/* */
/* CRTCLPGM PGM(XXX/SFL011CL)
SRCFILE(XXX/QCLLESRC) */
/* */
/*============================================================*/
PGM
DLTDTAQ DTAQ(QTEMP/SFL011DQ)
MONMSG MSGID(CPF2105)
CRTDTAQ DTAQ(QTEMP/SFL011DQ)
MAXLEN(256) SEQ(*KEYED) +
KEYLEN(7)
CALL PGM(*LIBL/SFL011RG)
ENDPGM
DDS:
只需要指定SFLPAG的值和SFLSIZ一样就可以了。每次写入到SFL的RECORD数不超过SFLPAG.
RPGLE:
* * Load
data to subfile * C
do sflpag C
read
sfl001lf
90 C
if *in90 C
leave C
endif * C
eval option = *blanks C
exsr rcvque C
eval rrnl = rrnl + 1 C
if rrnl = 1 C
eval savlnan = dblnam C
eval savfnan = dbfnam C
endif C
write sfl1 C
eval *in74 = *off C
enddo
Figure 7.2: Loading the subfile with one page of records.
注意每次从数据文当中读取数据之前，都会执行一次RCVQUE子程序。画面初始载入的过程中，这个子程序做不了什么事情，但是，之后，用户改变Subfile的记录，并且按下pagedown/pageup做更多改动的时候，它就变得很重要了。因为我们想要在用户第二次回到一个画面的时候，用户值前在该画面上的改动依然能体现出来。ADDQUE子程序是当用户执行任何有效的功能键的时候，记录下用户在subfile上对记录做的修改，利用QSNDDTAQ将他们写入到data
queue中。
Figure 7.3: Each time a valid function key, other than F3 or F12, is
pressed, the changed records are added to the data
queue.
Table 7.1 显示了0QSNDDTAQ
的参数列表
Figure 7.4 显示了当用户在某个subfile记录前面输入选项4，然后又按下了pagedown的时候写入到data queue的内容
包括选祥（4），DBIDNM的值（它是数据库文件的关键字，也是DATA
QUEUE的关键字），以及一个subfile的隐含栏位。
Figure 7.4: The contents of the data queue
after the user places a
presses the page-down key.
ADDQUE子程序跟踪所有subfile中更该过的记录。例如：用户在当前画面上的某个记录前面输入4准备要删除它，同时还想删除下个画面上的两笔记录。这样，在显示给用户下一个画面之前，ADDQUE把画面的操作信息写入data
queue,在用户在这两个画面上共选定了3笔记录之后，按下enter键，这时候，data queue中共用三笔输入。同样，当用户要定位到subfile的某一笔记录的时候，也会在data queue中写入用户操作的信息。
Figure 7.5: This routine writes the
changed records to the data queue.
现在让我们看看RCVQUE的详细内容。.
Figure 7.6: This routine removes entries
from the data queue.
Figure 7.6: This routine removes entries
from the data queue (continued).
该子程序用QRCVDTAQ从数据库文件读取的关键字DBIDNM从data
queue中获得一笔输入的信息。逻辑关系设置为“相等”（EQ）。然后，设置指示器*IN74（SFLNXTCHG）状态位‘1’，当subfile被写入记录的时候，标识该画面为“已更改”。下一次该页面显示的时候就可以用READC来找到对应用户用过操作的记录了。
Table 7.2 显示了QRCVDTAQ的参数列表
图7.7 显示了RCVQUE子程序中调用 API QRCVDTAQ 的应用。
该API一直运行到变量LEN=0,这个时候表示data queue中所有存储的数据信息都已经被读出来了。
完成的源代码：
SFL011CL: CL
Program to Create the Temporary Data Queue
/*============================================================*/
/* To compile: */
/* */
/* CRTCLPGM PGM(XXX/SFL011CL)
SRCFILE(XXX/QCLLESRC) */
/* */
/*============================================================*/
PGM
DLTDTAQ DTAQ(QTEMP/SFL011DQ)
MONMSG MSGID(CPF2105)
CRTDTAQ DTAQ(QTEMP/SFL011DQ)
MAXLEN(256) SEQ(*KEYED) +
KEYLEN(7)
CALL PGM(*LIBL/SFL011RG)
ENDPGM
SFL011DF: DDS
Using the Data Queue Technique
A
DSPSIZ(24 80 *DS3)
A
PRINT
A ERRSFL
A CA03
A CA12
A*
A
R SFL1 SFL
A*
A 74
SFLNXTCHG
A
DBIDNM R
H
REFFLD(PFR/DBIDNM *LIBL/SFL001PF)
A
OPTINO
A
DBLNAM R O
10 7REFFLD(PFR/DBLNAM
*LIBL/SFL001PF)
A
DBFNAM R O
10 31REFFLD(PFR/DBFNAM
*LIBL/SFL001PF)
A
DBMINI
R
O 10 55REFFLD(PFR/DBMINI *LIBL/SFL001PF)
A
DBNNAM R O
10 60REFFLD(PFR/DBNNAM
*LIBL/SFL001PF)
A
R SF1CTL
SFLCTL(SFL1)
A*
A
CF06
A
SFLSIZ(0012)
A
SFLPAG(0012)
A
ROLLUP
A
ROLLDOWN
A
OVERLAY
A N32
SFLDSP
A N31
SFLDSPCTL
A 31
SFLCLR
A 90
SFLEND(*MORE)
A
RRN1 45
OH
SFLRCDNBR
A
9
A
DSPATR(HI)
A
9
*
* To compile:
*
* CRTRPGPGM PGM(XXX/SFL011RG)
SRCFILE(XXX/QRPGLESRC)
*
*=======================================================================
6.3
API应用
关于API的应用，www.code400.com上面有很多例子。具体的链接地址是：http://www.code400.com/viewsamples.php?lang_id=10
6.3.1 用API获取工作站的IP地址（QDCRDEVD）
sample program: RTVIPADR
H NOMAIN
*****************************************************************
* RTVIPADR -
Retrieve the IP address of a display device
*
* Uses QDCRDEVD
API
*
*****************************************************************
D
D* Prototype
D RtvIPAdr
PR
15
D DeviceNm
10 Value
D
*****************************************************************
* RtvIPAdR function
*****************************************************************
P RtvIPAdr
B
Export
D
D RtvIPAdr PI
15
D DeviceNm
10 Value
D* Declare variables
for calling QDCRDEVD API
D Err
S
15
D DevType
S
8 Inz('DEVD0600')
D DataLen
S
4B 0 Inz(971)
D Data
S
971
D
D* Data structure for
error info
D ErrorDS
DS
D ErrLen
1 4B
0 Inz(15)
D ErrID
9 15
D
D* receiver field for
IP address
D IPAddr
S
15
D
C* Call the QDCRDEVD
API
C
Call
'QDCRDEVD'
C
Parm
Data
C
Parm
DataLen
C
Parm
DevType
C
Parm
DeviceNm
C
Parm
Err
C
C* Move error info
into Data Structure
C
Eval ErrorDS = Err
C
C* If error found then
return "ERROR" otherwise return IP address
C
If
ErrID <> *blanks
C
Eval IPAddr = 'ERROR'
C
Else
C* Pull out the IP
address
C
Eval IPAddr = %subst(Data:878:15)
C
Endif
C
C* Return the IP
address to the calling pgm
C
Return IPAddr
P
E
它可以用来获得任何网络设备的IP地址。该例中只用来获得一个工作站的IP.
使用QDCRDEVD API的时候我们要注意到它的几个限制：
1.设备名必须都是大写(QPADEV0001, 而不是
qapdev0001).如果你传递的参数是小写，它会返回一个错误。
2.如果设备是通过pass-through (STRPASTHR)方式连接的，QDCRDEVD就不适用了。3.它也不能用于只调用RPG/CL的PC工作。
更多关于QDCRDEVD的信息可以在IBM information centre找到。