stringm.bas

电话本信息 基本上实现电话功能 自己下载侃侃吧

Attribute VB_Name = "StringM"
Option Explicit

Public Function IsLongNUM(ByVal STR1 As String) As Boolean
  STR1 = Trim(STR1)
  If Len(STR1) Then
    IsLongNUM = IsNumeric(STR1) And (InStr(STR1, ".") < 1)
  End If
End Function


Public Function IsEmail(ByVal STR1 As String) As Boolean
  Dim I As Integer, K As Integer
  
  STR1 = Trim(STR1)
  If Len(STR1) Then
    I = InStr(STR1, "@")
    If I > 1 And I < Len(STR1) Then
      K = InStr(I + 1, STR1, ".")
      If K > I + 1 Then
        I = InStr(I + 1, STR1, "@")
        If I < 1 Then IsEmail = (Left(STR1, 1) <> ".") And (Right(STR1, 1) <> ".")
      End If
    End If
  End If
End Function

Public Function IsYLDate(ByVal STR1 As String) As Boolean
  Dim I As Integer, K As Integer, STRS1() As String
  
  STRS1 = Split(Trim(STR1), "-")
  If UBound(STRS1) <> 2 Then Exit Function
  If IsLongNUM(STRS1(0)) And IsLongNUM(STRS1(1)) And IsLongNUM(STRS1(2)) Then
    If Val(STRS1(0)) > 0 And Val(STRS1(1)) > 0 And Val(STRS1(1)) > 0 Then
      IsYLDate = Val(STRS1(1)) < 13 And Val(STRS1(2)) < 31
    End If
  End If
End Function

Public Function IsDate(ByVal STR1 As String) As Boolean
  Dim Date1 As Date, I As Integer, K As Integer, STRS1() As String
  
  On Error GoTo IsDateError
  
  STRS1 = Split(Trim(STR1), "-")
  If UBound(STRS1) <> 2 Then Exit Function
  If IsLongNUM(STRS1(0)) And IsLongNUM(STRS1(1)) And IsLongNUM(STRS1(2)) Then
    If Val(STRS1(0)) < 1 Or Val(STRS1(1)) < 1 Or Val(STRS1(1)) < 1 Or Val(STRS1(1)) > 12 Or Val(STRS1(2)) > 32 Then Exit Function
  End If
  Date1 = CDate(STR1)
  IsDate = True
IsDateError:
End Function

Public Function IsPhoneNumber(ByVal STR1 As String) As Boolean
  Dim I As Long, STRS1() As String
  
  STRS1 = Split(Trim(STR1), "-")
  If Len(STRS1(0)) < 3 Then Exit Function
  For I = 0 To UBound(STRS1)
    If InStr(STRS1(I), " ") Then Exit Function
    If Not IsLongNUM(STRS1(I)) Then Exit Function
  Next
  IsPhoneNumber = True
End Function