mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-13 04:49:29 +02:00
Google Calendar API Demo
- bugfix for not fetching all events - only first page ist fetched with a maximum of 250 events - new loop with passing nextpageToken - nicer display of events
This commit is contained in:
parent
e3580cd0b0
commit
5c1eccf1dc
@ -1,16 +1,16 @@
|
|||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<ProjectOptions>
|
<ProjectOptions>
|
||||||
<Version Value="9"/>
|
<Version Value="12"/>
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<General>
|
<General>
|
||||||
<Flags>
|
<Flags>
|
||||||
<SaveOnlyProjectUnits Value="True"/>
|
<SaveOnlyProjectUnits Value="True"/>
|
||||||
<SaveJumpHistory Value="False"/>
|
<SaveJumpHistory Value="False"/>
|
||||||
<SaveFoldState Value="False"/>
|
<SaveFoldState Value="False"/>
|
||||||
|
<CompatibilityMode Value="True"/>
|
||||||
</Flags>
|
</Flags>
|
||||||
<SessionStorage Value="InProjectDir"/>
|
<SessionStorage Value="InProjectDir"/>
|
||||||
<MainUnit Value="0"/>
|
|
||||||
<Title Value="calendardemo"/>
|
<Title Value="calendardemo"/>
|
||||||
<ResourceType Value="res"/>
|
<ResourceType Value="res"/>
|
||||||
<UseXPManifest Value="True"/>
|
<UseXPManifest Value="True"/>
|
||||||
@ -18,9 +18,6 @@
|
|||||||
<i18n>
|
<i18n>
|
||||||
<EnableI18N LFM="False"/>
|
<EnableI18N LFM="False"/>
|
||||||
</i18n>
|
</i18n>
|
||||||
<VersionInfo>
|
|
||||||
<StringTable ProductVersion=""/>
|
|
||||||
</VersionInfo>
|
|
||||||
<BuildModes Count="2">
|
<BuildModes Count="2">
|
||||||
<Item1 Name="Default" Default="True"/>
|
<Item1 Name="Default" Default="True"/>
|
||||||
<Item2 Name="Debug">
|
<Item2 Name="Debug">
|
||||||
@ -50,13 +47,12 @@
|
|||||||
</BuildModes>
|
</BuildModes>
|
||||||
<PublishOptions>
|
<PublishOptions>
|
||||||
<Version Value="2"/>
|
<Version Value="2"/>
|
||||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
|
||||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
|
||||||
</PublishOptions>
|
</PublishOptions>
|
||||||
<RunParams>
|
<RunParams>
|
||||||
<local>
|
<FormatVersion Value="2"/>
|
||||||
<FormatVersion Value="1"/>
|
<Modes Count="1">
|
||||||
</local>
|
<Mode0 Name="default"/>
|
||||||
|
</Modes>
|
||||||
</RunParams>
|
</RunParams>
|
||||||
<RequiredPackages Count="3">
|
<RequiredPackages Count="3">
|
||||||
<Item1>
|
<Item1>
|
||||||
@ -95,7 +91,7 @@
|
|||||||
</Target>
|
</Target>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
<OtherUnitFiles Value="C:\Documents and Settings\Ludo\Mes documents\Borland Studio Projects\ODBCHTTP\synapse\source\libsvn;.."/>
|
<OtherUnitFiles Value="C:\Documents and Settings\Ludo\Mes documents\Borland Studio Projects\ODBCHTTP\synapse\source\libsvn\;.."/>
|
||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<CodeGeneration>
|
<CodeGeneration>
|
||||||
|
@ -2,13 +2,13 @@ object MainForm: TMainForm
|
|||||||
Left = 456
|
Left = 456
|
||||||
Height = 388
|
Height = 388
|
||||||
Top = 191
|
Top = 191
|
||||||
Width = 666
|
Width = 1240
|
||||||
Caption = 'Calendar Demo'
|
Caption = 'Calendar Demo'
|
||||||
ClientHeight = 388
|
ClientHeight = 388
|
||||||
ClientWidth = 666
|
ClientWidth = 1240
|
||||||
OnCreate = FormCreate
|
OnCreate = FormCreate
|
||||||
OnDestroy = FormDestroy
|
OnDestroy = FormDestroy
|
||||||
LCLVersion = '1.5'
|
LCLVersion = '2.2.4.0'
|
||||||
object BFetchCalendars: TButton
|
object BFetchCalendars: TButton
|
||||||
Left = 8
|
Left = 8
|
||||||
Height = 25
|
Height = 25
|
||||||
@ -22,11 +22,11 @@ object MainForm: TMainForm
|
|||||||
Left = 0
|
Left = 0
|
||||||
Height = 80
|
Height = 80
|
||||||
Top = 308
|
Top = 308
|
||||||
Width = 666
|
Width = 1240
|
||||||
Align = alBottom
|
Align = alBottom
|
||||||
Caption = 'Please provide Google API access code'
|
Caption = 'Please provide Google API access code'
|
||||||
ClientHeight = 52
|
ClientHeight = 52
|
||||||
ClientWidth = 662
|
ClientWidth = 1236
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
Visible = False
|
Visible = False
|
||||||
object LEAccess: TLabel
|
object LEAccess: TLabel
|
||||||
@ -38,7 +38,7 @@ object MainForm: TMainForm
|
|||||||
ParentColor = False
|
ParentColor = False
|
||||||
end
|
end
|
||||||
object BSetAccess: TButton
|
object BSetAccess: TButton
|
||||||
Left = 490
|
Left = 1064
|
||||||
Height = 25
|
Height = 25
|
||||||
Top = 9
|
Top = 9
|
||||||
Width = 75
|
Width = 75
|
||||||
@ -48,7 +48,7 @@ object MainForm: TMainForm
|
|||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
end
|
end
|
||||||
object BCancel: TButton
|
object BCancel: TButton
|
||||||
Left = 570
|
Left = 1144
|
||||||
Height = 25
|
Height = 25
|
||||||
Top = 8
|
Top = 8
|
||||||
Width = 75
|
Width = 75
|
||||||
@ -61,13 +61,13 @@ object MainForm: TMainForm
|
|||||||
Left = 112
|
Left = 112
|
||||||
Height = 18
|
Height = 18
|
||||||
Top = 8
|
Top = 8
|
||||||
Width = 362
|
Width = 936
|
||||||
Anchors = [akTop, akLeft, akRight]
|
Anchors = [akTop, akLeft, akRight]
|
||||||
TabOrder = 2
|
TabOrder = 2
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
object BFetchEvents: TButton
|
object BFetchEvents: TButton
|
||||||
Left = 548
|
Left = 1122
|
||||||
Height = 25
|
Height = 25
|
||||||
Top = 8
|
Top = 8
|
||||||
Width = 96
|
Width = 96
|
||||||
@ -87,18 +87,6 @@ object MainForm: TMainForm
|
|||||||
OnSelectionChange = LBCalendarsSelectionChange
|
OnSelectionChange = LBCalendarsSelectionChange
|
||||||
ScrollWidth = 308
|
ScrollWidth = 308
|
||||||
TabOrder = 3
|
TabOrder = 3
|
||||||
TopIndex = -1
|
|
||||||
end
|
|
||||||
object LBEvents: TListBox
|
|
||||||
Left = 328
|
|
||||||
Height = 249
|
|
||||||
Top = 40
|
|
||||||
Width = 324
|
|
||||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
|
||||||
ItemHeight = 0
|
|
||||||
ScrollWidth = 320
|
|
||||||
TabOrder = 4
|
|
||||||
TopIndex = -1
|
|
||||||
end
|
end
|
||||||
object LEvents: TLabel
|
object LEvents: TLabel
|
||||||
Left = 328
|
Left = 328
|
||||||
@ -110,4 +98,39 @@ object MainForm: TMainForm
|
|||||||
Caption = 'Events for calendar : <select a calendar>'
|
Caption = 'Events for calendar : <select a calendar>'
|
||||||
ParentColor = False
|
ParentColor = False
|
||||||
end
|
end
|
||||||
|
object SGEvents: TStringGrid
|
||||||
|
Left = 326
|
||||||
|
Height = 248
|
||||||
|
Top = 40
|
||||||
|
Width = 892
|
||||||
|
Anchors = [akTop, akLeft, akBottom]
|
||||||
|
FixedCols = 0
|
||||||
|
RowCount = 1
|
||||||
|
TabOrder = 4
|
||||||
|
ColWidths = (
|
||||||
|
64
|
||||||
|
108
|
||||||
|
108
|
||||||
|
493
|
||||||
|
112
|
||||||
|
)
|
||||||
|
Cells = (
|
||||||
|
5
|
||||||
|
0
|
||||||
|
0
|
||||||
|
'ID'
|
||||||
|
1
|
||||||
|
0
|
||||||
|
'Start Date/Time'
|
||||||
|
2
|
||||||
|
0
|
||||||
|
'End Date/Time'
|
||||||
|
3
|
||||||
|
0
|
||||||
|
'Description'
|
||||||
|
4
|
||||||
|
0
|
||||||
|
'TimeStamp'
|
||||||
|
)
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
@ -14,7 +14,8 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
synautil, IniFiles, googlebase, googleservice, googleclient, googlecalendar;
|
Grids, synautil, IniFiles, googlebase, googleservice, googleclient,
|
||||||
|
googlecalendar, opensslsockets;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -31,7 +32,7 @@ type
|
|||||||
LEvents: TLabel;
|
LEvents: TLabel;
|
||||||
LEAccess: TLabel;
|
LEAccess: TLabel;
|
||||||
LBCalendars: TListBox;
|
LBCalendars: TListBox;
|
||||||
LBEvents: TListBox;
|
SGEvents: TStringGrid;
|
||||||
procedure BCancelClick(Sender: TObject);
|
procedure BCancelClick(Sender: TObject);
|
||||||
procedure BFetchEventsClick(Sender: TObject);
|
procedure BFetchEventsClick(Sender: TObject);
|
||||||
procedure BSetAccessClick(Sender: TObject);
|
procedure BSetAccessClick(Sender: TObject);
|
||||||
@ -122,7 +123,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
LEvents.Caption:='Events for calendar : <select a calendar>';
|
LEvents.Caption:='Events for calendar : <select a calendar>';
|
||||||
LBEvents.Items.Clear;
|
SGEvents.RowCount:=1;
|
||||||
FCurrentCalendar:=Nil;
|
FCurrentCalendar:=Nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -235,31 +236,68 @@ var
|
|||||||
Entry: TEvent;
|
Entry: TEvent;
|
||||||
EN : String;
|
EN : String;
|
||||||
i:integer;
|
i:integer;
|
||||||
|
pageToken: String;
|
||||||
|
SD, ED, TS: String; //Startdate, Enddate, Timestamp
|
||||||
|
|
||||||
|
function prepareDate(EVDate: TEventDateTime):String;
|
||||||
|
begin
|
||||||
|
if EVDate.date<>0 then
|
||||||
|
prepareDate:=DateToStr(EVDate.date)
|
||||||
|
else if EVDate.dateTime<>0 then
|
||||||
|
prepareDate:=DateTimeToStr(EVDate.datetime)
|
||||||
|
else
|
||||||
|
prepareDate:='(unspecified)';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function prepareTS(EVDate: TEventDateTime):String;
|
||||||
|
begin
|
||||||
|
if EVDate.date<>0 then
|
||||||
|
prepareTS:=Format('%.*d',[12,TimeStampToMSecs(DateTimeToTimeStamp(EVDate.date)) div 1000])
|
||||||
|
else if EVDate.dateTime<>0 then
|
||||||
|
prepareTS:=Format('%.*d',[12,TimeStampToMSecs(DateTimeToTimeStamp(EVDate.dateTime)) div 1000])
|
||||||
|
else
|
||||||
|
prepareTS:='(unspecified)';
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if LBCalendars.ItemIndex<0 then
|
if LBCalendars.ItemIndex<0 then
|
||||||
Exit;
|
Exit;
|
||||||
LBEvents.Items.Clear;
|
BFetchEvents.Enabled:=False;
|
||||||
|
MainForm.Cursor:=crHourGlass;
|
||||||
|
|
||||||
|
SGEvents.RowCount:=1;
|
||||||
FreeAndNil(Events);
|
FreeAndNil(Events);
|
||||||
Events:=FCalendarAPI.EventsResource.list(FCurrentCalendar.id,'');
|
|
||||||
SaveRefreshToken;
|
SaveRefreshToken;
|
||||||
I:=0;
|
I:=0;
|
||||||
if assigned(Events) then
|
pageToken := '';
|
||||||
for Entry in Events.items do
|
repeat
|
||||||
begin
|
SD:='(unspecified)';
|
||||||
Inc(i);
|
ED:='(unspecified)';
|
||||||
EN:=Entry.Summary;
|
TS:='(unspecified)';
|
||||||
if EN='' then
|
Events:=FCalendarAPI.EventsResource.list(FCurrentCalendar.id,'pageToken='+pageToken);
|
||||||
EN:=Entry.id+' ('+Entry.description+')';
|
if assigned(Events) then begin
|
||||||
if Assigned(Entry.Start) then
|
pageToken:=Events.nextPageToken;
|
||||||
if Entry.start.date<>0 then
|
for Entry in Events.items do
|
||||||
EN:=DateToStr(Entry.start.date)+' : '+EN
|
begin
|
||||||
else if Entry.start.dateTime<>0 then
|
Inc(i);
|
||||||
EN:=DateTimeToStr(Entry.start.datetime)+' : '+EN
|
if Assigned(Entry.start) then begin
|
||||||
else
|
SD:=prepareDate(Entry.start);
|
||||||
EN:='(unspecified time) '+EN;
|
TS:=prepareTS(Entry.start);
|
||||||
LBEvents.Items.AddObject(IntToStr(i)+': '+EN,Entry);
|
end;
|
||||||
|
|
||||||
|
if Assigned(Entry._end) then
|
||||||
|
ED:=prepareDate(Entry._end);
|
||||||
|
|
||||||
|
|
||||||
|
SGEvents.InsertRowWithValues(SGEvents.RowCount,[IntToStr(i),SD,ED,Entry.Summary,TS]);
|
||||||
end;
|
end;
|
||||||
|
Application.ProcessMessages;
|
||||||
|
end;
|
||||||
|
until (not assigned(Events)) or (pageToken='');
|
||||||
|
SGEvents.SortColRow(True,4);
|
||||||
|
MainForm.Cursor:=crDefault;
|
||||||
|
BFetchEvents.Enabled:=True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Procedure TMainForm.DoUserConsent(Const AURL: String; Out AAuthCode: String);
|
Procedure TMainForm.DoUserConsent(Const AURL: String; Out AAuthCode: String);
|
||||||
|
Loading…
Reference in New Issue
Block a user