Better Split Command

[Gregery D Engle]

I was wondering if anyone has made a better split command (like the VB6 one and the one that Dave Made in the source code fourm) the way the split command works now is:
lets assume input$ ="<G>EXAMPLE</g><G>hi</g>"

then with the original split command that VB6 uses:

buffer()=split(input$,"<G>")
------------
buffer(0) would equal : EXAMPLE</g>
buffer(1) would equal : hi</g>

What I think a better split command would be:
-----------------------------------------------------
buffer()=split(input$, "<G>", </g&gt
-----------------------------------------------------

buffer(0) would equal : EXAMPLE
buffer(1) would equal : hi

I think this type of function would be very useful has anyone made a function like this? If so would they be willing to share it?

Thanks in advance

-------------
-Greg

[Dave Stanton]

This is a routine I use in PB3.5
Hope this helps
Dave

SUB Somestringtoarray(T$,A$(1),Delim$,Flag?)
'Flag?:- 0=No blank strings ; 1=Include blanks
LOCAL Q$,S$,Q??,Q1??,Text$(),Dl?
DIM Text$(1:1000)
S$=T$
Dl?=LEN(Delim$)
Q??=0
DO UNTIL LEN(S$)=0
Q1??=INSTR(S$,Delim$)
IF Q1??>0 THEN
Q$=LEFT$(S$,Q1??-1)
S$=MID$(S$,Q1??+Dl?)
ELSE
Q$=S$
S$=""
END IF
IF Flag? OR (LTRIM$(Q$)<>"") THEN
INCR Q??
Text$(Q??)=Q$
END IF
LOOP
Q??=MAX(Q??,1)
REDIM A$(1:Q??)
FOR Q1?? =1 TO Q??
A$(Q1??)=Text$(Q1??)
NEXT Q1??
END SUB



------------------

[Gregery D Engle]

This isn't what I'm looking for... I'm looking for a split command that allows for TWO different delimitors. Like a split command that will allow for a:

CHR(32) (space) &
a "." (period)

so if I had the string:

"Hello how are you today? I am doing fine."

I would get the result in array(0):

"fine."

------------------
-Greg

[Dave Stanton]

Greg,
Use someting like REPLACE "." WITH " " in T$
Dave
e.g.

     SUB Somestringtoarray(T$,A$(1),Delim$,Otherdelims$(1),Flag?)
         'Flag?:- 0=No blank strings ; 1=Include blanks
          LOCAL Q$,S$,Q??,Q1??,Text$(),Dl?
          DIM Text$(1:1000)
          S$=T$
          FOR Q1?? = LBOUND(Otherdelims$) TO UBOUND(Otherdelims$)
              REPLACE Otherdelims$(Q1??) WITH Delim$ IN S$
          NEXT Q1??
          Dl?=LEN(Delim$)
          Q??=0
          DO UNTIL LEN(S$)=0
             Q1??=INSTR(S$,Delim$)
             IF Q1??>0 THEN
                Q$=LEFT$(S$,Q1??-1)
                S$=MID$(S$,Q1??+Dl?)
             ELSE
                Q$=S$
                S$=""
             END IF
             IF Flag? OR (LTRIM$(Q$)<>"") THEN
             INCR Q??
             Text$(Q??)=Q$
             END IF
          LOOP
          Q??=MAX(Q??,1)
          REDIM A$(1:Q??)
          FOR Q1?? =1 TO Q??
              A$(Q1??)=Text$(Q1??)
          NEXT Q1??
     END SUB

Can't get the format to work




[This message has been edited by Dave Stanton (edited June 20, 2000).]

[Dave Stanton]

Greg,
Thinking about it a bit more I recoded it using PBWIN, excuse the
PBCC test routine.
Dave.

'More elegantly


        SUB Splitstring(T$, _   'Text to search
                  A$(), _ ' Split array
                  D$(), _ ' Delimiter array
                  Flag&)  ' 0=No blank strings ; 1=Include blanks

            DIM S AS LOCAL STRING    ' Local copy of text
            DIM Split AS LOCAL STRING' Spit bit
            DIM Q AS LOCAL LONG      ' Counter
            DIM P AS LOCAL LONG      ' Position pointer
            DIM Items AS LOCAL LONG  ' Number of items
            DIM Blanks AS LOCAL LONG ' Number of blank lines

            S=T$
            FOR Q = LBOUND(D$) TO UBOUND(D$)
                REPLACE D$(Q) WITH CHR$(255) IN S
            NEXT Q
            IF RIGHT$(S,1)<>CHR$(255) THEN S=S+CHR$(255)
            Items=TALLY(S,CHR$(255))
            Blanks=TALLY(S,CHR$(255,255))
            IF Flag&=0 THEN Items=Items-Blanks
            REDIM A$(1 TO MAX(1,Items))

            Q=0
            DO UNTIL LEN(S)=0
               P=INSTR(S,CHR$(255))
               IF P>0 THEN
                  Split=LEFT$(S,P-1)
                  S=MID$(S,P+1)
               ELSE
                  Split=S
                  S=""
               END IF
               IF Flag& OR (LTRIM$(Split)<>"") THEN
                  INCR Q
                  A$(Q)=Split
               END IF
            LOOP

        END SUB
                                      

        FUNCTION PBMAIN()
          DIM X AS LOCAL STRING
          DIM D(1 TO 4) AS LOCAL STRING
          DIM A(1:1) AS LOCAL STRING
          DIM Q AS LOCAL LONG
          X="AB CDE.FGH\\..IJK888LMN"
          D$(1)=" "
          D$(2)="."
          D$(3)="\\"
          D$(4)="888"
          SPLITSTRING X,A(),D(),1
          PRINT X
          FOR Q=LBOUND(A) TO UBOUND(A)
            PRINT Q,, A(Q)
          NEXT Q
          WAITKEY$
          
        END FUNCTION

------------------