Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

16 Январь 2022, 21:27 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Доступно и просто о работе в офисных пакетах
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: [MEMO] Импорт ics  (Прочитано 3655 раз)
0 Пользователей и 1 Гость смотрят эту тему.
dr.Faust
Администратор
**
Offline Offline

Пол: Мужской
Расположение: Ростов-на-Дону
Сообщений: 1 340


« Стартовое сообщение: 14 Октябрь 2010, 16:29 »

Не очень универсальная и грамотная, сильно упрощённая, но всё же полезная функция импорта файлов ics в массив, который потом можно влепить на лист Calc например:
Код:
REM  *****  BASIC  *****ByVal sPath As String

Function icsimport (ByVal sPath As String, ByVal sDFormat As String) As Variant
REM caption
REM Импортирует ics файл в массив
REM version
REM 1
REM returns
REM Array - Массив событий
REM in
REM sPath - путь к файлу
REM sDFormat - Формат даты и времени вида "DD.MM.YYYY HH:MM:SS"
REM raises
REM #NA! - Нехватает аргументов
REM #NF! - Файл не существует
REM #IF! - invalid file
REM discription
REM Импортирует ics файл в массив событий вида:  создание | изменение | начало | конец | событие | котегория | место
Dim aResult() As String
Dim a() As String
Dim sResult As Variant
Dim dD As Date
Dim s As String
Dim TIMESHIFT As Date ' Сдвиг местного времени
Dim TIMESHIFTV As String ' Напровление сдвига

Dim fileAccessService As Object
Dim textInputStream As Object
Dim vFileData As Object

If IsMissing(sPath) Then
icsimport = "#NA!" ' Аргумент обязателен
End If

If IsMissing(sDFormat) Then
sDFormat = "DD.MM.YYYY HH:MM:SS"
End If

If FileExists(sPath) Then
Else
icsimport = "#NF!" ' Файл не существует
End If

fileAccessService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
textInputStream = createUnoService("com.sun.star.io.TextInputStream")

vFileData = fileAccessService.openFileRead(sPath)
textInputStream.setInputStream(vFileData)

s = textInputStream.readLine
If s <> "BEGIN:VCALENDAR" Then
icsimport = "#IF!" ' invalid file
Exit Function
End If
' время - просто берём стандарт игнорирую летнее время
Do
s = textInputStream.readLine
Loop Until s = "BEGIN:VTIMEZONE" or s = "BEGIN:VEVENT"

If s = "BEGIN:VTIMEZONE" Then
Do
s = textInputStream.readLine
Loop While s <> "BEGIN:STANDARD"
Do
s = textInputStream.readLine
Loop Until InStr(s,"TZOFFSETTO:")

TIMESHIFT = TimeValue(MID(s,13,2) & ":" & MID(s,15,2) & ":00")
TIMESHIFTV = MID(s,12,1)

Do
s = textInputStream.readLine
Loop While s <> "END:STANDARD"
Else
End If
mind = 99
l = -1
ReDim aResult (mind,6)
' создание | изменение | начало | конец | событие | котегория | место
' сообщение |
s = textInputStream.readLine
Do While s <> "END:VCALENDAR"
If s = "BEGIN:VEVENT" Then
s = textInputStream.readLine
l=l+1
If l>mind Then
mind = mind + 300
ReDim Preserve aResult (mind,6)
End If
Do While s <> "END:VEVENT"



a=Split(s,":")
Select Case a(0)
Case "CREATED"
dD = DateValue(MID(s,15,2) & "/" & MID(s,13,2) & "/" & MID(s,9,4)) + TimeValue(MID(s,18,2) & ":" & MID(s,20,2) & ":" & MID(s,22,2))
If Len(s) = 24 Then
If MID(s,24,1) = "Z" Then
If TIMESHIFTV = "+" Then
dD = dD + TIMESHIFT
Else
dD = dD - TIMESHIFT
End If
End If
End If
aResult(l,0) = Format(dD,sDFormat)
Case "LAST-MODIFIED"
dD = DateValue(MID(s,21,2) & "/" & MID(s,19,2) & "/" & MID(s,15,4)) + TimeValue(MID(s,24,2) & ":" & MID(s,26,2) & ":" & MID(s,28,2))
If Len(s) = 30 Then
If MID(s,30,1) = "Z" Then
If TIMESHIFTV = "+" Then
dD = dD + TIMESHIFT
Else
dD = dD - TIMESHIFT
End If
End If
End If
aResult(l,1) = Format(dD,sDFormat)

Case "SUMMARY"
aResult(l,4) = Right(s,Len(s)-8)
Case "CATEGORIES"
aResult(l,5) = Right(s,Len(s)-11)
Case "LOCATION"
aResult(l,6) = Right(s,Len(s)-9)
Case Else
If Left(a(0),7)="DTSTART" Then
dD = DateValue(MID(a(1),7,2) & "/" & MID(a(1),5,2) & "/" & MID(a(1),1,4)) + TimeValue(MID(a(1),10,2) & ":" & MID(a(1),12,2) & ":" & MID(a(1),14,2))
aResult(l,2) = Format(dD,sDFormat)
ElseIf Left(a(0),5)="DTEND" Then
dD = DateValue(MID(a(1),7,2) & "/" & MID(a(1),5,2) & "/" & MID(a(1),1,4)) + TimeValue(MID(a(1),10,2) & ":" & MID(a(1),12,2) & ":" & MID(a(1),14,2))
aResult(l,3) = Format(dD,sDFormat)
End If

End Select
s = textInputStream.readLine
Loop
End If
s = textInputStream.readLine
Loop
textInputStream.closeInput
ReDim Preserve aResult(l,6)
icsimport = aResult
End Function
Записан

Свобода информации - свобода личности!
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!