返回总目录   CU网友原创,转载请注明出处ChinaUnix.net及作者

返回总目录

 

6     样例分析-- 26

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

6.2             RPGLE的应用... 26

6.2.1       SQLRPGLE 处理数据样例-- 26

6.3             API应用... 26

6.3.1       API获取工作站的IP地址(QDCRDEVD-- 26

6.样例分析

6.1QCMDEXC备份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 处理数据样例
 

   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键的时候,所有用户做过的改动都将被处理。每个特性都可以简单的通过rpgsubfile应用来实现。但只有将他们都联合起来应用才会如此灵活。

    下面是典型的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*

 A           R SFL1                           SFL

 A*

 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*

 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

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