擷取系統時間至微秒單位(Get system timesatmp with a precision in microseconds by API QWCCVTDT)
範例含 CLP, RPGLE, COBOL。
File : QCLSRC
Member: GETSYSTIMC
Type : CLP
Usage : CRTCLPGM PGM(GETSYSTIMC)
PGM
/* For Convert Date & Time... */
dcl &CDT_I_FORM *char 10 value( '*CURRENT' )
dcl &CDT_I_VAR *char 8
dcl &CDT_O_FORM *char 10 value( '*YYMD' )
dcl &CDT_O_VAR *char 20
dcl &CDT_I_TZ *char 10 value( '*SYS' )
dcl &CDT_O_TZ *char 10 value( '*SYS' )
dcl &CDT_O_TZi *char 111 value( ' ' )
dcl &CDT_O_TZl *int value( 0 )
dcl &CDT_O_Pi *char 1 value( '1' )
/* And we'll need to specify an errcode receiver at one point... */
dcl &ERRCODE *char 116 value( x'00000074' )
dcl &ERRLEN *int value( 0 )
call QWCCVTDT ( +
&CDT_I_FORM +
&CDT_I_VAR +
&CDT_O_FORM +
&CDT_O_VAR +
&ERRCODE +
&CDT_I_TZ +
&CDT_O_TZ +
&CDT_O_TZi +
&CDT_O_TZl +
&CDT_O_Pi +
)
SndPgmMsg MsgId(CPF9898) MsgF(*LIBL/QCPFMSG) +
MsgDta(&CDT_O_VAR)
Return
ENDPGM
File : QRPGLESRC
Member: GETSYSTIMR
Type : RPGLE
Usage : CRTBNDRPG PGM(GETSYSTIMR)
**-- API error data structure:
D ERRC0100 Ds Qualified
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 128a
DOutputVar DS
D CurCentury 2
D CurYear 2
D CurMonth 2
D CurDay 2
D CurHour 2
D CurMinute 2
D CurSecond 2
D CurMicroSec 6
D TimeZoneInfL 10i 0
C Move *On *InLr
C Call 'QWCCVTDT'
C Parm '*CURRENT' InputFmt 10
C Parm InputVar 1
C Parm '*YYMD' OutputFmt 10
C Parm OutputVar
C Parm ERRC0100
C Parm InpTimeZone 10
C Parm '*SYS' OutTimeZone 10
C Parm TimeZineInf 1
C Parm 0 TimeZoneInfL
C Parm '1' PrcInd 1
C OutputVar dsply
File : QCBLLESRC
Member: GETSYSTIME
Type : COBOL
Usage : CRTCBLPGM PGM(GETSYSTIME)
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLE07.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DATES.
05 INPUT-DATE PIC X(10).
05 OUTPUT-DATE17 PIC X(17).
05 OUTPUT-DATE20 PIC X(20).
05 INPUT-DATE-FORMAT PIC X(10).
05 OUTPUT-DATE-FORMAT PIC X(10).
05 INPUT-TIME-ZONE PIC X(10) VALUE '*SYS'.
05 OUTPUT-TIME-ZONE PIC X(10) VALUE '*SYS'.
05 TIME-ZONE-INFO PIC X(10).
05 TIME-ZONE-INFO-LEN PIC S9(9) BINARY VALUE ZERO.
05 PRECISION-INDICATOR PIC X(01) VALUE '1'.
01 CURRENTTIME.
05 CUR-YEAR PIC X(04).
05 CUR-MONTH PIC X(02).
05 CUR-DAY PIC X(02).
05 CUR-HH PIC X(02).
05 CUR-MM PIC X(02).
05 CUR-SS PIC X(02).
05 CUR-MICROSECOND PIC X(06).
01 ERRPARM.
05 INPUT-L PIC S9(9) BINARY VALUE 116.
05 OUTPUT-L PIC S9(9) BINARY VALUE ZERO.
05 EXCEPTION-ID PIC X(7).
05 RESERVED PIC X(1).
05 EXCEPTION-DATA PIC X(100).
PROCEDURE DIVISION.
MAINLINE.
PERFORM GET-DATE-08
GOBACK.
GET-DATE-08.
MOVE SPACES TO EXCEPTION-ID.
MOVE "*CURRENT" TO INPUT-DATE-FORMAT.
MOVE "*YYMD " TO OUTPUT-DATE-FORMAT.
CALL "QWCCVTDT" USING INPUT-DATE-FORMAT ,
INPUT-DATE ,
OUTPUT-DATE-FORMAT,
CURRENTTIME ,
ERRPARM ,
INPUT-TIME-ZONE ,
OUTPUT-TIME-ZONE ,
TIME-ZONE-INFO ,
TIME-ZONE-INFO-LEN,
PRECISION-INDICATOR.
DISPLAY 'TIMESTAMP FROM COBOL: ' CURRENTTIME.
參照: Convert Date and Time Format (QWCCVTDT) API
星期四, 11月 09, 2023
2016-04-06 擷取系統時間至微秒單位(Get system timesatmp with a precision in microseconds by API QWCCVTDT)
星期三, 11月 08, 2023
2011-08-12 如何將 DTS 格式的時間 與 格式為 YYYYMMDD HHMISS sss 時間互為轉換？(MI MATTOD and Convert Date and Time Format QWCCVTDT API )
如何將 DTS 格式的時間 與 格式為 YYYYMMDD HHMISS sss 時間互為轉換？(MI MATTOD and Convert Date and Time Format QWCCVTDT API )
系統時間 DTS 格式常出現在 Journal 或 系統函數中，有時就有需要將 DTS 格式轉換為可讀取格式，
指令 CVSDTS(Convert DTS to Date/Time)，CVTTODTS((Convert Date/Time DTS) 如下：
File : QCLSRC
Member: CVTDTS
Type : CLP
Usage : CRTCLPGM CVTDTS
/* =============================================================== */
/* = Command CVTDTS CPP = */
/* = Program....... CvtDts = */
/* = Description... Convert DTS to Date/Time = */
/* =============================================================== */
/* = Date : 2011/07/28 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Pgm ( &Dts +
&RtnDate +
&RtnTime +
&RtnMillsec +
)
/*-- Parameters: ---------------------------------------------------*/
Dcl &Dts *Char 8
Dcl &RtnDate *Char 8
Dcl &RtnTime *Char 6
Dcl &RtnMillSec *Char 3
Dcl &OutDatTim *Char 20
/*-- Global error monitoring: --------------------------------------*/
MonMsg MCH3601
MonMsg CPF0000 *N GoTo Error
Call QWCCVTDT ( '*DTS' +
&Dts +
'*YYMD' +
&OutDatTim +
x'00000000' +
)
ChgVar &RtnDate %SST(&OutDatTim 1 8)
ChgVar &RtnTime %SST(&OutDatTim 9 6)
ChgVar &RtnMillSec %SST(&OutDatTim 15 3)
Return:
Return
/*-- Error processor ------------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCLSRC
Member: CVTTODTS
Type : CLP
Usage : CRTCLPGM CVTTODTS
/* =============================================================== */
/* = Command CVTTODTS CPP = */
/* = Program....... CvtToDts = */
/* = Description... Convert Date/Time to DTS = */
/* =============================================================== */
/* = Date : 2011/07/28 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Pgm ( &Date +
&Time +
&Millsec +
&RtnDts +
)
/*-- Parameters: ---------------------------------------------------*/
Dcl &Date *Char 8
Dcl &Time *Char 6
Dcl &MillSec *Char 3
Dcl &RtnDts *Char 8
Dcl &InpDatTim *Char 20
/*-- Global error monitoring: --------------------------------------*/
MonMsg CPF0000 *N GoTo Error
ChgVar %SST(&InpDatTim 1 8) &Date
ChgVar %SST(&InpDatTim 9 6) &Time
ChgVar %SST(&InpDatTim 15 3) &MillSec
ChgVar %SST(&InpDatTim 18 3) '000'
Call QWCCVTDT ( '*YYMD' +
&InpDatTim +
'*DTS' +
&RtnDts +
x'00000000' +
)
Return:
Return
/*-- Error processor ------------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: CVTDTS
Type : CMD
Usage : CRTCMD CMD(CVTDTS) PGM(CVTDTS) ALLOW(*IPGM *BPGM)
/* =============================================================== */
/* = Command....... CVTDTS = */
/* = CPP........... CVTDTS CLP = */
/* = Description... Convert DTS to date/time = */
/* = = */
/* = Compile options: = */
/* = = */
/* = CrtCmd Cmd( CVTDTS ) = */
/* = Pgm( CVTDTS ) = */
/* = SrcMbr( CVTDTS ) = */
/* = Allow( = */
/* = *IREXX = */
/* = *BREXX = */
/* = *BPGM = */
/* = *IPGM = */
/* = ) = */
/* =============================================================== */
/* = Date : 2011/07/14 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt( 'Convert DTS to Date/Time' )
Parm DTS *Char 8 +
Min( 1 ) +
Expr( *YES ) +
Prompt( 'DTS' )
Parm RTNDATE *Char 8 +
RTNVAL(*YES) +
Prompt( 'Return date format YYYYMMDD(8)')
Parm RTNTIME *Char 6 +
RTNVAL(*YES) +
Prompt( 'Return time format HHMMSS (6)')
Parm RTNMILLSEC *Char 3 +
RTNVAL(*YES) +
Prompt( 'Return millsec format sss (3)')
File : QCMDSRC
Member: CVTTODTS
Type : CMD
Usage : CRTCMD CMD(CVTTODTS) PGM(CVTTODTS) ALLOW(*IPGM *BPGM)
/* =============================================================== */
/* = Command....... CVTTODTS = */
/* = CPP........... CVTTODTS CLP = */
/* = Description... Convert date/time to DTS = */
/* = = */
/* = Compile options: = */
/* = = */
/* = CrtCmd Cmd( CVTTODTS ) = */
/* = Pgm( CVTTODTS ) = */
/* = SrcMbr( CVTTODTS ) = */
/* = Allow( = */
/* = *IREXX = */
/* = *BREXX = */
/* = *BPGM = */
/* = *IPGM = */
/* = ) = */
/* =============================================================== */
/* = Date : 2011/07/14 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt( 'Convert Date/time to DTS' )
Parm DATE *Char 8 +
Min( 1 ) +
Expr( *YES ) +
Prompt( 'The date format YYYYMMDD')
Parm TIME *Char 6 +
Min( 1 ) +
Expr( *YES ) +
Prompt( 'The time format HHMMSS')
Parm MILLSEC *Char 3 +
Dft( 000 ) +
Range('000' '999') +
Expr( *YES ) +
Prompt( 'The millsec format sss')
Parm DTS *Char 8 +
RTNVAL(*YES) +
Prompt( 'CL var for DTS (8)')
File : QCLSRC
Member: CVTDTST
Type : CCL
Usage : CRTCLPGM CVTDTST
CALL CVTDTST
PGM
/*-- Parameters: ---------------------------------------------------*/
Dcl &Dts *Char 8
Dcl &Dts2 *Char 8
Dcl &RtnDate *Char 8
Dcl &RtnTime *Char 6
Dcl &RtnMillSec *Char 3
Dcl &RtnDate2 *Char 8
Dcl &RtnTime2 *Char 6
Dcl &RtnMillSe2 *Char 3
Dcl &RtnDts *Char 8
Dcl &RtnDts2 *Char 8
callprc 'mattod' parm(&DTS)
CVTDTS DTS(&DTS) RTNDATE(&RTNDATE) +
RTNTIME(&RTNTIME) RTNMILLSEC(&RTNMILLSEC)
CVTTODTS DATE(&RTNDATE) TIME(&RTNTIME) +
MILLSEC(&RTNMILLSEC) DTS(&RTNDTS)
CVTDTS DTS(&RTNDTS) RTNDATE(&RTNDATE2) +
RTNTIME(&RTNTIME2) RTNMILLSEC(&RTNMILLSE2)
CVTTODTS DATE(&RTNDATE2) TIME(&RTNTIME2) +
MILLSEC(&RTNMILLSE2) DTS(&RTNDTS2)
DMPCLPGM
DSPSPLF FILE(QPPGMDMP) SPLNBR(*LAST)
ENDPGM
Convert Date and Time Format (QWCCVTDT) API
2011-07-19 如何取得含有 micro second 的系統時間 ？(MI MATTOD, API QWCCVTDT and Qp0zCvtToTimeval to get timestamp)
如何取得含有 micro second 的系統時間 ？(MI MATTOD, API QWCCVTDT and Qp0zCvtToTimeval to get timestamp)
File : QRPGLESRC
Member: MATTODR2
Type : RPGLE
Usage : CRTBNDRPG MATTODR2
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
H BNDDIR('QC2LE')
**-- Display long text: ------------------------------------------------**
D DspLngTxt Pr ExtPgm( 'QUILNGTX' )
D DtLngTxt 1024a Const Options( *VarSize )
D DtLngTxtLen 10i 0 Const
D DtMsgId 7a Const
D DtMsgF 20a Const
D DtError 10i 0 Const
D*-- GetErrNo ---- Get error number ----------------------------------
D* extern int * __errno(void);
D @__ERRNO PR * EXTPROC('__errno')
D
D*-- StrError ---- Get error text ------------------------------------
D* char *strerror(int errnum);
D STRERROR PR * EXTPROC('strerror')
D ERRNUM 10I 0 VALUE
D
D ERRNO PR 10I 0
**-- Convert date & time: ----------------------------------------------**
D CvtDtf Pr ExtPgm( 'QWCCVTDT' )
D CdInpFmt 10a Const
D CdInpVar 17a Const Options( *VarSize )
D CdOutFmt 10a Const
D CdOutVar 20a Options( *VarSize )
D CdError 10i 0 Const
**-- Qp0zCvtToTimeval()-Convert _MI_Time to Timeval Structure------------**
D DtsToTimeval Pr 10I 0 ExtProc( 'Qp0zCvtToTimeval' )
D toTimeVal * Value
D fromDts 8a Const
D option 10I 0 Value
D p_timeval S *
D timeval DS based(p_timeval)
D tv_sec 10I 0
D tv_usec 10I 0
D QP0Z_CVTTIME_TO_TIMESTAMP...
D C CONST(1)
D tv S *
D tvlen S 10I 0
D rc S 10I 0
D err S 10I 0
D DateOut s 20a Inz( *All'0' )
D MATTOD pr extproc('mattod')
D DTS 8a
D MsgTxt S 256
D DtsCur S 8
D tv_usec6 S 6 0
C Eval *InLr = *On
c eval tvlen = %size(timeval)
c alloc tvlen tv
c eval p_timeval = tv
* get System machine time
C callp MatTOD(DtsCur)
C CallP CvtDtf( '*DTS'
C : DtsCur
C : '*YYMD'
C : DateOut
C : 0
C )
C eval rc = DtsToTimeval (
C tv :
C DtsCur :
C QP0Z_CVTTIME_TO_TIMESTAMP
C )
C if rc < 0
C EVAL ERR = ERRNO
C Eval MsgTxt = 'error: ' + %CHAR(ERR) + ' ' +
C %STR(STRERROR(ERR))
C else
C eval tv_usec6 = tv_usec
C eval %SubSt(DateOut: 15) = %Char(tv_usec6)
C eval MsgTxt = 'Get current _MI_TIME with ' +
C 'MATTOD and converted with ' +
C 'Qp0zCvtToTimeval API -> ' +
C 'Current time is ' +
C DateOut +
C '. Timestamp is ' +
C %Char(tv_sec) + '.' +
C %Char(tv_usec6)
C endIf
**
C CallP(e) DspLngTxt( MsgTxt
C : %Len( MsgTxt )
C : *Blanks
C : *Blanks
C : *Zero
C )
P*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P* This procedure return call socket C API errno
P*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P ERRNO B
D ERRNO PI 10I 0
D P_ERRNO S *
D WWRETURN S 10I 0 BASED(P_ERRNO)
C EVAL P_ERRNO = @__ERRNO
C RETURN WWRETURN
P E
2011-03-22 如何取得系統 UTC 時間 (API CEEUTC, CEEDATM) ?
如何取得系統 UTC 時間 (API CEEUTC, CEEDATM) ?
File : QRPGLESRC
Member: RTVUTCR
Type : RPGLE
Usage : CRTBNDRPG RTVUTCR
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
** Convert to arbitrary timestamp API
d CEEDATM PR opdesc
d input_secs 8F const
d pic_string 26A const options(*varsize)
d output_ts 26A options(*varsize)
d feedback 12A options(*omit)
D CEEUTC PR
D output_lil 10I 0
D outptu_secs 8F
D feedback 12A options(*omit)
D
D lilian S 10I 0
D secs S 8F
D zchar S 23A based(pZ)
D pZ S *
D timestamp S Z
D utcString S 26
C callp ceeutc (lilian : secs : *omit)
C eval pZ = %addr(timestamp)
C callp ceedatm (secs :
C 'YYYY-MM-DD-HH.MI.SS.999' :
C zchar :
C *omit)
C* timestamp dsply
C zchar dsply
C return
星期一, 11月 06, 2023
2004-04-05 如何轉換美式日期 "March 18, 2004" 至 RPGLE 的 Date 格式？(API CEEDAYS CEEDATE)
如何轉換美式日期 "March 18, 2004" 至 RPGLE 的 Date 格式？(API CEEDAYS CEEDATE)
由於現有國際化的環境中，常會收到國外的資料，含有文字性敘述的日期形態，所以有此
轉換需求，要做日期格式間的轉換需要利用 API CEEDAYS, CEEDATE.
下述範例將 October 08, 2002 , October 8, 2002 , Oct 08, 2002 或Oct 8, 2002
轉換為 20002-10-08, 記住不管日期是 08 或 8 與月之間僅能有一個空白,
若是 October 8, 執行時就會錯誤，此範例所執行的最後一斷測試程式碼，就會錯誤，
請回 C (Cancel)。
File : QRPGLESRC
Member: CVTDATEFMT
Type : RPGLE
Usage : CRTBNDPGM CVTDATEFMT
CALL CVTDATEFMT
H DFTACTGRP(*NO)
*
* API to parse a character date into lilian format
*
D CEEDAYS PR opdesc
D char_date 80A const options(*varsize)
D date_format 80A const options(*varsize)
D lilian_date 10I 0
D feedback 12A options(*omit)
*
* API to create character date from lilian format
*
D CEEDATE PR opdesc
D lilian_date 10I 0 const
D date_format 80A const options(*varsize)
D char_date 80A options(*varsize)
D feedback 12A options(*omit)
D fmt1 c 'Mmmmmmmmmz ZD, YYYY'
D fmt2 c 'ZM/ZD/YYYY'
D iso c 'YYYYMMDD'
D mydate s 50A
D temp s 8A
D lil s 10I 0
D DateFld s D
** Test parsing date with a leading zero in the month.
** DateFld should result in 2002-10-08
**
c eval mydate = 'October 08, 2002'
c callp CEEDAYS(mydate: fmt1: lil: *omit)
c callp CEEDATE(lil: iso: temp: *omit)
c eval DateFld = %date(temp: *ISO0)
c dsply DateFld
**
** Same date without a leading zero.
**
c eval mydate = 'October 8, 2002'
c callp CEEDAYS(mydate: fmt1: lil: *omit)
c callp CEEDATE(lil: iso: temp: *omit)
c eval DateFld = %date(temp: *ISO0)
c dsply DateFld
**
** A different date with a shorter month name
**
c eval mydate = 'May 21, 1999'
c callp CEEDAYS(mydate: fmt1: lil: *omit)
c callp CEEDATE(lil: iso: temp: *omit)
c eval DateFld = %date(temp: *ISO0)
c dsply DateFld
**
** You can also go the other way, of course. This formats
** today's date nicely.
**
c eval temp = %char(%date(): *ISO0)
c callp CEEDAYS(temp: iso: lil: *omit)
c callp CEEDATE(lil: fmt1: mydate: *omit)
c dsply MyDate
**
** There's also the "slash date" format
**
c eval mydate = '01/01/2004'
c callp CEEDAYS(mydate: fmt2: lil: *omit)
c callp CEEDATE(lil: iso: temp: *omit)
c eval DateFld = %date(temp: *ISO0)
c dsply DateFld
**
** It also works without the leading zeroes
**
c eval mydate = '2/2/2004'
c callp CEEDAYS(mydate: fmt2: lil: *omit)
c callp CEEDATE(lil: iso: temp: *omit)
c eval DateFld = %date(temp: *ISO0)
c dsply DateFld
**
** This one, however, will fail...
** (it fails on the extra space before the 1)
**
c eval mydate = 'September 1, 2004'
c callp CEEDAYS(mydate: fmt1: lil: *omit)
c callp CEEDATE(lil: iso: temp: *omit)
c eval DateFld = %date(temp: *ISO0)
c dsply DateFld
c eval *inlr = *on
執行範例結果如下：
Display Program Messages
DSPLY 2002-10-08
*N
DSPLY 2002-10-08
*N
DSPLY 1999-05-21
*N
DSPLY April 5, 2004
*N
DSPLY 4/5/2004
*N
DSPLY 2004-01-01
*N
DSPLY 2004-02-02
*N
The call to CEEDAYS ended in error (C G D F).
Type reply, press Enter.
Reply . . .
F3=Exit F12=Cancel
訂閱：
文章 (Atom)