2018/9/9 (日) 01:49:25 taka |
// Form に Memo1, Button1 を配置します
uses System.RegularExpressions, System.Net.HttpClient, System.StrUtils;
function getGoogleIcs() : string; forward;
procedure TForm1.Button1Click(Sender: TObject);
var
i, j : Integer;
k, v : string;
AMatchCollection : TMatchCollection;
AStringList : TStringList;
begin
Memo1.Clear;
Memo1.ScrollBars := ssBoth;
AStringList := TStringList.Create;
try
AMatchCollection := TRegEx.Matches(
AdjustLineBreaks(getGoogleIcs()),
'BEGIN:VEVENT\s+\n(.+?)\s+\nEND:VEVENT',
[roSingleLine, roIgnoreCase]);
for i := 0 to AMatchCollection.Count-1 do
begin
with TRegEx.Matches(
AMatchCollection.Item[i].Groups.Item[1].Value,
'^(DTSTART|SUMMARY)[:;](.+)$',
[roMultiLine, roIgnoreCase]) do
begin
k := '';
v := '';
for j := 0 to Count-1 do
begin
if Item[j].Groups.Item[1].Value = 'DTSTART' then
k := TRegEx.Replace(
Item[j].Groups.Item[2].Value,
'.+DATE:', '', [roIgnoreCase])
else
v := Item[j].Groups.Item[2].Value;
end;
AStringList.Add(k + '=' + v);
end;
end;
AStringList.Sort;
if AStringList.Count > 0 then
Memo1.Lines.Add(AStringList.Text)
else
Memo1.Lines.Add('取得失敗');
finally
AStringList.Free;
end;
end;
function getGoogleIcs() : string;
var
filename, url, data : string;
HttpClient : THTTPClient;
response : IHTTPResponse;
t : TDateTime;
begin
Result := '';
url := 'https://calendar.google.com/calendar/ical/japanese__ja@holiday.calendar.google.com/public/full.ics';
filename := ExtractFilePath(Application.ExeName) + 'full.ics';
if Not FileExists(filename) Or
(FileAge(filename, t) and (t < now - 90) ) then
begin
HttpClient := THTTPClient.Create;
try
response := HttpClient.Get(url);
if response.StatusCode = 200 then
begin
Result := response.ContentAsString();
if Not ContainsText(Result, 'BEGIN:VEVENT') then
Result := '';
end;
if Length(Result)>0 then
with TFileStream.Create(filename, fmCreate) do
try
CopyFrom(response.ContentStream, -1);
finally
Free;
end;
finally
HttpClient.Free;
end;
end;
if Length(Result)>0 then
Exit;
if FileExists(filename) then
with TBytesStream.Create() do
try
LoadFromFile(filename);
Result := UTF8ToString(RawByteString(bytes));
finally
Free;
end;
end;
|
|