?? stringprocess.bas
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -