[MEMO] Импорт ics

dr.Faust · 14 октября 2010, 17: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

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

Новости:

[MEMO] Импорт ics

dr.Faust