名前
題名
▼ 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;
GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.
600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示).
(上限122000(120k)バイト)

削除キー Link