subroutine U01B0( 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() * 1000),"MX") CASE What = "D" TimeDate = OCONV(DATE(),"MX") CASE What = "TD" TimeDate = OCONV((TIME() * 1000),"MX"):"\":OCONV(DATE(),"MX") 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 Dummy 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