85 lines
2.5 KiB
Plaintext
85 lines
2.5 KiB
Plaintext
|
********************************************************************************
|
||
|
|
*
|
||
|
|
* Support of subroutine '!SUBSTRINGSH'
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
* 05/15/97 20626 RJE Integrate subroutine into universe
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
SUBROUTINE SUBSTRINGSH(RSLT,STG,FRM,LGTH)
|
||
|
|
*************************************************************************
|
||
|
|
* Given DynArr of Strings, FromPos, Length, return DynArr of substrings
|
||
|
|
* for use by UniVerse Retrieve Processor
|
||
|
|
* Copyright (c) 1996 by DataWorks Corporation, "ALL RIGHTS RESERVED"
|
||
|
|
* REV: 09/19/96 MDB
|
||
|
|
*
|
||
|
|
RSLT=''
|
||
|
|
* Get 1st token from each of: string, from and length
|
||
|
|
GOSUB FIRSTS
|
||
|
|
GOSUB FIRSTF
|
||
|
|
GOSUB FIRSTL
|
||
|
|
EXIT.FLAG=0
|
||
|
|
LOOP UNTIL EXIT.FLAG DO
|
||
|
|
IF NOT(NUM(FRM.SEG)) THEN FRM.SEG=0
|
||
|
|
IF NOT(NUM(LGTH.SEG)) THEN LGTH.SEG=0
|
||
|
|
RSLT=RSLT:STG.SEG[FRM.SEG,LGTH.SEG]
|
||
|
|
!IF INDEX(@LOGNAME,'mikeb',1) THEN PRINT "+++":STG.SEG:"[":FRM.SEG:",":LGTH.SEG:"]=":STG.SEG[FRM.SEG,LGTH.SEG]:"<"
|
||
|
|
IF STG.DLM < 3 THEN EXIT.FLAG=1 ELSE
|
||
|
|
RSLT=RSLT:CHAR(256 - STG.DLM)
|
||
|
|
GOSUB NEXTS
|
||
|
|
GOSUB NEXTF
|
||
|
|
GOSUB NEXTL
|
||
|
|
END
|
||
|
|
REPEAT
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
FIRSTS:
|
||
|
|
REMOVE STG.SEG FROM STG SETTING STG.DLM
|
||
|
|
PR.STG.DLM=0; * Prior delim is EOS
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
FIRSTF:
|
||
|
|
REMOVE FRM.SEG FROM FRM SETTING FRM.DLM
|
||
|
|
IF FRM.DLM < 3 THEN PR.FRM.DLM=0 ELSE PR.FRM.DLM=STG.DLM
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
FIRSTL:
|
||
|
|
REMOVE LGTH.SEG FROM LGTH SETTING LGTH.DLM
|
||
|
|
IF LGTH.DLM < 3 THEN PR.LGTH.DLM=0 ELSE PR.LGTH.DLM=STG.DLM
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
NEXTS:
|
||
|
|
PR.STG.DLM=STG.DLM
|
||
|
|
REMOVE STG.SEG FROM STG SETTING STG.DLM
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
NEXTF:
|
||
|
|
IF FRM.DLM < PR.STG.DLM THEN RETURN
|
||
|
|
LOOP
|
||
|
|
PR.FRM.DLM=FRM.DLM
|
||
|
|
REMOVE FRM.SEG FROM FRM SETTING FRM.DLM
|
||
|
|
UNTIL PR.FRM.DLM <= PR.STG.DLM DO REPEAT
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
NEXTL:
|
||
|
|
IF LGTH.DLM < PR.STG.DLM THEN RETURN
|
||
|
|
LOOP
|
||
|
|
PR.LGTH.DLM=LGTH.DLM
|
||
|
|
REMOVE LGTH.SEG FROM LGTH SETTING LGTH.DLM
|
||
|
|
UNTIL PR.LGTH.DLM <= PR.STG.DLM DO REPEAT
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|