How to read Google Calendar events?

[Ikerkaz]

Hi to all 

I am trying to make a basic calendar program, in order to show my future calendar events.
I would like to READ my Google Calendar and show events on screen (only read, it is not necessary to write new events), and I have no idea on how to make it.

Do you know if it is possible with QB64PE ?

Thank you very much!!!  

[Ultraman]

Erm, maybe you could download the ICS file and look at it? I know OAuth2 is possible in QB64 but I don't know how complex Google API calls would be.

[Ikerkaz]

Erm, maybe you could download the ICS file and look at it? I know OAuth2 is possible in QB64 but I don't know how complex Google API calls would be.

OMG... I did not think it could be so simple!
I tried with the QB64 help in order to download the ICS file of my calendar, and it works!!!
Now I have to understand the file structure, but I think it will be not difficult.

Thank you very much!!!

[Ultraman]

I tried making this quick and dirty parser for ICS files this morning. Maybe this will help you get a jump start. You might have to add more parts to the VEVENT type.

Code: (Select All)

Option Explicit

$NoPrefix

$Console:Only



Type VEVENT

    As String SUMMARY, LOCATION, UID, DTSTART, DTEND, SEQUENCE, STATUS, DESCRIPTION

End Type



ReDim As VEVENT events(0 To 0)

GetAllEvents "C:\Users\zspriggs\Downloads\calendar.ics", events()



Dim As Long i

For i = 0 To UBound(events)

    Print events(i).SUMMARY

    Print events(i).LOCATION

    Print events(i).DTSTART, events(i).DTEND

    Print events(i).DESCRIPTION

    Print

Next



Sub GetAllEvents (icsFile As String, vevents() As VEVENT)

    If FileExists(icsFile) Then

        Dim As Long icsHandle: icsHandle = FreeFile

        Open "B", icsHandle, icsFile

        ReDim As String eventStrings(0 To 0)

        Dim As String buf: buf = Space$(LOF(icsHandle))

        Get icsHandle, , buf

        Close icsHandle

        tokenize buf, Chr$(13) + Chr$(10), eventStrings()

        Dim As Long i, j

        For i = 0 To UBound(eventStrings)

            If InStr(eventStrings(i), "DTSTART") Or InStr(eventStrings(i), "DTEND") Then

                Select Case Mid$(eventStrings(i), 1, InStr(eventStrings(i), ";") - 1)

                    Case "DTSTART"

                        vevents(j).DTSTART = Mid$(eventStrings(i), InStr(eventStrings(i), ";") + 1)

                    Case "DTEND"

                        vevents(j).DTEND = Mid$(eventStrings(i), InStr(eventStrings(i), ";") + 1)

                End Select

            Else

                Select Case Mid$(eventStrings(i), 1, InStr(eventStrings(i), ":") - 1)

                    Case "SUMMARY"

                        vevents(j).SUMMARY = String.Replace(Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1), "\n", Chr$(10))

                        If Left$(eventStrings(i + 1), 1) = " " Then

                            Dim As Long k: k = i + 1

                            Do

                                vevents(j).SUMMARY = vevents(j).SUMMARY + String.Replace(Mid$(eventStrings(k), 2), "\n", Chr$(10))

                                k = k + 1

                            Loop Until Left$(eventStrings(k), 1) <> " "

                        End If

                    Case "LOCATION"

                        vevents(j).LOCATION = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "UID"

                        vevents(j).UID = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "SEQUENCE"

                        vevents(j).SEQUENCE = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "STATUS"

                        vevents(j).STATUS = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "DESCRIPTION"

                        vevents(j).DESCRIPTION = String.Replace(Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1), "\n", Chr$(10))

                        If Left$(eventStrings(i + 1), 1) = " " Then

                            Dim As Long l: l = i + 1

                            Do

                                vevents(j).DESCRIPTION = vevents(j).DESCRIPTION + String.Replace(Mid$(eventStrings(l), 2), "\n", Chr$(10))

                                l = l + 1

                            Loop Until Left$(eventStrings(l), 1) <> " "

                        End If

                End Select

            End If

            If eventStrings(i) = "END:VEVENT" Then

                j = j + 1

                ReDim Preserve vevents(0 To j) As VEVENT

            End If

        Next

    End If

End Sub



Function String.Replace$ (instring As String, searchString As String, replaceWith As String)

    Dim As Single j

    Dim As String outstring

    j = InStr(instring, searchString)

    If j > 0 Then

        outstring = Left$(instring, j - 1) + replaceWith + String.Replace(Right$(instring, Len(instring) - j + 1 - Len(searchString)), searchString, replaceWith)

    Else

        outstring = instring

    End If

    String.Replace = outstring

End Function



Function pointerToString$ (pointer As _Offset)

    Declare CustomType Library

        Function strlen%& (ByVal ptr As _Unsigned _Offset)

    End Declare

    Dim As _Offset length: length = strlen(pointer)

    If length Then

        Dim As _MEM pString: pString = _Mem(pointer, length)

        Dim As String ret: ret = Space$(length)

        _MemGet pString, pString.OFFSET, ret

        _MemFree pString

    End If

    pointerToString = ret

End Function



Sub tokenize (toTokenize As String, delimiters As String, StorageArray() As String)

    Declare CustomType Library

        Function strtok%& (ByVal str As _Offset, delimiters As String)

    End Declare

    Dim As _Offset tokenized

    Dim As String tokCopy: If Right$(toTokenize, 1) <> Chr$(0) Then tokCopy = toTokenize + Chr$(0) Else tokCopy = toTokenize

    Dim As String delCopy: If Right$(delimiters, 1) <> Chr$(0) Then delCopy = delimiters + Chr$(0) Else delCopy = delimiters

    Dim As _Unsigned Long lowerbound: lowerbound = LBound(StorageArray)

    Dim As _Unsigned Long i: i = lowerbound

    tokenized = strtok(_Offset(tokCopy), delCopy)

    While tokenized <> 0

        ReDim _Preserve StorageArray(lowerbound To UBound(StorageArray) + 1)

        StorageArray(i) = pointerToString(tokenized)

        tokenized = strtok(0, delCopy)

        i = i + 1

    Wend

    ReDim _Preserve StorageArray(UBound(StorageArray) - 1)

End Sub

[Ikerkaz]

I tried making this quick and dirty parser for ICS files this morning. Maybe this will help you get a jump start. You might have to add more parts to the VEVENT type.

Code: (Select All)

Option Explicit

$NoPrefix

$Console:Only



Type VEVENT

    As String SUMMARY, LOCATION, UID, DTSTART, DTEND, SEQUENCE, STATUS, DESCRIPTION

End Type



ReDim As VEVENT events(0 To 0)

GetAllEvents "C:\Users\zspriggs\Downloads\calendar.ics", events()



Dim As Long i

For i = 0 To UBound(events)

    Print events(i).SUMMARY

    Print events(i).LOCATION

    Print events(i).DTSTART, events(i).DTEND

    Print events(i).DESCRIPTION

    Print

Next



Sub GetAllEvents (icsFile As String, vevents() As VEVENT)

    If FileExists(icsFile) Then

        Dim As Long icsHandle: icsHandle = FreeFile

        Open "B", icsHandle, icsFile

        ReDim As String eventStrings(0 To 0)

        Dim As String buf: buf = Space$(LOF(icsHandle))

        Get icsHandle, , buf

        Close icsHandle

        tokenize buf, Chr$(13) + Chr$(10), eventStrings()

        Dim As Long i, j

        For i = 0 To UBound(eventStrings)

            If InStr(eventStrings(i), "DTSTART") Or InStr(eventStrings(i), "DTEND") Then

                Select Case Mid$(eventStrings(i), 1, InStr(eventStrings(i), ";") - 1)

                    Case "DTSTART"

                        vevents(j).DTSTART = Mid$(eventStrings(i), InStr(eventStrings(i), ";") + 1)

                    Case "DTEND"

                        vevents(j).DTEND = Mid$(eventStrings(i), InStr(eventStrings(i), ";") + 1)

                End Select

            Else

                Select Case Mid$(eventStrings(i), 1, InStr(eventStrings(i), ":") - 1)

                    Case "SUMMARY"

                        vevents(j).SUMMARY = String.Replace(Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1), "\n", Chr$(10))

                        If Left$(eventStrings(i + 1), 1) = " " Then

                            Dim As Long k: k = i + 1

                            Do

                                vevents(j).SUMMARY = vevents(j).SUMMARY + String.Replace(Mid$(eventStrings(k), 2), "\n", Chr$(10))

                                k = k + 1

                            Loop Until Left$(eventStrings(k), 1) <> " "

                        End If

                    Case "LOCATION"

                        vevents(j).LOCATION = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "UID"

                        vevents(j).UID = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "SEQUENCE"

                        vevents(j).SEQUENCE = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "STATUS"

                        vevents(j).STATUS = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "DESCRIPTION"

                        vevents(j).DESCRIPTION = String.Replace(Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1), "\n", Chr$(10))

                        If Left$(eventStrings(i + 1), 1) = " " Then

                            Dim As Long l: l = i + 1

                            Do

                                vevents(j).DESCRIPTION = vevents(j).DESCRIPTION + String.Replace(Mid$(eventStrings(l), 2), "\n", Chr$(10))

                                l = l + 1

                            Loop Until Left$(eventStrings(l), 1) <> " "

                        End If

                End Select

            End If

            If eventStrings(i) = "END:VEVENT" Then

                j = j + 1

                ReDim Preserve vevents(0 To j) As VEVENT

            End If

        Next

    End If

End Sub



Function String.Replace$ (instring As String, searchString As String, replaceWith As String)

    Dim As Single j

    Dim As String outstring

    j = InStr(instring, searchString)

    If j > 0 Then

        outstring = Left$(instring, j - 1) + replaceWith + String.Replace(Right$(instring, Len(instring) - j + 1 - Len(searchString)), searchString, replaceWith)

    Else

        outstring = instring

    End If

    String.Replace = outstring

End Function



Function pointerToString$ (pointer As _Offset)

    Declare CustomType Library

        Function strlen%& (ByVal ptr As _Unsigned _Offset)

    End Declare

    Dim As _Offset length: length = strlen(pointer)

    If length Then

        Dim As _MEM pString: pString = _Mem(pointer, length)

        Dim As String ret: ret = Space$(length)

        _MemGet pString, pString.OFFSET, ret

        _MemFree pString

    End If

    pointerToString = ret

End Function



Sub tokenize (toTokenize As String, delimiters As String, StorageArray() As String)

    Declare CustomType Library

        Function strtok%& (ByVal str As _Offset, delimiters As String)

    End Declare

    Dim As _Offset tokenized

    Dim As String tokCopy: If Right$(toTokenize, 1) <> Chr$(0) Then tokCopy = toTokenize + Chr$(0) Else tokCopy = toTokenize

    Dim As String delCopy: If Right$(delimiters, 1) <> Chr$(0) Then delCopy = delimiters + Chr$(0) Else delCopy = delimiters

    Dim As _Unsigned Long lowerbound: lowerbound = LBound(StorageArray)

    Dim As _Unsigned Long i: i = lowerbound

    tokenized = strtok(_Offset(tokCopy), delCopy)

    While tokenized <> 0

        ReDim _Preserve StorageArray(lowerbound To UBound(StorageArray) + 1)

        StorageArray(i) = pointerToString(tokenized)

        tokenized = strtok(0, delCopy)

        i = i + 1

    Wend

    ReDim _Preserve StorageArray(UBound(StorageArray) - 1)

End Sub

Thank you very much.
I downloaded ICS from my current Google calendar, and tried with this code, but it does not work.
It crashes in the GetAllEvents sub, it exits with no error screen

[mnrvovrfc]

You might have to add more parts to the VEVENT type.

This bears repeating. Ultraman said it was a hasty working of his, so it might need to be added to a bit with your help. "Crashes without error" is not useful feedback. Maybe you could say something about what is in your calendar? If you don't want to do it publicly here then send PM and do it.

[Ultraman]

I used it for parsing an ICS file of mine and it worked fine. Can you paste a VEVENT block from the file here? The block will start with BEGIN:VEVENT and end with END:VEVENT. It might also be useful to know if you are on Windows or not and if you are on 32 bit or 64.

Here is one from my file:

BEGIN:VEVENT
SUMMARY:Bring extra medicine home
LOCATION:School
UID:<omittedforprivacy>@google.com
DTSTART;TZID=America/New_York:20130517T060000
DTEND;TZID=America/New_York:20130517T070000
SEQUENCE:1
STATUS:CONFIRMED
END:VEVENT

[Ikerkaz]

Thank you all for the help, and sorry if I have disrespected you, it was not my intention

I think the problem is in my ICS... I have lots of events, this is one of them:

BEGIN:VEVENT
DTSTART;VALUE=DATE:20100713
DTEND;VALUE=DATE:20100714
RRULE:FREQ=YEARLY;WKST=MO;UNTIL=20160712;INTERVAL=1
DTSTAMP:20230704T141254Z
UID:trkrfvlvlrxxxxxxxmha4uk@google.com
CREATED:20100111T150325Z
LAST-MODIFIED:20230204T183447Z
SEQUENCE:0
STATUS:CONFIRMED
SUMMARY:Maria
TRANSP:TRANSPARENT
CATEGORIES:http://schemas.google.com/g/2005#event
END:VEVENT

[Ikerkaz]

In any case, I don't want to waste your time with my question, I'm sure you have many more interesting and useful questions to answer. I will continue testing on my own to learn. Thanks again to everyone

[Ultraman]

Thank you all for the help, and sorry if I have disrespected you, it was not my intention

I think the problem is in my ICS... I have lots of events, this is one of them:

BEGIN:VEVENT
DTSTART;VALUE=DATE:20100713
DTEND;VALUE=DATE:20100714
RRULE:FREQ=YEARLY;WKST=MO;UNTIL=20160712;INTERVAL=1
DTSTAMP:20230704T141254Z
UID:trkrfvlvlrxxxxxxxmha4uk@google.com
CREATED:20100111T150325Z
LAST-MODIFIED:20230204T183447Z
SEQUENCE:0
STATUS:CONFIRMED
SUMMARY:Maria
TRANSP:TRANSPARENT
CATEGORIES:http://schemas.google.com/g/2005#event
END:VEVENT

No, no, no.... There was no disrespect. Let me apologize that I made you feel that way. I sometimes answer with curt responses and I should work better on that.