basstring.bas

功能强大的API

Attribute VB_Name = "basString"
'****************************************
'汉化: 小聪明       [e-mail]
'小聪明的主页VB版:  http://coolzm.533.net
'****************************************
Option Explicit

Private Declare Function IsCharAlpha Lib "user32" _
   Alias "IsCharAlphaA" (ByVal cChar As Byte) As Long
   
Private Declare Function IsCharAlphaNumeric Lib _
   "user32" Alias "IsCharAlphaNumericA" (ByVal cChar As Byte) As Long


' 此函数取得第Nth个token和第Nth-1个token之间的字符串
' 例如: GetToken("This is a test.", " ", 2) = "is"
'       GetToken("This is a test.:, "s", 2) = " i"
Public Function GetToken(s As String, token As String, ByVal Nth As Integer) As String
   Dim i As Integer
   Dim p As Integer
   Dim r As Integer

   If Nth < 1 Then
      GetToken = ""
      Exit Function
   End If

   r = 0

   For i = 1 To Nth
      p = r
      r = InStr(p + 1, s, token)
      If r = 0 Then
         If i = Nth Then
            GetToken = Mid$(s, p + 1, Len(s) - p)
         Else
            GetToken = ""
         End If
         Exit Function
      End If
   Next i

   GetToken = Mid$(s, p + 1, r - p - 1)
End Function
'
'
'  例:  GetTokens("This is a test.") = ({ "This", "is", "a", "test." })
'
Public Function GetTokens(sTxt As String, sToken As String) As Variant
    Dim iTokenLen As Integer
    Dim iTokenCnt As Integer
    Dim lOffset As Long
    Dim lPrevOffset As Long
    Dim aTokens() As String

    iTokenLen = Len(sToken)
    lOffset = InStr(sTxt, sToken)
    
    Do While lOffset > 0
        ReDim Preserve aTokens(iTokenCnt)
        If lOffset - lPrevOffset > 1 Then
            aTokens(iTokenCnt) = Mid$(sTxt, lPrevOffset + 1, lOffset - 1 - lPrevOffset)
        Else
            aTokens(iTokenCnt) = ""
        End If
        
        lPrevOffset = lOffset
        lOffset = InStr(lOffset + iTokenLen, sTxt, sToken)
        iTokenCnt = iTokenCnt + 1
    Loop
    
    ReDim Preserve aTokens(iTokenCnt)
    aTokens(iTokenCnt) = Mid$(sTxt, lPrevOffset + 1)
    GetTokens = CVar(aTokens)
End Function

'此函数将一个Double类型的数转换为字符串
'注意:小数点后的数将被忽略
Function Int2String(ByVal l As Double) As String
   Dim tmp As String
   Dim str As String
   Dim i As Integer
   Dim j As Integer
   
   tmp = Format(l, "000000000000")
   str = ""
  
   If Len(tmp) > 12 Then
      Int2String = ""
      Exit Function
   End If
   
    
   If Val(tmp) = 0 Then
      Int2String = "zero"
      Exit Function
   End If
   
   
   i = Val(Left$(tmp, 3))
   If i <> 0 Then
      GoSub do_hundreds
      str = str + " trillion"
   End If
   
   i = Val(Mid$(tmp, 4, 3))
   If i <> 0 Then
      GoSub do_hundreds
      str = str + " million"
   End If
   
   i = Val(Mid$(tmp, 7, 3))
   If i <> 0 Then
      GoSub do_hundreds
      str = str + " thousand"
   End If
   
      
   i = Val(Right$(tmp, 3))
   If i <> 0 Then
      GoSub do_hundreds
   End If
   
   Int2String = str
   Exit Function
   
   

do_hundreds:
   If i > 99 Then
      j = i
      i = i \ 100
      GoSub do_ones
      str = str + " hundred"
      i = j Mod 100
   End If

   If i <> 0 Then
      GoSub do_tens
   End If
   Return
   
do_tens:
   Select Case i Mod 100
      Case 90 To 99:
         str = str + " ninety"
         GoSub do_ones
      Case 80 To 89:
         str = str + " eighty"
         GoSub do_ones
      Case 70 To 79:
         str = str + " seventy"
         GoSub do_ones
      Case 60 To 69:
         str = str + " sixty"
         GoSub do_ones
      Case 50 To 59:
         str = str + " fifty"
         GoSub do_ones
      Case 40 To 49:
         str = str + " fourty"
         GoSub do_ones
      Case 30 To 39:
         str = str + " thirty"
         GoSub do_ones
      Case 20 To 29:
         str = str + " twenty"
         GoSub do_ones
         
      Case 19: str = str + " nineteen"
      Case 18: str = str + " eighteen"
      Case 17: str = str + " seventeen"
      Case 16: str = str + " sixteen"
      Case 15: str = str + " fifteen"
      Case 14: str = str + " fourteen"
      Case 13: str = str + " thirteen"
      Case 12: str = str + " twelve"
      Case 11: str = str + " eleven"
      Case 10: str = str + " ten"
      
      Case Else
         GoSub do_ones
   End Select
   Return
   
   
do_ones:
   If i < 10 Or i Mod 10 = 0 Then
      str = str + " "
   Else
      str = str + "-"
   End If
   
   Select Case i Mod 10
      Case 9: str = str + "nine"
      Case 8: str = str + "eight"
      Case 7: str = str + "seven"
      Case 6: str = str + "six"
      Case 5: str = str + "five"
      Case 4: str = str + "four"
      Case 3: str = str + "three"
      Case 2: str = str + "two"
      Case 1: str = str + "one"
   End Select
   
   Return
End Function


' 判断一个字符串中有没有非字母
' 如果参数s中的字符全是字母则返回0
' 否则将返回第一个非字母出现的位置
' 例如 IsStringAlpha("asdf12a") = 5
Public Function IsStringAlpha(s As String) As Long
   Dim i As Long
   
   For i = 1 To Len(s)
      If IsCharAlpha(Asc(Mid$(s, i, 1))) = 0 Then
         IsStringAlpha = i
         Exit Function
      End If
   Next i
   
   IsStringAlpha = 0
End Function

'
' 如果参数s中的字符全是字母或数字则返回0
' 否则将返回第一个非法字符出现的位置
' 例如 IsStringAlpha("asdf>12a") = 5
Public Function IsStringAlphaNumeric(s As String) As Long
   Dim i As Long
   
   For i = 1 To Len(s)
      If IsCharAlphaNumeric(Asc(Mid$(s, i, 1))) = 0 Then
         IsStringAlphaNumeric = i
         Exit Function
      End If
   Next i
   
   IsStringAlphaNumeric = 0
End Function
'
' 如果参数s中的字符全是数字则返回0
' 否则将返回第一个非数字出现的位置
' 例如 IsStringAlpha("asdf12a") = 1
'
Public Function IsStringNumeric(s As String) As Long
   Dim i As Long
   Dim j As Byte
   
   For i = 1 To Len(s)
      j = Asc(Mid$(s, i, 1))
      If IsCharAlphaNumeric(j) = 1 Then
         If IsCharAlpha(j) = 1 Then
            IsStringNumeric = i
            Exit Function
         End If
      Else
         IsStringNumeric = i
         Exit Function
      End If
   Next i
   
   IsStringNumeric = 0
End Function
'修整字符串
Public Function STrim(s As String) As String
   Dim i As Integer
   Dim s2 As String
   
   s2 = Trim(s)
   i = InStr(s2, Chr$(0))
   
   If i > 0 Then
      s2 = Left$(s2, i - 1)
   End If
   
   STrim = s2
End Function