在COBOL程序中取得百万分之一秒精度时间(没有使用DB2的情况下)--转载

在COBOL程序中取得百万分之一秒精度时间(没有使用DB2的情况下)

在COBOL程序中通常要用的要精度计时,但是COBOL提供的时间精度最大也就百分之一秒

通过CALL下列程序就可以取得当前时间的TimeStamp(百万分之一秒)

 

********************************************************************** KDS08308

* * CREATED BY :KEVIN KANG                                                                                             * KDS08308

* * CREATED DATE :NOV 03, 2008                                                                                      * KDS08308

* * REMARK :GET MICROSECOND                                                                                        * KDS08308

* * COMPILE REQ :DEFAULT OPTION,NO SPECIAL COMPILE REQUIRMENT                          * KDS08308

* ********************************************************************* KDS08308

GETSTAMP CSECT                                                                                                                   KDS08308 ***********************************************************************KDS08308

         SAVE (14,12)                                                                                                                KDS08308

         BALR 12,0                                                                                                                     KDS08308

         USING *,12                                                                                                                   KDS08308

         ST 13,SAVE+4                                                                                                               KDS08308

         LA 13,SAVE                                                                                                                   KDS08308

         L 8,0(,1)                                                                                                                        KDS08308

GETRTN EQU *                                                                                                                       KDS08308

         STCK TODCLOCK                                                                                                           KDS08308

         STCKCONV STCKVAL=TODCLOCK,CONVVAL=OUTVAL,TIMETYPE=DEC,                        *KDS08308

         DATETYPE=YYYYMMDD                                                                                                   KDS08308

         MVC PWORK,PTIME                                                                                                       KDS08308

         MVC PWORK1,EDMSK2                                                                                                  KDS08308

         MVO PWORK(9),PWORK                                                                                                KDS08308

         MVC CTIME,EDMSK                                                                                                        KDS08308

         ED CTIME,PWORK                                                                                                          KDS08308

         MVC PWORK,PDATE                                                                                                       KDS08308

         MVC PWORK1,EDMSK2                                                                                                  KDS08308

         MVO PWORK(9),PWORK                                                                                                KDS08308

         MVC CDATE,EDMSK                                                                                                       KDS08308

         ED CDATE,PWORK                                                                                                         KDS08308

*       MVC OUTTIM(8),CDATE+2                                                                                              KDS08308

         MVC OUTTIM(4),CDATE+2                                                                                              KDS08308

         MVC OUTTIM+4(1),=C'-'                                                                                                 KDS08308

         MVC OUTTIM+5(2),CDATE+6                                                                                          KDS08308

         MVC OUTTIM+7(1),=C'-'                                                                                                 KDS08308

         MVC OUTTIM+8(2),CDATE+8                                                                                          KDS08308

         MVC OUTTIM+10(1),=C'-'                                                                                               KDS08308

         MVC OUTTIM+11(2),CTIME+2                                                                                        KDS08308

         MVC OUTTIM+13(1),=C'.'                                                                                               KDS08308

         MVC OUTTIM+14(2),CTIME+4                                                                                        KDS08308

         MVC OUTTIM+16(1),=C'.'                                                                                               KDS08308

         MVC OUTTIM+17(2),CTIME+6                                                                                        KDS08308

         MVC OUTTIM+19(1),=C'.'                                                                                               KDS08308

         MVC OUTTIM+20(6),CTIME+8                                                                                        KDS08308

*       MVC OUTTIM+8(12),CTIME+2                                                                                        KDS08308

         MVC 0(L'OUTTIM,8),OUTTIM                                                                                           KDS08308

         SR 15,15                                                                                                                        KDS08308

          L  13,SAVE+4                                                                                                                KDS08308

         RETURN (14,12),RC=0                                                                                                    KDS08308

*                                                                                                                                             KDS08308

*                                                                                                                                             KDS08308 *********************************************************************** KDS08308

*********************************************************************** KDS08308

SAVE DS 18F                                                                                                                           KDS08308

TODCLOCK DS XL8                                                                                                                  KDS08308

OUTVAL DS 0CL16                                                                                                                   KDS08308

PTIME DS PL8                                                                                                                          KDS08308

PDATE DS PL8                                                                                                                          KDS08308

PWORK DS PL8                                                                                                                        KDS08308

PWORK1 DS PL8                                                                                                                      KDS08308

CTIME DS CL14                                                                                                                        KDS08308

CDATE DS CL14                                                                                                                       KDS08308

OUTTIM DS CL32                                                                                                                      KDS08308

EDMSK DC X'F0212020202020202020202020202020'                                                            KDS08308

EDMSK2 DC X'0C000000'                                                                                                         KDS08308

*                                                                                                                                              KDS08308

END                                                                                                                                          KDS08308

 

编译JOB

 

//COM#ASM JOB (ACCTNUM,EXP),'COMP GETSTAMP ',

//       TIME=1440,

//       NOTIFY=&SYSUID,

//       CLASS=A,

//       MSGCLASS=X,

//       MSGLEVEL=(1,1)

//       PROCLIB JCLLIB ORDER=(SYS1.PROCLIB)

//*

//COMPILE EXEC ASMACL,COND=(8,LT)

 

//C.SYSIN DD DISP=SHR,DSN=IBMUSER.JCL.ASM(GETSTAMP)

//C.SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB

//       DD DISP=SHR,DSN=SYS1.MODGEN

//       DD DISP=SHR,DSN=IBMUSER.JCL.ASM

//L.SYSLMOD DD DISP=SHR,DSN=SYS1.PROG.LOAD.KANG

//L.SYSIN DD *

    NAME GETSTAMP(R)

/*

 

COBOL 程序CALL GETSTAMP 的例子

     IDENTIFICATION DIVISION.

     PROGRAM-ID. TIMESTAP.

     AUTHOR. KEVIN KANG

     ENVIRONMENT DIVISION.

     DATA DIVISION.

     WORKING-STORAGE SECTION.

     01 PASS-AREA.

        05 PASS-REQUEST PIC X(32).

     PROCEDURE DIVISION.

         DISPLAY 'TIMESTAP BEGIN'

         MOVE SPACE TO PASS-AREA

         CALL 'GETSTAMP' USING PASS-AREA.

         DISPLAY 'TIME STAMPE=' PASS-AREA

         CALL 'GETSTAMP' USING PASS-AREA.

         DISPLAY 'TIME STAMPE=' PASS-AREA

         DISPLAY 'TIMESTAP END '

         GOBACK.

 

CALL GETSTAMP返回的日期时间格式:

YYYY-MM-DD-HH.MM.SS.thmiju

HH is hours, based on a 24-hour clock

MM is minutes

SS is seconds

t is tenths of seconds

h is hundredths of seconds

m is milliseconds

i is ten-thousandths of seconds

j is hundred-thousandths of seconds

u is microseconds

如：2008-11-05-02.07.36.970541