查看: 10  |  回复: 0
  VB6 检查日期是否有效,子程序 IsValidDateField
楼主
发表于 昨天 14:21
Enum psDateTypes
  AnyValidDate  'Allows any valid date to be entered
  PastDate    'Only allows past dates (before today) to be entered
  FutureDate   'Only allows future dates (after today) to be entered
  TodayOrFuture  'Only allows today or future date to be entered
  TodayOrPast   'Only allows today or a previous day to be entered
End Enum

' Validate attributes of date data
' Returns True if valid, False if invalid
'
' Example:
' If IsValidDateField(Value:="01/30/2001",
' '    DateType:=psDateTypes.FutureDate, IsRequired:=True)

Function IsValidDateField(Value As Variant, Optional ByVal DateType As _
  psDateTypes = AnyValidDate, Optional ByVal IsRequired As Boolean = True) As _
  Boolean

  On Error GoTo ErrorHandler
  
  Dim lngDate As Long
  Dim lngToday As Long

  IsValidDateField = True

  If IsRequired = True Then
    If IsNull(Value) Or Value = vbNullString Then
      IsValidDateField = False
    End If
  ElseIf IsNull(Value) Or Value = "" Then
    Value = Null
    Exit Function
  End If

  If IsDate(Value) Then
    lngDate = Format$(Value, "yyyymmdd")
    lngToday = Format$(Now, "yyyymmdd")

    Select Case DateType
      Case psDateTypes.FutureDate
        If lngDate <= lngToday Then
          IsValidDateField = False
        End If
      Case psDateTypes.PastDate
        If lngDate >= lngToday Then
          IsValidDateField = False
        End If
      Case psDateTypes.TodayOrFuture
        If lngDate < lngToday Then
          IsValidDateField = False
        End If
      Case psDateTypes.TodayOrPast
        If lngDate > lngToday Then
          IsValidDateField = False
        End If
    End Select
  Else
    IsValidDateField = False
  End If

  Exit Function
  
ErrorHandler:
  Err.Raise Err.Number, "IsValidDateField", Err.Description
End Function


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2025 MaNongKu.com