A better CDate for VB6

后端 未结 8 704
悲哀的现实
悲哀的现实 2020-12-21 05:43

We have a a VB6 app (in a COM component) which uses CDate() to take a string and cast it to a Date, for storing in a database.

Depending on if we want the applicatio

相关标签:
8条回答
  • 2020-12-21 06:13

    This should be close, though it hardcodes the delimiter as "/" and windows YY years at 50:

    Private Function ParseDate(ByVal DateString As String, _
                               ByVal DatePattern As String) As Date
        'DateString:  i/j/k formatting.
        'DatePattern: i/j/k formatting, each to be:
        '               M or MM for month position.
        '               D or DD for day position.
        '               YY or YYYY for year position, if YY
        '                 then century windowed at 50.
        Dim strStringParts() As String
        Dim strPatternParts() As String
        Dim intPart As Integer, intScore As Integer
        Dim intMonth As Integer, intDay As Integer, intYear As Integer
        Const DELIM As String = "/"
        Const YYWINDOW As Integer = 50
    
        strStringParts = Split(DateString, DELIM)
        strPatternParts = Split(UCase$(DatePattern), DELIM)
        For intPart = 0 To UBound(strStringParts)
            If intPart > UBound(strPatternParts) Then
                Err.Raise 5, "ParseDate"
            End If
            Select Case strPatternParts(intPart)
                Case "M", "MM"
                    intMonth = CInt(strStringParts(intPart))
                    intScore = intScore Or &H1
                Case "D", "DD"
                    intDay = CInt(strStringParts(intPart))
                    intScore = intScore Or &H2
                Case "YY"
                    intYear = CInt(strStringParts(intPart))
                    If 0 > intYear Or intYear > 99 Then
                        Err.Raise 5, "ParseDate"
                    End If
                    intYear = intYear + IIf(intYear < YYWINDOW, 2000, 1900)
                    intScore = intScore Or &H4
                Case "YYYY"
                    intYear = CInt(strStringParts(intPart))
                    If 100 > intYear Or intYear > 9999 Then
                        Err.Raise 5, "ParseDate"
                    End If
                    intScore = intScore Or &H4
                Case Else
                    Err.Raise 5, "ParseDate"
            End Select
        Next
        If intScore = &H7 Then
            ParseDate = DateSerial(intYear, intMonth, intDay)
        Else
            Err.Raise 5, "ParseDate"
        End If
    End Function
    

    Validation may not be perfect, but it ought to be close. It throws "Invalid procedure call or argument (Error 5)" on bad inputs.

    0 讨论(0)
  • 2020-12-21 06:14

    You should talk with a date variable (not a formatted string) and then show formatted value in the form using the user regional settings or take the input from the user to a date variable.

    0 讨论(0)
  • 2020-12-21 06:16

    You can use the built-in Format function to do this for you.

    Here is a simple test to confirm this:

    Public Sub TestDateParsing()
    
       'On my computer, the date format is U.S. (mm/dd/yyyy)'
       'This test creates a date string in dd/mm/yyyy format to'
       'simulate user input in a different format'
    
        Const TEST_DATE As Date = #6/1/2009#
    
        Dim inputDate As String
        inputDate = Format(TEST_DATE, "dd/mm/yyyy")
        'inputDate is "1/6/2009" (June 1 in dd/mm/yyyy format)'
    
        Debug.Print Format(inputDate, "dd/mm/yyyy")
        'It`s magic! The above line will print 6/1/2009'
        'which is the correct format for my Regional Settings'
    
    End Sub
    

    It might seem like magic, but it isn't. It takes advantage of how the Format function works in conjunction with the current regional settings.

    For example, suppose your Regional Settings are configured to use the "mm/dd/yyyy" format for dates.

    Now, you get a date string from a user in "dd/mm/yyyy" format. If you Format this date string and tell Format to also use "dd/mm/yyy", it will swap the month and day parts of the date because your settings say dates are in "mm/dd/yyyy" format.

    In other words, Format always assumes the date string from the user is formatted according to your current Regional Settings (in this case, "mm/dd/yyyy"), so when you tell it to format the date using "dd/mm/yyyy", it will force it to swap the month and day parts. If your Regional Settings use the same format as the user-provided date, this code will still work: Format will simply return the user date unchanged. Confused yet? ;)

    The same thing will happen if your Regional Settings are set for "dd/mm/yyyy" and the user sends a date in "mm/dd/yyyy" format.

    The catch is that you have to know ahead of time which format the user is sending dates in. They can't start mixing and matching date formats (and they shouldn't be anyway).


    EDIT (by MarkJ) - just to prove that Mike's code can convert a string to Date. Mike, please roll back or change this edit if you want.

    Public Sub Test()
      Dim dte As Date
      For dte = #1/1/2009# To #12/31/2009#
        Call TestDateParsing(dte)
      Next dte
    End Sub
    
    Public Sub TestDateParsing(ByVal dteIn As Date)
    
      'On my computer, the date format is U.S. (mm/dd/yyyy)'
      'This test creates a date string in dd/mm/yyyy format to'
      'simulate user input in a different format'
    
      Dim sExpected As String
      sExpected = Day(dteIn) & " / " & Month(dteIn) & " / " & Year(dteIn)
      Dim inputDate As String
      Dim dte As Date
      inputDate = Format(dteIn, "dd/mm/yyyy")
      dte = Format(inputDate, "dd/mm/yyyy")
    
      Debug.Assert sExpected = Day(dte) & " / " & Month(dte) & " / " & Year(dte)
      Debug.Print sExpected
    
    End Sub
    
    0 讨论(0)
  • 2020-12-21 06:18

    Another way to go:

    Public Enum abDateType
        abMDY
        abDMY
    End Enum
    
    Public Function MakeDate(ByVal dateString As String, ByVal dateType As abDateType, Optional delimiter As String = "/") As Date
        Dim strVals() As String
        Dim dtRtnVal As Date
        strVals = Split(dateString, delimiter)
        Select Case dateType
        Case abMDY
            dtRtnVal = DateSerial(strVals(2), strVals(0), strVals(1))
        Case abDMY
            dtRtnVal = DateSerial(strVals(2), strVals(1), strVals(0))
        Case Else
            Err.Raise vbObjectError, , "Unexpected date format."
        End Select
        MakeDate = dtRtnVal
    End Function
    
    0 讨论(0)
  • 2020-12-21 06:19

    Look, there's no easy way to say this - you're screwed. If you accept freeform input from the web, you have to live with the reality that people around the world format dates differently. That's why so many websites use popup calendars, and such, to get user input. No ambiguity there. No matter what you think, .NET's library routines can't fathom your user's intentions any better than any other library.

    Fwiw, the code Mike posted is absolutely VB6. I'm not sure what about it looks like VB.NET? Once you get a date/time into a Date variable, you can display it however you want with Format(). That's the easy part.

    I'd strongly suggest you either A) find a way to gather your inputs unambiguously, or B) tell your users what format you expect and live with what they input. All that said, is it possible I misunderstood the question, and you really do know what format the user is providing the data in? (Because if so, I really am having trouble understanding what's the problem interpreting it in ClassicVB - sorry.)

    0 讨论(0)
  • 2020-12-21 06:20

    You mention in the comments to one of the other answers that you are taking input from the web.

    In that case you can control the date format that is being submitted by restricting user input to <select> drop lists. Make the month box list the short or long month names Jan/January Feb/February etc and then construct a date string in the format "1 Jan 2009"

    Then it doesn't matter what your locale settings are, you'll get the date the user intended.

    0 讨论(0)
提交回复
热议问题