134 lines
3.7 KiB
Plaintext
Executable File
134 lines
3.7 KiB
Plaintext
Executable File
subroutine U11B0( proc, ibn, pib, sib, ip, obn, pob, sob )
|
|
*******************************************************************************
|
|
*
|
|
* Return date and/or time to a ProVerb
|
|
*
|
|
* Module %M% Version %I% Date %H%
|
|
*
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
|
* The copyright notice above does not evidence any actual or intended
|
|
* publication of such source code.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* Maintenence log - insert most recent change descriptions at top
|
|
*
|
|
* Date.... GTAR# WHO Description.........................................
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 11/21/94 15189 GMH Add READU
|
|
* 01/14/91 7930 JWT Added new Ucode for Siemens/Nixdorf
|
|
* 24/10/89 BHX creation of the source
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* This "user-exit", called from a ProVerb, returns the date and/or time
|
|
* of the systeme
|
|
*
|
|
* Usage:
|
|
* U11B0
|
|
* What Target
|
|
* error return
|
|
* success return
|
|
*
|
|
* Where "What" can be:
|
|
* T - Time of the system
|
|
* U01B0 : in milliseconds since midnight
|
|
* U11B0 : in form hh:mm:ss
|
|
* U31B0 : like U01B0 in hexadecimal
|
|
* D - Date of the system
|
|
* U01B0 : in number of days since 31 DEC 1967
|
|
* U11B0 : in form dd mmm aa
|
|
* U31B0 : like U01B0 in hexadecimal
|
|
* TD - time and date of the system
|
|
* U01B0 : the 2 results are separated by '\'
|
|
* U11B0 : the 2 results are separated by 2 blanks
|
|
* U31B0 : the 2 results are separated by '\'
|
|
*
|
|
* Where "Target" can be:
|
|
* T - terminal
|
|
* S - Current output buffer
|
|
* P - Primary input buffer
|
|
* WIdArt - write in private file "nnP", where nn is the user #,
|
|
* item named IdArt.
|
|
*
|
|
* Arguments to this subroutine are:
|
|
* proc - the text of the proc itself
|
|
* ibn - the current input buffer number (0 = primary;
|
|
* 1 = secondary)
|
|
* pib - the primary input buffer
|
|
* sib - the secondary input buffer
|
|
* ip - the input buffer pointer (character count)
|
|
* obn - the current output buffer number (0 = primary;
|
|
* 1 = secondary)
|
|
* pob - the primary output buffer
|
|
* sob - the secondary output buffer
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
CR = 1
|
|
|
|
DIM Words( 10 )
|
|
REMOVE Line FROM proc SETTING x
|
|
Line = TRIM( Line )
|
|
MATPARSE Words FROM Line," "
|
|
What = Words(1)
|
|
Target = Words(2)
|
|
|
|
BEGIN CASE
|
|
CASE What = "T"
|
|
TimeDate = OCONV(TIME(),"MTS")
|
|
CASE What = "D"
|
|
TimeDate = OCONV(DATE(),"D2/")
|
|
CASE What = "TD"
|
|
TimeDate = OCONV(TIME(),"MTS"):" ": OCONV(DATE(),"D2/")
|
|
CASE 1
|
|
ERRMSG 270
|
|
CR = 0
|
|
END CASE
|
|
|
|
IF CR = 0 THEN RETURN
|
|
|
|
BEGIN CASE
|
|
CASE Target = "T"
|
|
PRINT TimeDate
|
|
CASE Target = "S"
|
|
IF ( obn ) THEN
|
|
sob := TimeDate
|
|
END ELSE
|
|
pob := TimeDate
|
|
END
|
|
CASE Target = "P"
|
|
IF ip = LEN(pib) THEN
|
|
pib := TimeDate
|
|
END ELSE
|
|
IF pib[ip,1] = @AM THEN ip += 1
|
|
first.part = pib[1,ip-1]:TimeDate:@AM
|
|
last.part = pib[ip+1,LEN(pib)]
|
|
DEL last.part<1>
|
|
pib = first.part:last.part
|
|
END
|
|
CASE Target[1,1] = "W"
|
|
IdArt = Target[2,LEN(Target)-1]
|
|
OPEN @USER.NO:"P" TO IdFicnnP ELSE
|
|
ERRMSG 201,@USER.NO:"P"
|
|
CR = 0
|
|
END
|
|
IF CR THEN
|
|
READU Duummy FROM IdFicnnP,IdArt ELSE NULL
|
|
WRITE TimeDate ON IdFicnnP,IdArt ELSE
|
|
ERRMSG 202,IdArt
|
|
CR = 0
|
|
END
|
|
END
|
|
CASE 1
|
|
ERRMSG 270
|
|
CR = 0
|
|
END CASE
|
|
|
|
* If no error, we must remove the error return line from the proc.
|
|
IF CR THEN REMOVE Line FROM proc SETTING x
|
|
RETURN
|
|
|
|
END
|