237 lines
6.8 KiB
Plaintext
237 lines
6.8 KiB
Plaintext
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Support the Ultimate get statement. This routine is called by
|
||
|
|
* calls inserted into user's code by the basic compiler.
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
* 01/24/96 17671 LAG Remove \ as quoted argument on Win9X and WINNT
|
||
|
|
* 08/11/92 9308 PVW Add check mode 1, if i=argnum-1 and userval#""
|
||
|
|
* 10/16/91 8698 DTM Correct \ as quoted argument
|
||
|
|
* 08/10/88 6710 JWT recognize quoted args
|
||
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
$OPTIONS DEFAULT
|
||
|
|
|
||
|
|
SUBROUTINE GET(rtncode, argnum, userval, mode )
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
|
||
|
|
|
||
|
|
*
|
||
|
|
* This routine will be called by code generated by the BASIC
|
||
|
|
* compiler. The variable 'rtncode' will be set to success ('1')
|
||
|
|
* or failure ('0'). The variable 'mode' tells the routine whether
|
||
|
|
* to
|
||
|
|
* 1) set up the initial argumnet string
|
||
|
|
* 2) return the next argument
|
||
|
|
* 3) set the remove pointer to a specific argument
|
||
|
|
|
||
|
|
EQU SUCCESS TO 1
|
||
|
|
EQU FAILURE TO 0
|
||
|
|
EQU INITTED TO @RECUR0
|
||
|
|
EQU UEOF TO @RECUR1
|
||
|
|
EQU UARGS TO @RECUR2
|
||
|
|
|
||
|
|
|
||
|
|
OPEN "","VOC" TO fv ELSE
|
||
|
|
PRINT "subroutine *GET is unable to OPEN your VOC"
|
||
|
|
STOP
|
||
|
|
END
|
||
|
|
|
||
|
|
BEGIN CASE
|
||
|
|
CASE mode = 0
|
||
|
|
* called to find the arguments and initialize uarg
|
||
|
|
IF INITTED = 0 THEN
|
||
|
|
INITTED = 1
|
||
|
|
tempsen = TRIMF(@SENTENCE)
|
||
|
|
temp = ""
|
||
|
|
LOOP
|
||
|
|
UNTIL tempsen = "" do
|
||
|
|
|
||
|
|
******************
|
||
|
|
** Windows NT port
|
||
|
|
**
|
||
|
|
IF OS.TYPE = "UNIX"
|
||
|
|
THEN
|
||
|
|
|
||
|
|
BEGIN CASE
|
||
|
|
|
||
|
|
CASE tempsen[1,1] = "'"
|
||
|
|
qpos = index(tempsen[2,999],"'",1)
|
||
|
|
if qpos = 0 then qpos = len(tempsen)+1
|
||
|
|
temp := tempsen[2,qpos-1]
|
||
|
|
tempsen = TRIMF(tempsen[qpos+2,999])
|
||
|
|
|
||
|
|
CASE tempsen[1,1] = "\"
|
||
|
|
qpos = index(tempsen[2,999],"\",1)
|
||
|
|
if qpos = 0 then qpos = len(tempsen)+1
|
||
|
|
temp := tempsen[2,qpos-1]
|
||
|
|
tempsen = TRIMF(tempsen[qpos+2,999])
|
||
|
|
|
||
|
|
CASE tempsen[1,1] = '"'
|
||
|
|
qpos = index(tempsen[2,999],'"',1)
|
||
|
|
if qpos = 0 then qpos = len(tempsen)+1
|
||
|
|
temp := tempsen[2,qpos-1]
|
||
|
|
tempsen = TRIMF(tempsen[qpos+2,999])
|
||
|
|
|
||
|
|
CASE 1
|
||
|
|
qpos = 1000
|
||
|
|
tpos = index(tempsen[1,999],"'",1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
tpos = index(tempsen[1,999],'"',1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
tpos = index(tempsen[1,999],"\",1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
tpos = index(tempsen[1,999]," ",1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
tpos = index(tempsen[1,999]," ",1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
temp := tempsen[1,qpos-1]
|
||
|
|
tempsen = TRIMF(tempsen[qpos,999])
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
BEGIN CASE
|
||
|
|
|
||
|
|
CASE tempsen[1,1] = "'"
|
||
|
|
qpos = index(tempsen[2,999],"'",1)
|
||
|
|
if qpos = 0 then qpos = len(tempsen)+1
|
||
|
|
temp := tempsen[2,qpos-1]
|
||
|
|
tempsen = TRIMF(tempsen[qpos+2,999])
|
||
|
|
|
||
|
|
CASE tempsen[1,1] = '"'
|
||
|
|
qpos = index(tempsen[2,999],'"',1)
|
||
|
|
if qpos = 0 then qpos = len(tempsen)+1
|
||
|
|
temp := tempsen[2,qpos-1]
|
||
|
|
tempsen = TRIMF(tempsen[qpos+2,999])
|
||
|
|
|
||
|
|
CASE 1
|
||
|
|
qpos = 1000
|
||
|
|
tpos = index(tempsen[1,999],"'",1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
tpos = index(tempsen[1,999],'"',1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
tpos = index(tempsen[1,999]," ",1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
tpos = index(tempsen[1,999]," ",1)
|
||
|
|
if tpos and tpos < qpos then qpos = tpos
|
||
|
|
temp := tempsen[1,qpos-1]
|
||
|
|
tempsen = TRIMF(tempsen[qpos,999])
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
END
|
||
|
|
**
|
||
|
|
******************
|
||
|
|
|
||
|
|
if tempsen # "" then temp := @FM
|
||
|
|
REPEAT
|
||
|
|
|
||
|
|
READV verbtype FROM fv,temp<1>,3 ELSE
|
||
|
|
verbtype = "B"
|
||
|
|
END
|
||
|
|
verbtype = UPCASE(verbtype[1,1])
|
||
|
|
argc = DCOUNT(temp,@FM)
|
||
|
|
IF verbtype = "I" THEN
|
||
|
|
* RUN command or synonym
|
||
|
|
IF argc < 4 THEN
|
||
|
|
* no arguments
|
||
|
|
UARGS = ""
|
||
|
|
UEOF = 1
|
||
|
|
rtncode = FAILURE
|
||
|
|
END ELSE
|
||
|
|
UARGS = FIELD(temp,@FM,4,999)
|
||
|
|
UEOF = 0
|
||
|
|
rtncode = SUCCESS
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
* CATALOGed program
|
||
|
|
UARGS = FIELD(temp,@FM,2,999)
|
||
|
|
UEOF = DCOUNT(UARGS,@FM) # 0
|
||
|
|
rtncode = SUCCESS
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
|
||
|
|
CASE mode = 1
|
||
|
|
* called to get next or specific argument
|
||
|
|
save = userval
|
||
|
|
IF argnum THEN
|
||
|
|
UARGS = UARGS ;* reset REMOVE pointer
|
||
|
|
UEOF = 0;
|
||
|
|
i = 0
|
||
|
|
LOOP
|
||
|
|
WHILE i < argnum
|
||
|
|
REMOVE userval FROM UARGS SETTING delim
|
||
|
|
if delim = 0 THEN UEOF = 1
|
||
|
|
UNTIL UEOF DO
|
||
|
|
i+=1
|
||
|
|
REPEAT
|
||
|
|
|
||
|
|
IF UEOF THEN
|
||
|
|
BEGIN CASE
|
||
|
|
CASE (i=argnum-1 AND userval#"")
|
||
|
|
rtncode = SUCCESS
|
||
|
|
CASE 1
|
||
|
|
rtncode = FAILURE
|
||
|
|
userval = save
|
||
|
|
END CASE
|
||
|
|
END ELSE
|
||
|
|
rtncode = SUCCESS
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
REMOVE userval FROM UARGS SETTING delim
|
||
|
|
if delim = 0 THEN UEOF = 1
|
||
|
|
IF userval # "" THEN
|
||
|
|
rtncode = SUCCESS
|
||
|
|
END ELSE
|
||
|
|
rtncode = FAILURE
|
||
|
|
userval = save
|
||
|
|
END
|
||
|
|
END
|
||
|
|
CASE mode = 2
|
||
|
|
* called to set the remove pointer to some value
|
||
|
|
IF argnum THEN
|
||
|
|
UARGS = UARGS ;* reset REMOVE pointer
|
||
|
|
UEOF = 0;
|
||
|
|
FOR i = 1 TO argnum-1 UNTIL UEOF
|
||
|
|
REMOVE dummy FROM UARGS SETTING delim
|
||
|
|
if delim = 0 THEN UEOF = 1
|
||
|
|
NEXT i
|
||
|
|
rtncode = NOT(UEOF)
|
||
|
|
END ELSE
|
||
|
|
IF UEOF THEN
|
||
|
|
rtncode = 0
|
||
|
|
END ELSE
|
||
|
|
REMOVE dummy FROM UARGS SETTING delim
|
||
|
|
if delim = 0 THEN UEOF = 1
|
||
|
|
rtncode = NOT(UEOF)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE mode = 3
|
||
|
|
rtncode = UEOF
|
||
|
|
|
||
|
|
CASE 1
|
||
|
|
rtncode = FAILURE
|
||
|
|
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
RETURN
|