stringprocess.bas

这是一本学习串口编程喝计算机监控的好书里面是用VB开发的源代码

Attribute VB_Name = "StringProcess"
    Option Explicit
    'no dependence

Public Function NextString(ByVal strSource As String, strD As String) As String
    Dim I As Long
    Dim J As Long
    
    I = InStr(1, strSource, strD, vbTextCompare)
    J = Len(strD)
    If I = 0 Then
        NextString = ""
    Else
        NextString = Mid(strSource, I + J)
    End If
End Function

Public Function GetLeftString(ByVal strSource As String, strD As String) As String
    Dim lLoc As Long
    
    lLoc = InStr(1, strSource, strD, vbTextCompare)
    If lLoc = 0 Then
        GetLeftString = ""
    Else
        GetLeftString = Left(strSource, lLoc - 1)
    End If
End Function

Public Function GetIncludeString(ByVal strSource As String, strD As String) As String
    Dim strTmp As String
    
    strTmp = GetInsideString(strSource, strD)
    If strTmp <> "" Then
        GetIncludeString = strD + strTmp + strD
    Else
        GetIncludeString = ""
    End If
End Function

Public Function GetNoTail(ByVal strSource As String, strD As String, nLocation As Integer) As String
    'I=0, for entire string
    Dim I As Integer
    Dim strTmp As String
    
    If nLocation = 0 Then
        GetNoTail = strSource
        Exit Function
    End If
    
    strTmp = NextString(strSource, strD)
    I = I + 1
    
    Do While I < nLocation And strTmp <> ""
        strTmp = NextString(strTmp, strD)
        I = I + 1
    Loop
    
    GetNoTail = strTmp
End Function

Public Function GetNoString(ByVal strSource As String, strD As String, nLocation As Integer) As String
    'Start from 0.
    Dim nlen As Integer
    
    nlen = Len(strD)
    If Left(strSource, nlen) <> strD Then strSource = strSource + strD
    
    GetNoString = GetLeftString(GetNoTail(strSource, strD, nLocation), strD)
End Function

Public Function GetLastString(ByVal strSource As String, strD As String) As String
    Dim I As Integer
    Dim nlen As Integer
      
    nlen = Len(strSource)
    If Mid(strSource, nlen) <> strD Then strSource = strSource + strD
      
    Do While GetNoString(strSource, strD, I) <> ""
        GetLastString = GetNoString(strSource, strD, I)
        I = I + 1
    Loop
End Function

Public Function ChangeTail(ByVal strSource As String, strD1 As String, strD2 As String) As String
    Dim nlen As Integer
    Dim strEnd As String
    
    nlen = Len(strD1)
    strEnd = Mid(strSource, Len(strSource) - nlen + 1)
    
    If strEnd = strD1 Then
        ChangeTail = Left(strSource, Len(strSource) - nlen) + strD2
    Else
        ChangeTail = strSource
    End If
End Function

Public Function GetInsideString(ByVal strSource As String, strD As String) As String
    Dim strTmp As String
    Dim nLenOfStrD As Integer
    Dim I As Long
    
    strTmp = strSource
    If Len(strTmp) < 3 Or strD = "" Then Exit Function
    
    nLenOfStrD = Len(strD)
    I = InStr(1, strTmp, strD, vbTextCompare)
    
    If I <> 0 Then
        strTmp = Mid(strTmp, I + nLenOfStrD)
        GetInsideString = GetLeftString(strTmp, strD)
    End If
End Function

Public Function ChCharsCount(ByVal strSource As String) As Long
    Dim lLen As Long
    Dim lTmp As Long
    Dim lCode As Long
    Dim lCount As Long
    Dim strCh As String
    
    If strSource = "" Then Exit Function
    
    lLen = Len(strSource)
    For lTmp = 1 To lLen
        strCh = Mid(strSource, lTmp, 1)
        lCode = AscW(strCh)
        If lCode > 255 Or lCode < 0 Then lCount = lCount + 1
    Next lTmp
    
    ChCharsCount = lCount
End Function

Public Function FeatureCount(ByVal strSource As String, strFeature As String) As Long
    Dim I As Long
    Dim strTmp As String
    Dim nlen As Long
    Dim nCount As Long
    
    If strFeature = "" Then Exit Function
    
    strTmp = strSource
    nlen = Len(strTmp)
    I = InStr(1, strTmp, strFeature, vbTextCompare)
    strTmp = NextString(strTmp, strFeature)
    
    Do While I > 0
        nCount = nCount + 1
        
        I = InStr(1, strTmp, strFeature, vbTextCompare)
        strTmp = NextString(strTmp, strFeature)
        DoEvents
    Loop
    
    FeatureCount = nCount
End Function

Public Function OnlyOneSegChar(ByVal strSource As String, strSegment As String, bDelHead As Boolean) As String
    'if "**", use only a "*", ABAB to AB
    Dim strD2 As String
    Dim strTmp As String
    Dim nLoc As Long
    
    If strSource = "" Or strSegment = "" Then
        OnlyOneSegChar = strSource
        Exit Function
    End If
    
    strTmp = strSource
    If bDelHead = True Then
        Do While Mid(strTmp, 1, Len(strSegment)) = strSegment
            strTmp = Mid(strTmp, 1 + Len(strSegment))
            DoEvents
        Loop
    End If
    
    strD2 = strSegment + strSegment
    nLoc = InStr(1, strSource, strD2)
    Do While nLoc <> 0
        strTmp = Mid(strTmp, 1, nLoc + Len(strSegment) - 1) + Mid(strTmp, nLoc + Len(strD2))
        nLoc = InStr(1, strTmp, strD2)
        DoEvents
    Loop
    OnlyOneSegChar = strTmp
End Function

Public Function SegmentChars(ByVal strSource As String, nlen As Integer, strD As String) As String
    Dim I As Integer
    Dim strTmp As String
    Dim strResult As String
    
    If strSource = "" Or nlen < 1 Then Exit Function
    
    For I = 1 To Len(strSource)
        strTmp = Mid(strSource, I, nlen)
        If Len(strTmp) < nlen Then Exit For
        strResult = strResult + strTmp + strD
    Next I
    
    SegmentChars = strResult
End Function

Public Function DelAllSubChars(ByVal strSource As String, strSubChars As String) As String
    Dim lLoc As Long
    Dim nTmp As Integer
    Dim strTmp As String
    
    strTmp = strSource
    nTmp = Len(strSubChars)
    
    If strTmp = "" Or nTmp = 0 Then
        DelAllSubChars = strSource
        Exit Function
    End If
    
    lLoc = InStr(1, strTmp, strSubChars)
    
    Do While lLoc > 0
        strTmp = Mid(strTmp, 1, lLoc - 1) + Mid(strTmp, lLoc + nTmp)
        lLoc = InStr(lLoc, strTmp, strSubChars)
        DoEvents
    Loop
    
    DelAllSubChars = strTmp
End Function

Public Function InsertUniqueString(strSource As String, strWord As String, strD As String, nEnd As Integer) As String
    'But "春天" > "我们".
    Dim I As Integer
    Dim strTmp As String
    Dim nLoc As Long
    
    If strSource = "" Then
        InsertUniqueString = strWord + strD
        Exit Function
    Else
        If InStr(1, strSource, strWord, vbTextCompare) <> 0 Then
            InsertUniqueString = strSource
            Exit Function
        End If
        
        If nEnd = 0 Then
            'by order
            strTmp = GetNoString(strSource, strD, I)
            Do While strTmp < strWord
                If strTmp = "" Then Exit Do
                I = I + 1
                strTmp = GetNoString(strSource, strD, I)
                DoEvents
            Loop
            
            If strTmp = "" Then
                InsertUniqueString = strSource + strWord + strD
            Else
                nLoc = InStr(1, strSource, strTmp, vbTextCompare)
                InsertUniqueString = Mid(strSource, 1, nLoc - 1) + strWord + strD + Mid(strSource, nLoc)
            End If
        Else
            InsertUniqueString = strSource + strWord + strD
        End If
    End If
End Function

Public Function InsertSpecialChar(ByVal strSource As String, strSegment As String, strD As String) As String
    'from "我们12的祖国。" to "我们*祖国*"
    Dim strTmp As String
    Dim lLocation As Long
    
    If Len(strD) > 1 Then
        MsgBox "The length of segmentChar must less than 2!", vbExclamation + vbOKOnly
        InsertSpecialChar = strSource
        Exit Function
    End If
    
    strTmp = strSource
    
    For lLocation = 1 To Len(strTmp)
        If InStr(1, strSegment, Mid(strTmp, lLocation, 1)) <> 0 Then
            strTmp = Mid(strTmp, 1, lLocation - 1) + strD + Mid(strTmp, lLocation + 1)
        End If
        DoEvents
    Next lLocation
    
    'use only a "*"
    InsertSpecialChar = OnlyOneSegChar(strTmp, strD, True)
End Function

Public Function CheckLegalChars(ByVal strSource As String, ByVal strStandard As String) As Boolean
    Dim nlen As Integer
    Dim I As Integer
    Dim bError As Boolean
    
    If strSource = "" Or strStandard = "" Then Exit Function
    
    nlen = Len(strSource)
    
    For I = 1 To nlen
        If InStr(1, strStandard, Mid(strSource, I, 1)) = 0 Then
            bError = True
            Exit For
        End If
    Next I
    
    If bError = True Then
        CheckLegalChars = False
    Else
        CheckLegalChars = True
    End If
End Function

Public Function GetSeconds(strTime As String) As Long
    Dim nH, nM, nS As Long
    On Error Resume Next
    
    nH = Val(GetNoString(strTime, ":", 0))
    nM = Val(GetNoString(strTime, ":", 1))
    nS = Val(GetNoTail(strTime, ":", 2))
    GetSeconds = (nH * 60 + nM) * 60 + nS
End Function

Public Function GetHMS(sTotal As Long) As String
    Dim nH, nM, nS As Long
    On Error GoTo ErrProcess
    
    If sTotal < 0 Then GoTo ErrProcess 'The second day
    nH = sTotal \ 3600
    sTotal = sTotal - nH * 3600
    nM = sTotal \ 60
    nS = sTotal - nM * 60
    GetHMS = Trim(Str(nH)) + ":" + Trim(Str(nM)) + ":" + Trim(Str(nS))
    GetHMS = Format(GetHMS, "H:MM:SS")
    Exit Function
    
ErrProcess:
    GetHMS = "0:00:00"
End Function

Public Function GetEndChar(ByVal strSource As String) As String
    Dim lLen As Long
    
    lLen = Len(strSource)
    If lLen > 0 Then GetEndChar = Mid(strSource, lLen, 1)
End Function

Public Function GetStringBetweenTwoChars(ByVal strSource As String, nLocation As Integer, strStart As String, strEnd As String) As String
    Dim strTmp As String
    Dim nStart As Integer
    Dim nEnd As Integer
    
    nStart = InStr(nLocation, strSource, strStart, vbTextCompare)
    If nStart = 0 Then Exit Function
    
    nEnd = InStr(nStart, strSource, strEnd, vbTextCompare)
    If nEnd = 0 Then Exit Function
    If nEnd <= nStart Then Exit Function
    
    GetStringBetweenTwoChars = Mid(strSource, nStart + Len(strStart), nEnd - nStart - Len(strStart))
End Function

Public Function InsertString(strSource As String, strSub As String, nLoc As Integer) As String
    If nLoc < 1 Then InsertString = strSource
    If nLoc > Len(strSource) Then InsertString = strSource + strSub
    
    If nLoc >= 1 And nLoc <= Len(strSource) Then
        InsertString = Mid(strSource, 1, nLoc - 1) + strSub + Mid(strSource, nLoc)
    End If
End Function

Public Function ts(ByVal vData As Variant) As String  'ts: trim(str(data))
    ts = Trim(Str(vData))
End Function

Public Function TwoDigit(ByVal nData As Integer) As String
    If nData > 99 Then Exit Function
    TwoDigit = Format(nData, "0#")
End Function

Public Function GetMonthEnd(ByVal strSource As String) As String
    'from 2005-11-xx to 2005-11-30
    Dim nYear As Integer
    Dim nMonth As Integer
    Dim strTmp As String
    Dim dTmp As Date
    
    nYear = Val(GetNoString(strSource, "-", 0))
    nMonth = Val(GetNoString(strSource, "-", 1))
    
    If nMonth = 12 Then
        strTmp = ts(nYear + 1) + "-01-01"
    Else
        strTmp = ts(nYear) + "-" + ts(nMonth + 1) + "-1"
    End If
        
    dTmp = CDate(strTmp)
    GetMonthEnd = Format(dTmp - 1, "yyyy-mm-dd")
End Function