Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Some supplementary "parse-string" functions

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Some supplementary "parse-string" functions

    ' Some supplementary "parse-string" functions
    '
    ' Powerbasic has some very powerful functions to manipulate strings with
    ' delimited fields. These are:
    ' PARSE statement: Parses an entire string and extract all delimited fields
    ' into an array.
    ' PARSE$ function: Returns one delimited field from a string expression.
    ' The complementary function to the PARSE statement is the
    ' JOIN$ function: Returns a string consisting of all of the strings in a
    ' string array, each separated by a delimiter.
    '
    ' If you have strings with many delimited fields, it may sometimes be simpler
    ' and faster to insert/delete/extract/replace fields or substrings directly on the
    ' main string using the functions presented in this short code. I am sure you
    ' can make other supplementary functions. You can increase speed somewhat by
    ' omitting the parameter check.
    '
    ' Best regards,
    '
    ' Erik ------ May 25, 2005
    Code:
    #COMPILE EXE
    #DIM ALL
    '
    FUNCTION InsertEmptyFields(BYVAL TextLine AS STRING, BYVAL IndxStart AS LONG, BYVAL EmptyFields AS LONG, BYVAL Separator AS STRING) AS STRING
        LOCAL Pos1 AS LONG, Pos2 AS LONG, I AS LONG
        I = PARSECOUNT(TextLine, Separator)
        ' check parameters: if invalid then exit without making any change
        IF IndxStart > I OR IndxStart < 1 OR EmptyFields < 1 OR LEN(separator)<>1 THEN FUNCTION = TextLine : EXIT FUNCTION
        FOR I = 2 TO IndxStart : INCR Pos1 : Pos1 = INSTR(Pos1, TextLine, Separator) : NEXT
        INCR Pos1 : FUNCTION = STRINSERT$(TextLine, STRING$(EmptyFields, Separator), Pos1)
    END FUNCTION
    '
    FUNCTION DeleteFields(BYVAL TextLine AS STRING, BYVAL IndxStart AS LONG, BYVAL IndxEnd AS LONG, BYVAL Separator AS STRING) AS STRING
        LOCAL Pos1 AS LONG, Pos2 AS LONG, I AS LONG
        I = PARSECOUNT(TextLine, Separator)
        ' check parameters: if invalid then exit without making any change
        IF IndxStart > I OR IndxEnd < IndxStart OR IndxEnd > I OR IndxEnd < 1 OR IndxStart < 1 OR LEN(separator)<>1 THEN FUNCTION = TextLine : EXIT FUNCTION
        FOR I = 2 TO IndxStart : INCR Pos1 : Pos1 = INSTR(Pos1, TextLine, Separator) : NEXT
        Pos2 = Pos1 : INCR pos1
        FOR I = 0 TO IndxEnd - IndxStart : INCR Pos2 : Pos2 = INSTR(Pos2, TextLine, Separator) : NEXT
        IF ISFALSE Pos2 THEN DECR Pos1 : Pos2 = LEN(TextLine) + 1  ' position at end of line
        FUNCTION = STRDELETE$(TextLine, Pos1, Pos2 - Pos1 + 1)
    END FUNCTION
    '
    FUNCTION GetFields(BYVAL TextLine AS STRING, BYVAL IndxStart AS LONG, BYVAL IndxEnd AS LONG, BYVAL Separator AS STRING) AS STRING
        LOCAL Pos1 AS LONG, Pos2 AS LONG, I AS LONG
        I = PARSECOUNT(TextLine, Separator)
        ' check parameters: if invalid then exit without making any change
        IF IndxStart > I OR IndxEnd < IndxStart OR IndxEnd > I OR IndxEnd < 1 OR IndxStart < 1 OR LEN(separator)<>1 THEN FUNCTION = TextLine : EXIT FUNCTION
        FOR I = 2 TO IndxStart : INCR Pos1 : Pos1 = INSTR(Pos1, TextLine, Separator) : NEXT
        Pos2 = Pos1 : INCR Pos1
        FOR I = 0 TO IndxEnd - IndxStart : INCR Pos2 : Pos2 = INSTR(Pos2, TextLine, Separator) : NEXT
        IF ISFALSE Pos2 THEN Pos2 = LEN(TextLine)+1  ' position at end of line
        FUNCTION = MID$(TextLine, Pos1, Pos2 - Pos1)
    END FUNCTION
    '
    FUNCTION ReplaceFields(BYVAL TextLine AS STRING, BYVAL NewFields AS STRING, BYVAL IndxStart AS LONG, BYVAL Separator AS STRING) AS STRING
        LOCAL Pos1 AS LONG, Pos2 AS LONG, I AS LONG, J AS LONG
        J = PARSECOUNT(NewFields, Separator) : I = PARSECOUNT(TextLine, Separator)
        IF J > I - IndxStart + 1 OR IndxStart < 1 OR LEN(separator)<>1 THEN FUNCTION = TextLine : EXIT FUNCTION ' Invalid parameters: make no change
        FOR I = 2 TO IndxStart : INCR Pos1 : Pos1 = INSTR(Pos1, TextLine, Separator) : NEXT
        Pos2 = Pos1 : INCR Pos1
        FOR I = 1 TO J  : INCR Pos2 : Pos2 = INSTR(Pos2, TextLine, Separator) : NEXT
        IF ISFALSE Pos2 THEN Pos2 = LEN(TextLine) + 1  ' position at end of line
        FUNCTION = STRINSERT$(STRDELETE$(TextLine, Pos1, Pos2 - Pos1), NewFields, Pos1)
    END FUNCTION
    '
    SUB ShowData(BYREF RowData() AS STRING, BYVAL R AS LONG, BYVAL t AS STRING)
        LOCAL B AS STRING, I AS LONG
        B = ""
        FOR I=1 TO R
            B = B + RowData(I) + $CRLF
        NEXT
        MSGBOX B,,t
    END SUB
    '
    FUNCTION PBMAIN()
        LOCAL I AS LONG, J AS LONG,K AS LONG
        LOCAL R AS LONG
        '
        DATA "Erik,Jensen,47,London"
        DATA "Peter,Jensen,23,New York"
        DATA "Hans,Jensen,34,Copenhagen"
        DATA "Hans,Jensen,6,Paris"
        DATA "John,Jensen,9,Los Angeles"
        DATA "John,Andersen,46,Stockholm"
        DATA "Hans,Andersen,21,Oslo"
        DATA "Jack,Andersen,36,Berlin"
        DATA "John,Andersen,7,Copenhagen"
        DATA "Hans,Carlsen,33,Paris"
        DATA "Peter,Carlsen,34,London"
        DATA "Niels,Carlsen,28,New York"
        DATA "Hans,Carlsen,33,New York"
        DATA "Hans,Carlsen,64,Los Angeles"
        DATA "Erik,Carlsen,26,Stockholm"
        DATA "John,Smith,45,Oslo"
        DATA "John,Smith,65,Berlin"
        DATA "Hans,Smith,35,Los Angeles"
        DATA "John,Smith,45,Stockholm"
        DATA "Carl,Smith,36,Oslo"
        '
        R = DATACOUNT
        DIM RowData(1 TO R) AS STRING
        DIM SubData(1 TO R) AS STRING
        '
        FOR I=1 TO R
            RowData(I)=READ$(I)
            REPLACE "," WITH $TAB IN RowData(I)
        NEXT
        CALL ShowData(RowData(), R, "Original Data:")
        '
        FOR I&=1 TO R
            RowData(I)=InsertEmptyFields(RowData(I), 3, 4, $TAB)
        NEXT
        CALL ShowData(RowData(), R, "Four empty fields inserted at field 3:")
        '
        FOR I&=1 TO R
            RowData(I)=ReplaceFields(RowData(I), "Perspective Road"+$TAB+FORMAT$(RND(50,500),"#")+$TAB+FORMAT$(RND(4,50),"#")+"th Fl."+$TAB+"App. "+CHR$(RND(65,77)), 3, $TAB)
        NEXT
        CALL ShowData(RowData(), R, "Four empty fields replaced by text fields")
        '
        FOR I&=1 TO R
            RowData(I)=DeleteFields(RowData(I), 3, 6, $TAB)
        NEXT
        CALL ShowData(RowData(), R, "Four new fields deleted again:")
        '
        FOR I&=1 TO R
            SubData(I)=GetFields(RowData(I), 1, 2, $TAB)
        NEXT
        CALL ShowData(SubData(), R, "First 2 fields extracted:")
        '
        RowData(1)=ReplaceFields(RowData(1), "Donald"+$TAB+"Duck", 1, $TAB)
        RowData(2)=ReplaceFields(RowData(2), "Mikey"+$TAB+"Mouse", 1, $TAB)
        CALL ShowData(RowData(), R, "First two fields replaced on the first two lines:")
        '
    END FUNCTION
    ------------------
Working...
X