$CPU 8086 ' make compatible with XT systems $LIB ALL OFF ' turn off all PowerBASIC libraries $ERROR ALL OFF ' turn off all PowerBASIC error checking $OPTIMIZE SPEED ' optimize for smaller code $COMPILE UNIT ' compile to a UNIT (.PBU) '$COMPILE EXE ' compile to a UNIT (.PBU) DEFINT A-Z ' Required for all numeric functions, forces PB to not ' include floating point in UNIT (makes it smaller) '/*------------------------------------------------------------------*/ $CODE SEG "MLIB6" DECLARE FUNCTION WORD(BYVAL X AS STRING,XN AS INTEGER) AS STRING DECLARE FUNCTION WORDS(BYVAL X AS STRING) AS INTEGER DECLARE FUNCTION STRIP(BYVAL X AS STRING, BYVAL OPT AS STRING, BYVAL CHAR AS STRING) AS STRING '/*------------------------------------------------------------------*/ '/*SUB PARSE(BYVAL TEXT$, BYVAL DELIMITER$, PARMS$(), BYVAL FLAG$) SUB PARSE(BYVAL FLAG$, BYVAL DELIMITER$, BYVAL TEXT$, PARMS$()) PUBLIC '/* This procedure parses text based on a given set of delimiters. '/* The delimiter can either separate the items in the string, or '/* it can precede items in the string. The resulting parsed items '/* are returned in the array PARMS$(). '/* '/* Parameter Descriptions '/* ====================== '/* Text$ = This is the string of text containing the delimiters to '/* parse. '/* Delimiters$= This is the list of delimiters used to parse the string. '/* These delimiters can be any single string item, or a '/* multiple list of items. Examples: "/" or "/\-" '/* Parms$() = The array that contains each item parsed out of the string. '/* This array is redimensioned (from 1) to hold the proper '/* number of parsed items. It should initially be Dim'ed to '/* Parms$(0) before being passed into this procedure. If no '/* delimiters are found in the string, the array will have a '/* dim'ed index of (0) and a null value is returned '/* in the array. '/* Flag% = A flag indicating whether the delimiters separate the '/* string, or precede delimited items. '/* 1 = Precede 2 = Separate '/* '/* The difference is defined as follows: '/* Type 1 A type 1 delimiter means that you are only interested in '/* the text that follows a delimiter. For example, as in a '/* command line string, you may have a string passed into your '/* Program that looks like Text$=" /n /o /d". The PARSE would '/* return 3 items in the array Parms$(1)="n", (2)="o", (3)="d". '/* All text up to the first delimiter is ignored. '/* '/* Type 2 A type 2 delimiter means that text is separated by the '/* delimiter, an all values on both sides of the delimiters '/* are returned. For example: If you have a string that is to be '/* broken apart based on where a Chr$(13) char is inserted, it '/* may look like this: Text$="This is"+Chr$(13)+"a sample." '/* The PARSE would return 2 items in the array. '/* Parms$(1)="This is " and Parms$(2)="a sample." '/* '/* Given these examples, it should be very easy to create other '/* types of delimiters. For example, it might be desirable to '/* have a delimiter type that is at the end of a string section. '/* This would be the opposite of a Type 1, such that any text '/* after the last delimiter would be ignored. Example: '/* '/* Text$ = "This is| a sample| text line." '/* Call PARSE$(Text$, "|", Parms$(), 3) ' type 3 '/* This would return 2 items; Parms$(1)="This is", (2)="a sample" '======================================================================== LOCAL L%, T%, C% FLAG$ = UCASE$(FLAG$) IF INSTR(1,FLAG$,"ARG") > 0 THEN FLAGA = 1 ELSE FLAGA = 0 IF INSTR(1,FLAG$,"UPPER") > 0 THEN FLAGU = 1 ELSE FLAGU = 0 IF INSTR(1,FLAG$,"PARMS") > 0 THEN FLAGP = 1 ELSE FLAGP = 0 IF INSTR(1,FLAG$,"WORDS") > 0 THEN FLAG$ = "3" IF INSTR(1,FLAG$,"PLACEHOLDER") THEN FLAG$ = "4" IF INSTR(1,FLAG$,"POSITIONAL") THEN FLAG$ = "5" IF INSTR(1,FLAG$,"PELEMENT") THEN FLAG$ = "6" IF INSTR(1,FLAG$,"DELIMIT") THEN FLAG$ = "2" IF INSTR(1,FLAG$,"TRIML") THEN FLAGL = 1 ELSE FLAGL = 0 IF INSTR(1,FLAG$,"TRIMR") THEN FLAGR = 1 ELSE FLAGR = 0 IF INSTR(1,FLAG$,"SENTENCE") THEN FLAG$ = "2" DELIMITER$ = "." END IF C%=0 '/* ITEM COUNTER '/*--- Get Command Line Parms? ---*/ IF FLAGA = 1 THEN TEXT$ = COMMAND$ FLAG$ = "2" DELIMITER$ = " " END IF '/*--- Get Parms? ---*/ IF FLAGP = 1 THEN FLAG$ = "1" '/*--- Upper Case? ---*/ IF FLAGU = 1 THEN TEXT$ = UCASE$(TEXT$) '/*--- Set Flag Value ---*/ FLAG% = VAL(FLAG$) SELECT CASE FLAG% CASE 1 '/* DELIMITER PRECEDES ITEMS BEING RETURNED '/* EXAMPLE DEL="/" STRING$="/M /NO /YES" '/* RETURNS 3 ITEMS T% = TALLY(TEXT$, ANY DELIMITER$) '/*NUMBER OF DELIMITERS FOUND IF T% = 0 THEN '/* NO DELIMITERS '/* REDIM PARMS$(0) '/* ERASE ARRAY VALUES PARMS$(0) = "0" EXIT SELECT '/* EXIT SUB END IF '/* REDIM PARMS$(0: T%) '/* CREATE ARRAY TO HOLD ITEMS DO INCR C% '/* INCREMENT COUNTER L% = INSTR(TEXT$, ANY DELIMITER$) '/* POINTER FOR FIRST DELIMITER TEXT$ = RIGHT$(TEXT$, LEN(TEXT$)-L%) '/* IGNORE ALL UP TO FIRST DELIM '/* SINCE THE DELIMITER PRECEDES. L% = INSTR(TEXT$, ANY DELIMITER$) '/* POINTER FOR NEXT DELIMITER IF L% <> 0 THEN PARMS$(C%) = LEFT$(TEXT$, L%-1) '/* GET ALL UP TO NEXT DELIM. ELSE PARMS$(C%) = TEXT$ '/* GET ALL REMAINING END IF TEXT$ = RIGHT$(TEXT$, LEN(TEXT$)-LEN(PARMS$(C%))) LOOP WHILE LEN(TEXT$) PARMS$(0) = STR$(C%) CASE 2 '/* DELIMITER SEPARATES ITEMS BEING RETURNED '/* EXAMPLE DEL=CHR$(13) STRING$="THIS IS"+CHR$(13)+" A TEST". '/* RETURNS 2 ITEMS T% = TALLY(TEXT$, ANY DELIMITER$) '/* NUMBER OF DELIMITERS FOUND IF T% = 0 THEN '/* NO DELIMITERS PARMS$(0) = "0" '/* REDIM PARMS$(0) '/* ERASE ARRAY VALUES EXIT SELECT '/* EXIT SUB END IF '/* REDIM PARMS$(0: T%+1) '/* CREATE ARRAY TO HOLD ITEMS DO INCR C% '/* INCREMENT COUNTER L% = INSTR(TEXT$, ANY DELIMITER$) '/* POINTER FOR DELIMITER IF L% <> 0 THEN PARMS$(C%) = LEFT$(TEXT$, L%-1) '/* GET ALL UP TO DELIMITER TEXT$ = RIGHT$(TEXT$, LEN(TEXT$) - LEN(PARMS$(C%))-1) ELSE PARMS$(C%) = TEXT$ '/* GET ALL REMAINING TEXT$ = "" END IF LOOP WHILE LEN(TEXT$) PARMS$(0) = STR$(C%) CASE 3 '/* Parse out words NWRDS = WORDS(TEXT$) '/* REDIM PARMS$(0: NWRDS) '/* CREATE ARRAY TO HOLD ITEMS FOR CNT = 1 TO NWRDS PARMS$(CNT) = WORD(TEXT$,CNT) NEXT CNT PARMS$(0) = STR$(NWRDS) CASE 4 '/* Placeholder parsing TH$ = "" NDEL = WORDS(DELIMITER$) NWRDS = WORDS(TEXT$) '/* REDIM PARMS$(1: NWRDS) '/* CREATE ARRAY TO HOLD ITEMS PCNT = 0 FOR CNT = 1 TO NWRDS PARMS$(CNT) = "" NEXT CNT FOR CNT = 1 TO NWRDS IF CNT <= NDEL THEN MWRD$ = WORD(DELIMITER$,CNT) ELSE MWRD$ = "." IF MWRD$ <> "." THEN TVAL = VAL(MID$(MWRD$,2)) PARMS$(TVAL) = WORD(TEXT$,CNT) END IF NEXT CNT PARMS$(0) = STR$(NWRDS) CASE 5 '/* Positional parsing NDEL = WORDS(DELIMITER$) NWRDS = NDEL / 2 PCNT = 0 L = LEN(TEXT$) '/* REDIM PARMS$(0: NWRDS) '/* CREATE ARRAY TO HOLD ITEMS FOR CNT = 1 TO NDEL PARMS$(CNT) = "" T1$ = WORD(DELIMITER$,CNT) T2$ = WORD(DELIMITER$,CNT+1) SP = VAL(T1$) LN = VAL(T2$) IF (LN + SP) > L THEN LN = L - SP + 1 IF LN = 0 THEN SP = L + 99 IF SP <= L AND L > 0 THEN CNT = CNT + 1 PCNT = PCNT + 1 PARMS$(PCNT) = MID$(TEXT$,SP,LN) '/* IF FLAG% = 6 THEN PARMS$(1) = PARMS$(1) + MID$(TEXT$,SP,LN) + " " END IF NEXT CNT PARMS$(0) = STR$(PCNT) CASE 6 '/* Positional parsing TO 1 Element NDEL = WORDS(DELIMITER$) NWRDS = NDEL / 2 PCNT = 0 L = LEN(TEXT$) '/* REDIM PARMS$(0: 1) '/* CREATE ARRAY TO HOLD ITEMS FOR CNT = 1 TO NDEL PARMS$(CNT) = "" T1$ = WORD(DELIMITER$,CNT) T2$ = WORD(DELIMITER$,CNT+1) SP = VAL(T1$) LN = VAL(T2$) IF (LN + SP) > L THEN LN = L - SP + 1 IF LN = 0 THEN SP = L + 99 IF SP <= L AND L > 0 THEN CNT = CNT + 1 PCNT = PCNT + 1 PARMS$(1) = PARMS$(1) + MID$(TEXT$,SP,LN) + " " END IF NEXT CNT PARMS$(0) = STR$(PCNT) CASE ELSE PARMS$(1) = TEXT$ END SELECT IF FLAGR = 1 OR FLAGL = 1 THEN IF FLAGL = 1 AND FLAGR = 1 THEN P$ = "B" IF FLAGL = 1 AND FLAGR = 0 THEN P$ = "L" IF FLAGL = 0 AND FLAGR = 1 THEN P$ = "T" FOR CNT = 1 TO UBOUND(PARMS$()) PARMS$(CNT) = STRIP(PARMS$(CNT),P$," ") NEXT CNT END IF END SUB '/*------------------------------------------------------------------*/ ' $INCLUDE "C:\CODE\MLIB\MLIB.INC" 'Cls 'DIM A$(100) ''Example #1 ''=========== 'CLS 'PRINT "Example #1 - DELIMIT BY SPACE" ' T$ = "This is a sample line of some words." ' Call PARSE("DELIMIT"," ",T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY '' Example #2 ''=========== 'CLS 'PRINT "Example #2 - DELIMIT USING CHR$(13)" ' T$ = "This is a sample line of some words."+Chr$(13)+ _ ' "It contains 2 sentences to parse apart." ' Call PARSE("DELIMIT",Chr$(13), T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ' ' '' Example #3 ''=========== 'CLS 'PRINT "Example #3 - PARMS" 'T$ = "\mn /tp /op /t:rew /lfre /abcdefg -pdq -dA:filename" 'Call PARSE("PARMS","/-\", T$,A$()) ' '' Print items returned from procedure. 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ' '' Example #4 ''=========== 'CLS 'PRINT "Example #4 DELIMIT SENTENCES BY CHR$13 & CHR$(10)" ' T$ = "This is a sample line of some words."+Chr$(13)+CHR$(10)+ _ ' "It contains 2 sentences to parse apart." ' Call PARSE("DELIMIT",Chr$(13,10), T$,A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY '' Example #5 ARGs ''=========== 'CLS 'PRINT "Example #5 - ARG" ' Call PARSE("ARG","","", A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ''======================================== '' Example #6 ''=========== 'CLS 'PRINT "Example #6 - WORDS" ' T$ = "This is a sample line of some words."+Chr$(13)+ _ ' "It contains 2 sentences to parse apart." ' Call PARSE("WORDS","",T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ''======================================== '' Example #7 ''=========== 'CLS 'PRINT "Example #7 - WORDS UPPER" ' T$ = "This is a sample line of some words." + _ ' " It contains 2 sentences to parse apart." ' Call PARSE("WORDS upper","",T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ''======================================== '' Example #8 ''=========== 'CLS 'PRINT "Example #8 - Placeholder" ' T$ = "This is a sample line of some words." + _ ' " It contains 2 sentences to parse apart." ' Call PARSE("PLACEHOLDER"," . . . E2 . . . E6 . . . . E1 .",T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ''======================================== '' Example #9 ''=========== 'CLS 'PRINT "Example #9 - SENTENCE" ' T$ = "This is a sample line of some words." + _ ' " It contains 2 sentences to parse apart." ' Call PARSE("SENTENCE","",T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ''======================================== '' Example #10 ''=========== 'CLS 'PRINT "Example #10 - TRIML " ' T$ = "This is a sample line of some words." + _ ' " It contains 2 sentences to parse apart." ' Call PARSE("SENTENCE TRIML","",T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ''======================================== '' Example #11 ''=========== 'CLS 'PRINT "Example #11 - POSITIONAL" ' ' 1 2 3 4 5 6 7 ' ' 1234567890123456789012345678901234567890123456789012345678901234567890123456789 ' T$ = "This is a sample line of some words. It contains 2 sentences to parse apart." ' Call PARSE("POSITIONAL","11 6 23 2 31 5 63 2 66 5 79 5 ",T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY ''======================================== '' Example #12 ''=========== 'CLS 'PRINT "Example #12 - POSITIONAL TO 1ELEMENT" ' ' 1 2 3 4 5 6 7 ' ' 1234567890123456789012345678901234567890123456789012345678901234567890123456789 ' T$ = "This is a sample line of some words. It contains 2 sentences to parse apart." ' Call PARSE("PELEMENT","11 6 23 2 31 5 63 2 66 5 79 5 ",T$, A$()) 'For K%=1 to VAL(A$(0)) ' Print K%; "'" + RTrim$(A$(K%)) + "'" 'Next 'PRINT A$(0) 'Y$ = GETKEY 'End ''======================================== '/*------------------------------------------------------------------*/