qstring.bas

Com串口即时通讯工具.有服务端和客启端..是学习的好程度!

Attribute VB_Name = "Wordfunc"
'===========================================
'Words.bas-字符处理模块
'本模块处理基本字符
'===========================================

Option Explicit

'=================================================
'取得词语中第N个字
'函数调用例子Word("red blue green ", 2)   "blue"
'=================================================
Public Function Word(ByVal sSource As String, _
                                 n As Long) As String
Const SP    As String = " "
Dim pointer As Long
Dim pos     As Long
Dim x       As Long   '字符串长度
Dim lEnd    As Long

sSource = CSpace(sSource)


x = 1
pointer = 1

Do
   Do While Mid$(sSource, pointer, 1) = SP     '跳过空格
      pointer = pointer + 1
   Loop
   If x = n Then                               '目录字符长度
      lEnd = InStr(pointer, sSource, SP)       '字符串尾的窗格
      If lEnd = 0 Then lEnd = Len(sSource) + 1 '
      Word = Mid$(sSource, pointer, lEnd - pointer)
      Exit Do                                  '处理成功，退出循环
   End If
  
   pos = InStr(pointer, sSource, SP)           '找下一个空格
   If pos = 0 Then Exit Do                     '查找空格失败
   x = x + 1                                   '字符长加1
  
   pointer = pos + 1                           '开始下一字符
Loop
  
End Function

'=================================================
' 返回字符串中单词的个数
' 例如:
'    Words("red blue green")   3
'=================================================
Public Function Words(ByVal sSource As String) As Long

Const SP    As String = " "
Dim lSource As Long    '源字符串长度
Dim pointer As Long    'Instr开始串变量
Dim pos     As Long
Dim x       As Long    '字符串长度

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

x = 1
pointer = 1

Do
   Do While Mid$(sSource, pointer, 1) = SP
      pointer = pointer + 1
   Loop
   pos = InStr(pointer, sSource, SP)           '查找下一个空格
   If pos = 0 Then Exit Do                     '已经是最后一个空格，退出循环
   x = x + 1                                   '字符长加1
  
   pointer = pos + 1                           '开始下一字符
Loop
If Mid$(sSource, lSource, 1) = SP Then x = x - 1 '哪果有空格则调整大小
Words = x
End Function

'=====================================================
' 取得单词在句子中出现的次数函数.
' 例如:
'    WordCount("a rose is a rose", "rose")     2
'=================================================
Public Function WordCount(ByVal sSource As String, _
                                sTarget As String) As Long
Const SP    As String = " "
Dim pointer As Long
Dim lSource As Long    '源字符串长度
Dim lTarget As Long    '目标字符串长度
Dim pos     As Long
Dim x       As Long    '字符串长度

lTarget = Len(sTarget)
lSource = Len(sSource)
sSource = CSpace(sSource)


'查找目标字符串
pointer = 1
Do While Mid$(sSource, pointer, 1) = SP       '跳过空格
   pointer = pointer + 1
Loop
If pointer > lSource Then Exit Function       '源字符串没有包含

Do                                            '查找目标字符串
   pos = InStr(pointer, sSource, sTarget)
   If pos = 0 Then Exit Do                    '没有找到目标字符串，退出
   If Mid$(sSource, pos + lTarget, 1) = SP _
   Or pos + lTarget > lSource Then
      If pos = 1 Then
         x = x + 1                            '找到目标字符串，加1
      ElseIf Mid$(sSource, pos - 1, 1) = SP Then
         x = x + 1                            '找到目标字符串，加1
      End If
   End If
   pointer = pos + lTarget
Loop
WordCount = x

End Function

'=====================================================
' 返回单词在句子中出现的位置
' 例如:
'    WordPos("red blue green", "blue")    2
'=================================================
Public Function WordPos(ByVal sSource As String, _
                              sTarget As String) As Long
Const SP       As String = " "
Dim pointer    As Long
Dim lSource    As Long    '源字符串长度
Dim lTarget    As Long    '目标字符串长度
Dim lPosTarget As Long
Dim pos        As Long
Dim x          As Long

lTarget = Len(sTarget)
lSource = Len(sSource)
sSource = CSpace(sSource)


'查找目标字符串
pointer = 1
Do While Mid$(sSource, pointer, 1) = SP       '跳过空格
   pointer = pointer + 1
Loop
If pointer > lSource Then Exit Function       '源字符串没有包含

Do                                            '查找目标字符串位置
   pos = InStr(pointer, sSource, sTarget)
   If pos = 0 Then Exit Function              '没有找到目标字符串
   If Mid$(sSource, pos + lTarget, 1) = SP _
   Or pos + lTarget > lSource Then
      If pos = 1 Then Exit Do                 '查找成功
      If Mid$(sSource, pos - 1, 1) = SP Then Exit Do
   End If
   pointer = pos + lTarget
Loop

'计算目标字符串位置
lPosTarget = pos
pointer = 1
x = 1
Do
   Do While Mid$(sSource, pointer, 1) = SP
      pointer = pointer + 1
   Loop
   If pointer >= lPosTarget Then Exit Do
   pos = InStr(pointer, sSource, SP)         '查找下一空格
   If pos = 0 Then Exit Do
   x = x + 1
   pointer = pos + 1
Loop
WordPos = x
End Function

'=========================================================
' 返回字符串中第n个单词的长度
' 例如:
'    WordLength("red blue green", 2)    4
'=========================================================

Public Function WordLength(ByVal sSource As String, _
                                       n As Long) As Long
Const SP    As String = " "
Dim lSource As Long
Dim pointer As Long
Dim pos     As Long
Dim x       As Long
Dim lEnd    As Long

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


x = 1
pointer = 1

Do
   Do While Mid$(sSource, pointer, 1) = SP
      pointer = pointer + 1
   Loop
   If x = n Then
      lEnd = InStr(pointer, sSource, SP)
      If lEnd = 0 Then lEnd = lSource + 1
      WordLength = lEnd - pointer
      Exit Do                                  '查找成功，退出
   End If
  
   pos = InStr(pointer, sSource, SP)           '查找下一空格
   If pos = 0 Then Exit Do
   x = x + 1
  
   pointer = pos + 1
Loop

End Function

'===========================================================
' 删除字符串中自N个单词开始的vWords个单词
' 例如:
'   DelWord("now is not the time", 3)     "now is"
'   DelWord("now is not the time", 3, 1)  "now is the time"
'===========================================================
Public Function DelWord(ByVal sSource As String, _
                                    n As Long, _
                      Optional vWords As Variant) As String
Const SP    As String = " "
Dim lWords  As Long    '目标字符串长度
Dim lSource As Long    '源字符串长度
Dim pointer As Long
Dim pos     As Long
Dim x       As Long    '长度
Dim lStart  As Long
Dim lEnd    As Long

lSource = Len(sSource)
DelWord = sSource
sSource = CSpace(sSource)
If IsMissing(vWords) Then
   lWords = -1
ElseIf IsNumeric(vWords) Then
   lWords = CLng(vWords)
Else
   Exit Function
End If

If n = 0 Or lWords = 0 Then Exit Function      '没有可删除的

x = 1
pointer = 1

Do
   Do While Mid$(sSource, pointer, 1) = SP     '跳过空格
      pointer = pointer + 1
   Loop
   If x = n Then                               '目标串长度
      lStart = pointer
      If lWords < 0 Then Exit Do
   End If
   
   If lWords > 0 Then
      If x = n + lWords - 1 Then
         lEnd = InStr(pointer, sSource, SP)
         Exit Do
      End If
   End If
   
   pos = InStr(pointer, sSource, SP)
   If pos = 0 Then Exit Do
   x = x + 1
  
   pointer = pos + 1
Loop
If lStart = 0 Then Exit Function
If lEnd = 0 Then
   DelWord = Trim$(Left$(sSource, lStart - 1))
Else
   DelWord = Trim$(Left$(sSource, lStart - 1) & Mid$(sSource, lEnd + 1))
End If
End Function

'===========================================================
' 返回句子中的子串
' 例如:
'   MidWord("now is not the time", 3)     "not the time"
'   MidWord("now is not the time", 3, 2)  "not the"
'===========================================================
Public Function MidWord(ByVal sSource As String, _
                                    n As Long, _
                      Optional vWords As Variant) As String
Const SP    As String = " "
Dim lWords  As Long
Dim lSource As Long
Dim pointer As Long
Dim pos     As Long
Dim x       As Long
Dim lStart  As Long
Dim lEnd    As Long

lSource = Len(sSource)
sSource = CSpace(sSource)
If IsMissing(vWords) Then
   lWords = -1
ElseIf IsNumeric(vWords) Then
   lWords = CLng(vWords)
Else
   Exit Function
End If

If n = 0 Or lWords = 0 Then Exit Function              '没有可删除的

'find position of n
x = 1
pointer = 1

Do
   Do While Mid$(sSource, pointer, 1) = SP     '跳过空格
      pointer = pointer + 1
   Loop
   If x = n Then
      lStart = pointer
      If lWords < 0 Then Exit Do               '包含目标串
   End If
   
   If lWords > 0 Then                          '找到目标串
      If x = n + lWords - 1 Then
         lEnd = InStr(pointer, sSource, SP)    '找到目标串后的空格
         Exit Do                               '查找目标串成功
      End If
   End If
   
   pos = InStr(pointer, sSource, SP)
   If pos = 0 Then Exit Do
   x = x + 1
  
   pointer = pos + 1
Loop
If lStart = 0 Then Exit Function
If lEnd = 0 Then
   MidWord = Trim$(Mid$(sSource, lStart))
Else
   MidWord = Trim$(Mid$(sSource, lStart, lEnd - lStart))
End If
End Function

'==================================================
'添加一个特别字符到串中
'  cSpace("a" & vbTab   & "b")  "a b"
'  cSpace("a" & vbCrlf  & "b")  "a  b"
'==================================================
Public Function CSpace(sSource As String) As String
Dim pointer   As Long
Dim pos       As Long
Dim x         As Long
Dim iSpace(3) As Integer

' 定认空字符
iSpace(0) = 9
iSpace(1) = 10
iSpace(2) = 13   '软回车
iSpace(3) = 160  '硬回车

CSpace = sSource
For x = 0 To UBound(iSpace) '替换
   pointer = 1
   Do
      pos = InStr(pointer, CSpace, Chr$(iSpace(x)))
      If pos = 0 Then Exit Do
      Mid$(CSpace, pos, 1) = " "
      pointer = pos + 1
   Loop
Next x

End Function

'==================================================
'分离字符串函数
'==================================================
Public Function SplitString(iSource As String, iTarget As String, Optional BeforeTarget As Boolean = False) As String
If BeforeTarget = True Then
   SplitString = DelWord(iSource, WordPos(iSource, iTarget))
Else
   SplitString = DelWord(iSource, 1, WordPos(iSource, iTarget))
End If

End Function

'===========================================================
' 返加字符在字符串中的位置
' 如:
'   WordIndex("two plus 2 is four", 2)       5
'   WordIndex("two plus 2 is four", "2")    10
'   WordIndex("two plus 2 is four", "two")   1
'===========================================================
Public Function WordIndex(ByVal sSource As String, _
                                vTarget As Variant) As Long
Const SP    As String = " "
Dim sTarget As String
Dim lTarget As Long
Dim lSource As Long    '源字符串长度
Dim pointer As Long    'instr开始变量
Dim pos     As Long    '目标字符串的位置
Dim x       As Long    '句子长度

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

If VarType(vTarget) = vbString Then GoTo strIndex
If Not IsNumeric(vTarget) Then Exit Function
lTarget = CLng(vTarget)                       '转化为长整型

'查找
x = 1
pointer = 1


Do
   Do While Mid$(sSource, pointer, 1) = SP     '跳过空格
      pointer = pointer + 1
   Loop
   
   If x = lTarget Then                         '目标串长度
      If pointer > lSource Then Exit Do
      WordIndex = pointer
      Exit Do                                  '查找成功
   End If
  
   pos = InStr(pointer, sSource, SP)           '查找下一空格
   If pos = 0 Then Exit Do                     '没有找到
   x = x + 1                                   '串长度加1
   pointer = pos + 1
Loop

Exit Function
strIndex:
sTarget = CStr(vTarget)
lTarget = Len(sTarget)
If lTarget = 0 Then Exit Function

pointer = 1
Do
   pos = InStr(pointer, sSource, sTarget)
   If pos = 0 Then Exit Do
   If Mid$(sSource, pos + lTarget, 1) = SP _
   Or pos + lTarget > lSource Then
      If pos = 1 Then Exit Do
      If Mid$(sSource, pos - 1, 1) = SP Then Exit Do
   End If
   pointer = pos + lTarget
Loop

WordIndex = pos

End Function