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("год", year_) Call iData.Add("месяц", month_) Call iData.Add("день", 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)) & " года" 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 "января": ConvertDateText2Int = 1 Case "февраля": ConvertDateText2Int = 2 Case "марта": ConvertDateText2Int = 3 Case "апреля": ConvertDateText2Int = 4 Case "мая": ConvertDateText2Int = 5 Case "июня": ConvertDateText2Int = 6 Case "июля": ConvertDateText2Int = 7 Case "августа": ConvertDateText2Int = 8 Case "сентября": ConvertDateText2Int = 9 Case "октября": ConvertDateText2Int = 10 Case "ноября": ConvertDateText2Int = 11 Case "декабря": ConvertDateText2Int = 12 Case Else: ConvertDateText2Int = 0 End Select End Function Private Function MonthStr(nMonth%) As String Select Case nMonth Case 1: MonthStr = "января" Case 2: MonthStr = "февраля" Case 3: MonthStr = "марта" Case 4: MonthStr = "апреля" Case 5: MonthStr = "мая" Case 6: MonthStr = "июня" Case 7: MonthStr = "июля" Case 8: MonthStr = "августа" Case 9: MonthStr = "сентября" Case 10: MonthStr = "октября" Case 11: MonthStr = "ноября" Case 12: MonthStr = "декабря" Case Else: MonthStr = "INVALID MONTH" End Select End Function