VBCommons/parsers/ParserDate.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ParserDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' ========= Date parser ==========
' Shared module version: 20220614
' Tested in: TestCommons
' Depends on: z_ParserRegex
' Required reference: VBScript_RegExp_55
Option Explicit

Private rxDate_ As RegExp

Public day_ As Integer
Public month_ As Integer
Public year_ As Integer

Private Sub Class_Initialize()
  Set rxDate_ = New RegExp
  rxDate_.Pattern = P_DATE_CAPTURE
  rxDate_.Global = False
End Sub

Public Function Init(aDay%, aMonth%, aYear%)
  day_ = aDay
  month_ = aMonth
  year_ = aYear
End Function

Public Function Test(target$) As Boolean
  Test = rxDate_.Test(target)
End Function

Public Function Parse(target$) As Boolean
  Parse = Test(target)
  If Parse Then
    Dim matches As Object
    Set matches = rxDate_.Execute(target)
    If matches.Item(0).SubMatches(0) <> vbNullString Then
      day_ = CInt(matches.Item(0).SubMatches(0))
      month_ = ConvertDateText2Int(matches.Item(0).SubMatches(1))
      year_ = CInt(matches.Item(0).SubMatches(2))
    Else
      day_ = CInt(matches.Item(0).SubMatches(3))
      month_ = CInt(matches.Item(0).SubMatches(4))
      year_ = CInt(matches.Item(0).SubMatches(5))
    End If
  End If
End Function

Public Function GetData() As Collection
  Set GetData = New Collection
  Call GetData.Add(year_)
  Call GetData.Add(month_)
  Call GetData.Add(day_)
End Function

Public Function GetDataDescription() As Scripting.Dictionary
  Dim iData As New Scripting.Dictionary
  Call iData.Add("<22><><EFBFBD>", year_)
  Call iData.Add("<22><><EFBFBD><EFBFBD><EFBFBD>", month_)
  Call iData.Add("<22><><EFBFBD><EFBFBD>", day_)
  Set GetDataDescription = iData
End Function

Public Function Transform(sText$, sParam$) As String
  If Not Parse(sText) Then
    Transform = sText
  ElseIf sParam = "1" Then
    Transform = AsTextString
  ElseIf sParam = "2" Then
    Transform = AsDigitsString
  Else
    Transform = sText
  End If
End Function

Public Property Get IsValidDate() As Boolean
  IsValidDate = False
  
  If month_ > 12 Or month_ < 1 Then _
    Exit Property
  If day_ > 31 Or day_ < 1 Then _
    Exit Property
  
  IsValidDate = IsDate(AsDigitsString)
End Property

Public Property Get DDate() As Double
  If Not IsValidDate Then _
    Exit Function
  DDate = DateSerial(year_, month_, day_)
End Property

Public Function AsDigitsString() As String
  AsDigitsString = Format(day_, "00") & "." & Format(month_, "00") & "." & Format(year_, IIf(year_ > 100, "0000", "00"))
End Function

Public Function AsTextString() As String
  If Not IsValidDate Then
    AsTextString = "INVALID_DATE"
  Else
    AsTextString = Format(day_, "00") & " " & MonthStr(month_) & " " & Year(DateSerial(year_, 1, 1)) & " <20><><EFBFBD><EFBFBD>"
  End If
End Function

' ============
Private Function ConvertDateText2Int(sMonth$) As Integer
  If IsNumeric(sMonth) Then
    ConvertDateText2Int = CInt(sMonth)
    Exit Function
  End If
  Select Case sMonth
    Case "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 1
    Case "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 2
    Case "<22><><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 3
    Case "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 4
    Case "<22><><EFBFBD>": ConvertDateText2Int = 5
    Case "<22><><EFBFBD><EFBFBD>": ConvertDateText2Int = 6
    Case "<22><><EFBFBD><EFBFBD>": ConvertDateText2Int = 7
    Case "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 8
    Case "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 9
    Case "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 10
    Case "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 11
    Case "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>": ConvertDateText2Int = 12
    Case Else: ConvertDateText2Int = 0
  End Select
End Function

Private Function MonthStr(nMonth%) As String
  Select Case nMonth
    Case 1: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    Case 2: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    Case 3: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD>"
    Case 4: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    Case 5: MonthStr = "<22><><EFBFBD>"
    Case 6: MonthStr = "<22><><EFBFBD><EFBFBD>"
    Case 7: MonthStr = "<22><><EFBFBD><EFBFBD>"
    Case 8: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    Case 9: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    Case 10: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    Case 11: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    Case 12: MonthStr = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
    Case Else: MonthStr = "INVALID MONTH"
  End Select
End Function