qstring.bas

ICQ通讯程序 ICQ通讯程序 ICQ通讯程序

Attribute VB_Name = "Wordfunc"
Option Explicit
'===============================================
'Words.bas - string handling functions for words
'Author: Evan Sims         [[e-mail]]
'Based on a module by Kevin O'Brien
'Version - 1.2 (Sept. 1996 - Dec 1999)
'
'These functions deal with "words".
'Words = blank-delimited strings
'Blank = any combination of one or more spaces,
'        tabs, line feeds, or carriage returns.
'
'Examples:
'      word("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", "in")   = 8
'
'     InStr("find 3 in here", "her")  = 11
' wordIndex("find 3 in here", "her")  = 0
'===============================================

Public Function Word(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 count
Dim lEnd    As Long   'position of trailing word delimiter

sSource = CSpace(sSource)

'find the nth word
x = 1
pointer = 1

Do
   Do While Mid$(sSource, pointer, 1) = SP     'skip consecutive 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
      Word = Mid$(sSource, pointer, 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 word
Loop
  
End Function

Public 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 sSource
Dim pointer As Long    'start parameter of Instr()
Dim pos     As Long    'position of target in InStr()
Dim x       As Long    'word count

sSource = CSpace(sSource)
lSource = Len(sSource)
If lSource = 0 Then Exit Function

'count words
x = 1
pointer = 1

Do
   Do While Mid$(sSource, pointer, 1) = SP     'skip consecutive 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 word
Loop
If Mid$(sSource, lSource, 1) = SP Then x = x - 1 'adjust if trailing space
Words = x
End Function

Public Function WordCount(ByVal sSource As String, _
                                sTarget As String) As Long
'=====================================================
' WordCount returns the number of times that
' 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 lSource As Long    'length of sSource
Dim lTarget As Long    'length of sTarget
Dim 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 word
pointer = 1
Do While Mid$(sSource, pointer, 1) = SP       'skip consecutive spaces
   pointer = pointer + 1
Loop
If 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$(sSource, pos + lTarget, 1) = SP _
   Or pos + lTarget > lSource Then            'must be a word
      If pos = 1 Then
         x = x + 1                            'word found
      ElseIf Mid$(sSource, pos - 1, 1) = SP Then
         x = x + 1                            'word found
      End If
   End If
   pointer = pos + lTarget
Loop
WordCount = x

End 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 sSource
Dim lTarget    As Long    'length of sTarget
Dim lPosTarget As Long    'position of target-word
Dim 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 word
pointer = 1
Do While Mid$(sSource, pointer, 1) = SP       'skip consecutive spaces
   pointer = pointer + 1
Loop
If pointer > lSource Then Exit Function       'sSource contains no words

Do                                            'find position of sTarget
   pos = InStr(pointer, sSource, sTarget)
   If pos = 0 Then Exit Function              'string not found
   If Mid$(sSource, pos + lTarget, 1) = SP _
   Or pos + lTarget > lSource Then            'must be a word
      If pos = 1 Then Exit Do                 'word found
      If Mid$(sSource, pos - 1, 1) = SP Then Exit Do
   End If
   pointer = pos + lTarget
Loop


'count words until position of sTarget
lPosTarget = pos                             'save position of sTarget
pointer = 1
x = 1
Do
   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 word
Loop
WordPos = x
End 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 String
Dim lTarget As Long    'vTarget converted to Long, or length of sTarget
Dim lSource As Long    'length of sSource
Dim pointer As Long    'start parameter of InStr()
Dim pos     As Long    'position of target in InStr()
Dim x       As Long    'word counter

lSource = Len(sSource)
sSource = CSpace(sSource)

If VarType(vTarget) = vbString Then GoTo strIndex
If Not IsNumeric(vTarget) Then Exit Function
lTarget = CLng(vTarget)                       'convert to Long

'find byte position of lTarget (word number)
x = 1
pointer = 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, sSource, SP)           'find next space
   If pos = 0 Then Exit Do                     'word not found