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 KeyName Setll BCKLIB03P

C KeyName Reade BCKLIB03P

C Dow Not%Eof(BCKLIB03P)

C* save command always use SAV command.

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* SAVLIB LIB(JUNK) DEV(*SAVF) SAVF(JJFLIB/SAVF)

C Eval Device = 'DEV(' + %Trim(TAPEDRIVE)

C + %Trim(')')

C Eval EndOpt = %Trim('ENDOPT(')

C + %trim(ENDOFTAPE) + %Trim(')')

C* write record for start of backup - Start Date And Time

C If Not%Open(BCKLIB04P)

C Open BCKLIB04P

C Endif

C If Not%Eof(BCKLIB03P)

C Time SAVESTIME

C Time KeyTime

C Move *DATE SAVESDATE

C Move *DATE KeyDate

C Write BCK04R

C Endif

C If %Open(BCKLIB04P)

C Close BCKLIB04P

C Endif

C Eval CmdString = %Trim(SaveCmd) + %Trim('@@')

C + %Trim(OBJECT) + %Trim(')@')

C + %Trim(Device)+ %trim('@')+%Trim(EndOpt)

C + %Trim('@SAVACT(*LIB) ACCPTH(*YES)')

C '@':' ' Xlate CmdString CmdString

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm 256. CmdLength

C* write record for start of backup - End Date And Time - Total run

C Back04Key Klist

C Kfld LISTNAME

C Kfld OBJECT

C Kfld KeyDate

C Kfld KeyTime

C If Not%Open(BCKLIB04P)

C Open BCKLIB04P

C Endif

C Back04Key Chain BCKLIB04P

C If %Found(BCKLIB04P)

C Time SAVEETIME

C Move *DATE SAVEEDATE

C*DiffDays = %Diff(ToISO:FromISO:*DAYS)

C SAVEETIME Subdur SAVESTIME DiffSec:*S

C Eval RunHours = (DiffSec/3600)

C Eval RunMinutes = (DiffSec/60 - RunHours * 60)

C Eval RunSeconds = (DiffSec -((RunHours * 3600)+

C (RunMinutes * 60)))

C Exsr $LibInfo

C Update BCK04R

C Endif

C If %Open(BCKLIB04P)

C Close BCKLIB04P

C Endif

C KeyName Reade BCKLIB03P

C Enddo

C* if there is a program to run then run it.

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 Endsr

6.2 RPGLE的应用

6.2.1 SQLRPGLE 处理数据样例

FRUSF072A O A E K DISK

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 R072A

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

S3M13VR RPGLE SK-Mtn of Production Schedule (13V) <A Apr> Phu

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 4 in the option field and

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 R SFL1 SFL

A 74 SFLNXTCHG

A DBIDNM R H REFFLD(PFR/DBIDNM *LIBL/SFL001PF)

A OPTINO 1A B 10 3VALUES(‘ ‘ ‘2’ ‘4’ ‘5’)

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 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 7’LAST NAME’

A DSPATR(HI)

A 9 31’FIRST NAME’

* 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* Prototype

D RtvIPAdr PR 15

D DeviceNm 10 Value

*****************************************************************

* RtvIPAdR function

*****************************************************************

P RtvIPAdr B Export

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* Data structure for error info

D ErrorDS DS

D ErrLen 1 4B 0 Inz(15)

D ErrID 9 15

D* receiver field for IP address

D IPAddr S 15

C* Call the QDCRDEVD API

C Call 'QDCRDEVD'

C Parm Data

C Parm DataLen

C Parm DevType

C Parm DeviceNm

C Parm Err

C* Move error info into Data Structure

C Eval ErrorDS = Err

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* 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找到。

6.样例分析

6.1用QCMDEXC备份LIBRARYS到一个FILE的子例程

6.2 RPGLE的应用

6.2.1 SQLRPGLE 处理数据样例

Subfile program and Data queue

6.3 API应用

6.3.1 用API获取工作站的IP地址（QDCRDEVD）