Option expendit '=============================================== 'Words.bas - String Handling Functions for Words'Author: Evan SIMS [ESIMS@arcola-il.com]' Based ON A Module By Kevin O'Brien'Version - 1.2 (Sept. 1996 - Dec 1999) '' Tse Functions Deal with "words". 'Words = blank-delimited strings'blank = any combination of one or more spaces,' tabs, line feeds, or carriage returns. 'Examples:' PWORD ("Find 3 in here", 3) = "IN" 3rd Word 'Words ("Find 3 in Here" = 4 Number of Words' Split ("Here 'S / S More", "/ S") = "More" Returns Words After Split Identifier (/ s)' Delword ("Find 3 in Here", 1, 2) = "in here" delete 2 Words, Start AT 1 'Midword ("Find 3 in Here", 1, 2) = "Find 3" Return 2 Words, Start AT 1 'WordPos ("Find 3 in Here", "in") = 3 Word-Number of "in"' WordCount ("Find 3 in Here", "in") = 1 Occurrences of Word "in" 'WordIndex (" Find 3 in here "," in ") = 8 position of" in "'WordIndex (" Find 3 in Here " , 3) = 8 Position of 3rd Word 'WordIndex ("Find 3 in Here", "3") = 6 position of "3"' WordLength ("Find 3 in Here", 3) = 2 Length of 3rd WORD ''
Difference Between INSTR () And WordIndex (): 'INSTR ("Find 3 in Here", "IN") = 2' WordIndex ("Find 3 in Here") = 8 '' INSTR ("Find 3 in "," her ") = 11 'WordIndex (" Find 3 in Here "," Her ") = 0' ======================== ======================= Public function PWord (byval ssource as string, _ n as long) AS string '========== ================================================ 'Word Retrieves the nth word from ssource' usage: 'Word ("Red Blue Green", 2) "blue" =================================== ============== const sp as string = "" DIM POINTER AS long 'start parameter of INSTR () DIM POS AS long' POSITION OF TARGET in INSTR () DIM X as long 'word Countdim Lend As Long 'Position of Trailing Word Delimiter
SSource = CSPACE (SSOource)
'Find the nth wordx = 1pointer = 1
Do Do While Mid $ (SSOURE, POINTER, 1) = SP 'SKIP ConsoTive Spaces Pointer = Pointer 1 Loop if x = n Then' The Target Word-Number Lend = Instr (Pointer, SSource, SP) 'POS of Space AT End of Word if lend = 0 Then Lend = len (ssource) 1 'or if its the last word pword = mid $ (ssource, pointer, lend - pointer) exit do' word found, done endiffs = instruction (Pointer , sSource, SP) 'find next space If pos = 0 Then Exit Do' word not found x = x 1 'increment word counter pointer = pos 1' start of next wordLoop End FunctionPublic Function Words (ByVal sSource As String) As Long '================================================================================================================================================================================================ = 'Words Returns the Number of Words in a string' usage: 'Words ("Red Blue Green") 3' ========================= ========================= CONST SP as string = " "DIM LSOURCE AS Long 'Length of Ssourcedim Pointer As Long' Start Parameter of INSTR () DIM POS AS Long 'Position of Target in INSTR () DIM X As Long' Word Count
SSource = CSPACE (SSOource) lsource = len (ssource) if lsource = 0 Then EXIT function'count wordsx = 1pointer = 1
Do Do While Mid $ (SSOURE, POINTER, 1) = SP 'SKIP Connecutive Spaces Pointer = Pointer 1 Loop Pos = Instr (Pointer, SSource, SP)' Find Next Space IF POS = 0 Then Exit do 'NO More Words X = x 1 'increment Word Counter Pointer = POS 1' Start of Next Wordloopif Mid $ (ssource, lsource, 1) = sphen x = x - 1 'adjust if trailing spacewords = Xend Function
Public Function WordCount (Byval Ssource As String, _ Starget As String) As long '================================== ==================== 'WordCount Returns the number of time' Word, Starget, is found in ssource. 'Usage:' WordCount ("a rose is a rose "," rose ") 2 '========================================== ======= Const SP as string = "" DIM POINTER AS Long 'Start Parameter of INSTR () DIM LSOURES As Long' Length of SSOURDIM LTARGET AS Long 'Length of Stargetdim Pos as Long' Position of Target in INSTR ) DIM X as long 'word countltarget = len (starget) lsource = len (ssource) SSource = CSPACE (SSOURE)
'Find Target WordPointer = 1do While Mid $ (SSource, Pointer, 1) = SP' SKIP Connecutive Spaces Pointer = Pointer 1LOOPIF Pointer> Lsource Then Exit Function 'SSource Contains no words
Do 'Find Position of Starget Pos = Instr (Pointer, SSource, Starget) if Pos = 0 THEN EXIT DO' STRING NOT FOUND IF MID $ (SSOURE, POS LTARGET, 1) = SP_OR POS LTARGET> LSOURETEN ' Must Be a Word if Pos = 1 THEN X = x 1 'Word Found elseif Mid $ (SSOURE, POS - 1, 1) = SP THEN X = X 1' Word Found end if end if pointer = POS LTARGETLOOPWORDCOUNT = Xend Function
Public Function WordPos (Byval Ssource As String, _ Starget As String) AS Long '================================== ==================== 'Wordpos Returns the Word Number of the' Word, Starget, in sSource. 'Usage:' WordPos ("Red Blue Green", "Blue ") 2 '=============================================== === Const SP As String = "" Dim pointer As Long 'start parameter of Instr () Dim lSource As Long' length of sSourceDim lTarget As Long 'length of sTargetDim lPosTarget As Long' position of target-wordDim pos As Long 'position Of target in INSTR () DIM X as long 'Word Count
lTarget = Len (sTarget) lSource = Len (sSource) sSource = CSpace (sSource) 'find target wordpointer = 1Do While Mid $ (sSource, pointer, 1) = SP' skip consecutive spaces pointer = pointer 1LoopIf pointer> lSource Then Exit Function 'SSource Contains No Words
Do 'Find Position of Starget POS = INSTR (POINTER, SSOUR, STARGET) IF POS = 0 THEN EXIT FUNCTION' STRING NOT FOUND IF MID $ (SSOURE, POS LTARGET, 1) = SP_OR POS LTARGET> LSOURCE THEN ' Must Be a Word if Pos = 1 THEN EXIT DO 'WORD IF MID $ (SSOURE, POS - 1, 1) = SP1 EXIT DO End if Pointer = POS LTARGETLOOP
'Count words until position of sTargetlPosTarget = pos' save position of sTargetpointer = 1x = 1Do Do While Mid $ (sSource, pointer, 1) = SP 'skip consecutive spaces pointer = pointer 1 Loop If pointer> = lPosTarget Then Exit Do' All Words Have Been Counted Pos = Instr (Pointer, SSource, SP) 'Find Next Space IF POS = 0 THEN EXIT DO' NO MORE WORDS X = X 1 'Increment Word Count Pointer = POS 1' Start of Next WordLoopWordPos = Xend Function
Public Function WordIndex (Byval Ssource As String, _ vtarget as variant) as long '================================== ========================== 'WordIndex returns the byte position of vtarget in ssource.' Vtarget can be a word-number or a string. ' USAGE: 'WordIndex ("Two Plus 2 IS Four", 2) 5' WordIndex ("Two Plus 2 IS Four", "2") 10 'WordIndex ("Two Plus 2 Is Four", "Two") 1' = ============================================================================================================================================================================================================= ======== Const SP As String = "" Dim sTarget As String 'vTarget converted to StringDim lTarget As Long' vTarget converted to Long, or length of sTargetDim lSource As Long 'length of sSourceDim pointer As Long' start parameter Of inst () Dim POS as long 'position of target in INSTR () DIM X as long' Word CounterlSource = LEN (SSOURES) SSOUR = CSPACE (SSource)
IF VARTYPE (VTARGET) = VBString Then Goto Strindexif Not IsNumeric (vtarget) Then EXIT functionLTarget = Clng (vtarget) 'Convert to Long
'Find Byte Position of LTarget (Word Number) x = 1Pointer = 1
Do Do While Mid $ (sSource, pointer, 1) = SP 'skip consecutive spaces pointer = pointer 1 Loop If x = lTarget Then' word-number of Target If pointer> lSource Then Exit Do 'beyond end of sSource WordIndex = pointer 'Position of Word Exit Do' Word Found, Done End if Pos = INSTR (Pointer, SSOUR, SP) 'Find Next Space if Pos = 0 THEN EXIT DO' WORD NOT FOUND X = X 1 'Increment Word Counter Pointer = POS 1LOOPEXIT FUNCTIONSTRINDEX: STARGET = CSTR (Vtarget) LTARGET = LEN (STARGET) if ltarget = 0 THEN EXIT FUNCTION 'NOTING to Count
'Find Byte Position of Starget (String) Pointer = 1DO POS = Instr (Pointer, SSource, Starget) if Pos = 0 THEN EXIT DO IF MID $ (SSOURE, POS LTARGET, 1) = SP_OR POS LTARGET> LSOURCE Then IF POS = 1 Then EXIT DO IF MID $ (SSOURE, POS - 1, 1) = SP1 EXIT DO END IF POINTER = POS LTARGETLOOP
WordIndex = POS
END FUNCTION
Public Function WordLength (Byval Ssource AS String, _ n as long) as long '================================== ======================== 'WordLength Returns the length of the nth word in ssource' usage: 'WordLength ("Red Blue Green", 2) 4 '==================================================== ======== Const SP as string = "" DIM LSOURCE AS long "LENGTH OF SSOURCEDIM POINTER AS Long 'Start Parameter INSTR () DIM POS AS Long' Position of Target with INSTR () DIM X as Long 'Word Countdim Lend As long 'Position of Trailing Word Delimiterssource = CSPACE (SSOURES) LSOURE = LEN (SSOURES)
'Find the nth wordx = 1pointer = 1
Do Do While Mid $ (SSOURE, POINTER, 1) = SP 'SKIP ConsoTive Spaces Pointer = Pointer 1 Loop if x = n Then' The Target Word-Number Lend = Instr (Pointer, SSource, SP) 'POS of Space AT End of Word if lend = 0 Then Lend = lsource 1 'or if its the last word wordlength = lend - Pointer Exit do' Word Found, Done End if Pos = INSTR (POINTER, SSOURCE, SP) 'Find Next Space IF POS = 0 THEN EXIT DO 'WORD NOT FOUND X = X 1' Increment Word Counter Pointer = POS 1 'Start of Next WordLoopend Function
Public Function Delword (Byval Ssource As String, _ n as long, _ Optional vWords as variant) AS string '=========================== ================================================= . 'IF vWords is omitted, all Words from the nth word on area deleted.' Usage: 'delword ("now is not the time", 3) "now"' delword ("now is not the time", 3 1) "Now is the time" ========================================== =================== const sp as string = "" DIM LWORDS AS Long 'Length of Stargetdim Lsource As Long' Length of Ssourcedim Pointer As Long 'Start Parameter Of Instr ) Dim pos As Long 'position of target in InStr () Dim x As Long' word counterDim lStart As Long 'position of word nDim lEnd As Long' position of space after last wordlSource = Len (sSource) DelWord = sSourcesSource = cSpace (sSource IF ismissing (vWords) Then LWORDS = - 1ELSEIF ISNUMERIC (VWORDS) THEN LWORDS = ClNG (vWords) Else EXIT FUNCTIONEND IF
IF n = 0 or lwords = 0 THEN EXIT function 'Nothing to delete'find position of nx = 1pointer = 1
Do Do While Mid $ (SSOURE, POINTER, 1) = SP 'SKIP Connecutive Spaces Pointer = Pointer 1 Loop if x = n Then' The Target Word-Number Lstart = Pointer IF LWORDS <0 THEN EXIT DO End ifnesss> 0 TEN 'LWORDS WAS PROVIDED IF X = N LWORDS - 1 TEN' FIND POS OF Last Word Lend = INSTR (POINTER, SSOURCE, SP) 'POS of Space At End of Word Exit Do Space Found, DONE END IF END IF POS = INSTR (POINTER, SSOURCE, SP) 'Find Next Space if Pos = 0 THEN EXIT DO' WORD NOT FOUND X = X 1 'Increment Word Counter Pointer = POS 1' Start of Next Wordloopif Lstart = 0 THEN EXIT FUNCTIONIF Lend = 0 Then Delword = TRIM $ (SSOURE, LSTART - 1)) ELSE DELWORD = TRIM $ (SSOURE, LSTART - 1) & MID $ (SSOURE, LEND 1)) End IFEND Function
Public Function MidWord (Byval Ssource As String, _ n as long, _ Optional vWords as variant) AS string '=========================== ================================================== Words. 'if vWords is omitted, all Words from the nth word on area' Returned. 'usage:' Midword ("Now is not the time", 3) "NOT TIME" 'MIDWORD ("Now Is Not The Time" , 3, 2) "NOT THE" ========================================== =================== const sp as string = "" DIM LWORDS As long 'vWords Converted to longdim lsource as long "langth of ssourcedim Pointer As Long' Start Parameter of Instr () DIM POS AS long 'POSITION OF TARGET in INSTR () DIM X AS Long' Word Counterdim Lstart As Long 'Position of Word Ndim Lend As Long' Position of Space Last Wordlsource = LEN (SSOURES) SSOURE = CSPACE (SSOURES) IF ismissing (vWords) Then LWORDS = -1ELS Eif IsNumeric (vWords) Then LWORDS = ClNG (vWords) Else EXIT FUNCTIONEND IF
IF n = 0 or lwords = 0 THEN EXIT function 'Nothing to delete'find position of nx = 1pointer = 1
Do Do While Mid $ (SSOURCE, POINTER, 1) = SP 'SKIP Connecutive Spaces Pointer = Pointer 1 Loop if x = N THEN' The Target Word-Number Lstart = Pointer if LWORDS <0 THEN EXIT DO 'INCLUDE REST OF SSOURCE End if if lwords> 0 the 'LWORDS WAS PROVIDED IF X = N LWORDS - 1 TEN' FIND POS OF Last Word Lend = INSTR (Pointer, SSource, SP) 'POS of Space At End of Word Exit Do Space At End of Word Exit Do Space DONE END IF End If Pos = Instr (Pointer, SSource, SP) 'Find Next Space IF POS = 0 THEN EXIT DO' WORD NOT FOUND X = X 1 'Increment Word Counter Pointer = POS 1' Start of Next Wordloopif Lstart = 0 THEN EXIT FUNCTIONIF Lend = 0 THEN MIDWORD = TRIM $ (MID $ (SSOURE, LSTART)) ELSE MIDWORD = TRIM $ (SSOURCE, LSTART, LEND - LSTART) END IFEND FUNCTION
Public Function CSPACE (SSOURE AS STRING) AS String '======================================== =========== 'Cspace Converts Blank Characters' (ASCII: 9, 10, 13, 160) TO Space (32) 'CSPACE ("A" & VBTAB & "B") "AB"' CSPACE ("A" & VBCRLF & "B") "a b" '==================================== ================ Dim Pointer As Longdim POS LONGDIM X as longdim ispace (3) AS integer 'define blank character' define blank character 'define blank character "= 9' Horizontal Tabispace (1) = 10 ' Line feedispace (2) = 13 'Carriage Returnispace (3) = 160' Hard Space
Cspace = ssourcefor x = 0 To Ubound (ispace) 'Replace All Blank Characters with space Pointer = 1 do Pos = INSTR (Pointer, Cspace, CSPACE (x))) IF POS = 0 THEN EXIT DO MID $ (CSPACE , POS, 1) = "" Pointer = POS 1 LoopNext X
END FUNCTION
Public Function Splitstring (isource as string, itarget as string, optional beforeetarget as boolean = false) AS string '============================ ====================== 'Returns the characters before or after the split'Identifier. By Default Will Return Text After ID,' Set Before True To Return To Text before'it. '============================================== ====== if BeforeTarget = True kiln splitstring = delword (isource, Wordpos (isource, Itarget) Else Splitstring = Delword
