[РЕШЕНО] Поиск даты в текстовой переменной

[ost]

Доброго.
Помогите решить задачу средствами StarBasic. Прошу прощения, если вопрос уже был разжеван ранее. Времени оч. мало. Беглый поиск результата не дал.
Задача: Получить в переменную sTarget дату из текстовой переменной sSource. sSource может содержать любой текст, но дата всегда в формате "DD.MM.YYYY". В sTarget нужно получить первое вхождение из sSource.

Спасибо.

[mikekaganski]

Код Выделить Развернуть


Sub Main
  Dim s As String
  s = "asdfasdfasdas12.14.1987sdflsdlfjl12.14.1987"
  Dim r As Object
  r = RegexSearch(s, "\d\d\.\d\d\.\d{4}")
  Dim s1 As String
  If (r.subRegExpressions=1) Then
    s1 = mid(s, r.startOffset(0)+1, r.endOffset(0)-r.startOffset(0))
  EndIf
  Print s1
End Sub

REM Adapted from https://forum.openoffice.org/en/forum/viewtopic.php?f=44&t=89845#p424049
REM nStart is zero-based
REM returns com.sun.star.util.SearchResult
Function RegexSearch (str As String, regex As String, Optional nStart) As Object
  If (IsMissing(nStart)) Then nStart = 0
  Dim opts As New com.sun.star.util.SearchOptions
  opts.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
  opts.searchString = regex
 
  Dim ts As Object
  ts = CreateUnoService("com.sun.star.util.TextSearch")
  ts.setOptions(opts)
  RegexSearch = ts.searchForward(str, nStart, Len(str))
End Function


[JohnSUN]

mikekaganski стреляет быстрее... 
Зато у меня тестовый пример длиннее и 14-ый месяц не прокатит 

Код Выделить Развернуть

Option Explicit
Option Base 0

Sub Main
Dim a As String, r As Variant
a = "Отчет составлен 05.04.2018 года"
r = searchDDMMYYYY(a)
MsgBox("В строке" & Chr(10) & "'" & a & "'" & Chr(10) & "найдены даты:" & Chr(10) & Join(r,Chr(10)), 64, "Результат")

a = "за период с 01.01.2016 по 31.12.2017 года"
r = searchDDMMYYYY(a)
MsgBox("В строке" & Chr(10) & "'" & a & "'" & Chr(10) & "найдены даты:" & Chr(10) & Join(r,Chr(10)), 64, "Результат")

a = "Проанализирован договор №13 от 12.11.2015 года (дата начала 01.01.2016, окончание 31.02.2018)," & Chr(10) & _
"по которому поступили платежи 13.01.2016 (123.16), 32.06.2016 (28.10) и 3 12.12.2017 года (112.45)"
r = searchDDMMYYYY(a)
MsgBox("В строке" & Chr(10) & "'" & a & "'" & Chr(10) & "найдены даты:" & Chr(10) & Join(r,Chr(10)), 64, "Результат")

a = "12.10.201615.10.201617.10.2016 есть сведения о платежах, но не указаны суммы"
r = searchDDMMYYYY(a)
MsgBox("В строке" & Chr(10) & "'" & a & "'" & Chr(10) & "найдены даты:" & Chr(10) & Join(r,Chr(10)), 64, "Результат")

End Sub

Function searchDDMMYYYY(sourceString As String) As Variant
Dim Res As Variant
Dim uTextSearch As Object, oResult As Object, r As Long, i As Long, srchPos As Long, s As String
Dim aOptions As New com.sun.star.util.SearchOptions
aOptions.searchString = "(0[1-9]|[12][0-9]|3[01])\.(0[1-9]|1[012])\.(19|20)\d\d"
aOptions.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
aOptions.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED

uTextSearch = createUnoService("com.sun.star.util.TextSearch")
uTextSearch.setOptions(aOptions)
Res = Array()

srchPos = 0
oResult = uTextSearch.searchForward(sourceString, srchPos, Len(sourceString))
Do While oResult.subRegExpressions > 0
s = Mid(sourceString, oResult.startOffset(0) + 1, oResult.endOffset(0) - oResult.startOffset(0))
addToArray(s, Res)
srchPos = oResult.endOffset(0)
oResult = uTextSearch.searchForward(sourceString, srchPos, Len(sourceString))
Loop
searchDDMMYYYY = Res
End Function

Sub addToArray(key, arr)
Dim uB As Long
uB = UBound(arr)+1
ReDim Preserve arr(uB)
arr(uB) = key
End Sub


[ost]

Ребята, спасибо за оперативность. Благодаря вам куча глупой работы пошла лесом. Огромное спасибо.
JohnSUN, отдельное спасибо за обстоятельный код.