1unit frmmain; 2 3{$mode objfpc}{$H+} 4 5// Define this if you want to use synapse. 6{ $DEFINE USESYNAPSE} 7 8// For 2.6.4, synapse is currently the only option. 9// You will need to add lazsynapsewebclient to the requires list. 10{$IFDEF VER2_6} 11{$DEFINE USESYNAPSE} 12{$ENDIF} 13 14interface 15 16uses 17 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 18 ComCtrls, ActnList, Menus, ListViewFilterEdit, restbase, googleclient, 19 googlediscovery, frmgenoptions, frmview; 20 21type 22 23 { TMainForm } 24 25 TMainForm = class(TForm) 26 APreViewRest: TAction; 27 AGenCode: TAction; 28 AViewHelp: TAction; 29 ASaveREST: TAction; 30 APreferredOnly: TAction; 31 AQuit: TAction; 32 AFetch: TAction; 33 ActionList1: TActionList; 34 EFilter: TEdit; 35 ILDiscovery: TImageList; 36 Label1: TLabel; 37 LVServices: TListView; 38 MainMenu1: TMainMenu; 39 MenuItem1: TMenuItem; 40 MenuItem2: TMenuItem; 41 MAPI: TMenuItem; 42 MenuItem3: TMenuItem; 43 MenuItem4: TMenuItem; 44 MenuItem5: TMenuItem; 45 MenuItem6: TMenuItem; 46 MIQuit: TMenuItem; 47 MIPreferredOnly: TMenuItem; 48 MServices: TMenuItem; 49 SDJSON: TSaveDialog; 50 SBDiscovery: TStatusBar; 51 ToolBar1: TToolBar; 52 ToolButton1: TToolButton; 53 ToolButton2: TToolButton; 54 ToolButton3: TToolButton; 55 ToolButton4: TToolButton; 56 ToolButton5: TToolButton; 57 ToolButton6: TToolButton; 58 procedure APreViewRestExecute(Sender: TObject); 59 procedure APreViewRestUpdate(Sender: TObject); 60 procedure ASaveRESTExecute(Sender: TObject); 61 procedure ASaveRESTUpdate(Sender: TObject); 62 procedure AGenCodeExecute(Sender: TObject); 63 procedure AGenCodeUpdate(Sender: TObject); 64 procedure AQuitExecute(Sender: TObject); 65 procedure AViewHelpExecute(Sender: TObject); 66 procedure AViewHelpUpdate(Sender: TObject); 67 procedure BFetchClick(Sender: TObject); 68 procedure CBPreferredOnlyChange(Sender: TObject); 69 procedure EFilterChange(Sender: TObject); 70 procedure FormCreate(Sender: TObject); 71 private 72 { private declarations } 73 FClient : TGoogleClient; 74 FDiscoveryAPI : TDiscoveryAPI; 75 FDirectory : TDirectoryList; 76 Function CurrentAPI : TDirectoryListTypeitemsItem; 77 procedure DoFetch; 78 procedure DownLoadRestAPI(Const AName,AURL: String); 79 procedure GenerateCode(const AName, AURL: String); 80 function HttpGetBinary(AURL: String; S: TStream): Boolean; 81 procedure ShowDiscovery(PreferredOnly: Boolean; FilterOn: String); 82 procedure UpdateCaption; 83 procedure ViewFile(AFileName: String); 84 procedure ViewFile(AStream: TStream; ASyntax: TSyntax; ACaption: String); 85 procedure ViewRestAPI(const AName, AURL: String); 86 public 87 { public declarations } 88 end; 89 90var 91 MainForm: TMainForm; 92 93implementation 94 95{$R *.lfm} 96uses 97 ssl_openssl, 98 jsonparser, // needed 99 fpoauth2, lclintf, 100{$IFDEF USESYNAPSE} 101 synapsewebclient, 102 httpsend, 103{$ELSE} 104 fphttpclient, 105 fphttpwebclient, 106{$ENDIF} 107 googlediscoverytopas; 108 109{ TMainForm } 110 111procedure TMainForm.FormCreate(Sender: TObject); 112begin 113 // set up communication. 114 FClient:=TGoogleClient.Create(Self); 115{$IFDEF USESYNAPSE} 116 FClient.WebClient:=TSynapseWebClient.Create(Self); 117{$ELSE} 118 FClient.WebClient:=TFPHTTPWebClient.Create(Self); 119{$ENDIF} 120 // Register all classes so they can be streamed. 121 TDiscoveryAPI.RegisterAPIResources; 122 // create the API and hook it up to the google client. 123 FDiscoveryAPI:=TDiscoveryAPI.Create(Self); 124 FDiscoveryAPI.GoogleClient:=FClient; 125 // The code generator uses it's own objects. 126 TDiscoveryJSONToPas.RegisterAllObjects; 127 UpdateCaption; 128end; 129 130procedure TMainForm.BFetchClick(Sender: TObject); 131 132begin 133 DoFetch; 134end; 135 136procedure TMainForm.AQuitExecute(Sender: TObject); 137begin 138 Close; 139end; 140 141procedure TMainForm.AViewHelpExecute(Sender: TObject); 142begin 143 OpenURL(CurrentAPI.DocumentationLink); 144end; 145 146procedure TMainForm.AViewHelpUpdate(Sender: TObject); 147begin 148 (Sender as TAction).Enabled:=Assigned(CurrentAPI) and (CurrentAPI.documentationLink<>''); 149end; 150 151procedure TMainForm.ASaveRESTUpdate(Sender: TObject); 152begin 153 (Sender as TAction).Enabled:=Assigned(CurrentAPI) and (CurrentAPI.discoveryRestUrl<>''); 154end; 155 156procedure TMainForm.AGenCodeExecute(Sender: TObject); 157 158Var 159 DLI : TDirectoryListTypeitemsItem; 160 161begin 162 DLI:=CurrentAPI; 163 GenerateCode(DLI.Name,DLI.DiscoveryRestUrl); 164end; 165 166procedure TMainForm.AGenCodeUpdate(Sender: TObject); 167begin 168 (Sender as TAction).Enabled:=Assigned(CurrentAPI) and (CurrentAPI.discoveryRestUrl<>'') 169end; 170 171procedure TMainForm.ViewFile(AFileName : String); 172 173begin 174 With TViewForm.Create(Nil) do 175 begin 176 Caption:='Viewing file: '+AFileName; 177 FileName:=AFileName; 178 Show; 179 end; 180end; 181 182procedure TMainForm.ViewFile(AStream : TStream; ASyntax : TSyntax; ACaption : String); 183 184begin 185 With TViewForm.Create(Nil) do 186 begin 187 AStream.POsition:=0; 188 Caption:='Viewing: '+ACaption; 189 Stream:=AStream; 190 Syntax:=ASyntax; 191 FreeStream:=True; 192 Show; 193 end; 194end; 195 196Function TMainForm.HttpGetBinary(AURL : String; S : TStream) : Boolean; 197 198begin 199{$IFDEF USESYNAPSE} 200 Result:=httpsend.HttpGetBinary(AURL,S); 201{$ELSE} 202 try 203 TFPHTTPClient.SimpleGet(AURL,S); 204 S.Position:=0; 205 Result:=True; 206 except 207 Result:=False; 208 end; 209{$ENDIF} 210end; 211 212procedure TMainForm.GenerateCode(const AName, AURL: String); 213 214Var 215 S : TMemoryStream; 216 FO : TGenCodeFormOptions; 217 DP : TDiscoveryJSONToPas; 218 219begin 220 FO:=Nil; 221 DP:=Nil; 222 S:=TMemoryStream.Create; 223 try 224 if HttpGetBinary(AURL,S) then 225 begin 226 S.Position:=0; 227 FO:=TGenCodeFormOptions.Create(Self); 228 FO.UnitName:=AName; 229 If FO.ShowModal=mrOK then 230 begin 231 DP:=TDiscoveryJSONToPas.Create(Self); 232 DP.LoadFromStream(S); 233 DP.BaseClassName:=FO.BaseClass; 234 DP.OutputUnitName:=FO.UnitName; 235 DP.ExtraUnits:=FO.ExtraUnits; 236 DP.ClassPrefix:=FO.Prefix; 237 DP.SaveToFile(FO.FileName); 238 if FO.DoPreview then 239 ViewFile(FO.FileName); 240 end; 241 end; 242 Finally 243 FO.Free; 244 DP.Free; 245 S.Free; 246 end; 247end; 248 249procedure TMainForm.DownLoadRestAPI(const AName, AURL: String); 250 251Var 252 S : TMemoryStream; 253 254begin 255 S:=TMemoryStream.Create; 256 try 257 if HttpGetBinary(AURL,S) then 258 begin 259 SDJSON.FileName:='google'+aname+'.json'; 260 If SDJSON.Execute then 261 With TFileStream.Create(SDJSON.FileName,fmCreate) do 262 try 263 CopyFrom(S,0); 264 finally 265 Free; 266 end; 267 end; 268 finally 269 S.Free; 270 end; 271end; 272 273procedure TMainForm.ViewRestAPI(const AName, AURL: String); 274Var 275 S : TMemoryStream; 276 277begin 278 S:=TMemoryStream.Create; 279 try 280 if HttpGetBinary(AURL,S) then 281 begin 282 ViewFile(S,sJSON,'REST discovery for '+AName); 283 S:=Nil; 284 end; 285 finally 286 S.Free; 287 end; 288end; 289 290procedure TMainForm.ASaveRESTExecute(Sender: TObject); 291 292Var 293 DLI : TDirectoryListTypeitemsItem; 294begin 295 DLI:=CurrentAPI; 296 DownLoadRestAPI(DLI.Name,DLI.DiscoveryRestUrl); 297end; 298 299procedure TMainForm.APreViewRestUpdate(Sender: TObject); 300begin 301 (Sender as TAction).Enabled:=Assigned(CurrentAPI) and (CurrentAPI.discoveryRestUrl<>''); 302end; 303 304procedure TMainForm.APreViewRestExecute(Sender: TObject); 305 306Var 307 DLI : TDirectoryListTypeitemsItem; 308 309begin 310 DLI:=CurrentAPI; 311 ViewRestAPI(DLI.Name,DLI.DiscoveryRestUrl); 312end; 313 314procedure TMainForm.CBPreferredOnlyChange(Sender: TObject); 315begin 316 if (LVServices.Items.Count>0) then 317 ShowDiscovery(MIPreferredOnly.Checked,EFilter.Text); 318end; 319 320procedure TMainForm.EFilterChange(Sender: TObject); 321begin 322 if (LVServices.Items.Count>0) then 323 ShowDiscovery(MIPreferredOnly.Checked,EFilter.Text); 324end; 325 326procedure TMainForm.UpdateCaption; 327 328Var 329 C : Integer; 330 331begin 332 C:=LVServices.Items.Count; 333 if (C=0) then 334 Caption:='Google Discovery Service Demo' 335 else 336 Caption:=Format('Google Discovery Service Demo (%d services)',[C]); 337 SBDiscovery.Panels[0].Text:=Format('%d items',[C]); 338end; 339 340function TMainForm.CurrentAPI: TDirectoryListTypeitemsItem; 341begin 342 If Assigned(LVServices.Selected) and Assigned(LVServices.Selected.Data) then 343 Result:=TDirectoryListTypeitemsItem(LVServices.Selected.Data) 344 else 345 Result:=Nil; 346end; 347 348procedure TMainForm.ShowDiscovery(PreferredOnly : Boolean; FilterOn : String); 349 350 Function DoComma(S : TStringArray) : String; 351 Var 352 I : String; 353 begin 354 Result:=''; 355 For I in S do 356 begin 357 if Result<>'' then 358 Result:=Result+','; 359 Result:=Result+I; 360 end; 361 end; 362 363 Function Contains(S: String) : Boolean; inline; 364 begin 365 Result:=Pos(FilterOn,LowerCase(S))<>0; 366 end; 367 368 Function ShowItem (DLI : TDirectoryListTypeitemsItem) : Boolean; 369 370 begin 371 Result:=DLI.Preferred or (Not PreferredOnly); 372 if Result and (FilterOn<>'') then 373 begin 374 Result:=Contains(DLI.Name) 375 or Contains(DLI.Title) 376 or Contains(DLI.kind) 377 or Contains(DLI.description) 378 or Contains(DoComma(DLI.Labels)); 379 end; 380 end; 381Var 382 DLI : TDirectoryListTypeitemsItem; 383 LI : TListItem; 384 385begin 386 FilterOn:=LowerCase(Filteron); 387 LVServices.Items.BeginUpdate; 388 try 389 LVServices.Items.Clear; 390 LVServices.Column[1].Visible:=Not PreferredOnly; 391 For DLI in FDirectory.Items do 392 if ShowItem(DLI) then 393 begin 394 LI:=LVServices.Items.Add; 395 LI.Caption:=DLI.name; 396 LI.Data:=DLI; 397 With LI.SubItems,DLI do 398 begin 399 Add(BoolToStr(preferred,'True','False')); 400 Add(id); 401 Add(title); 402 Add(version); 403 Add(description); 404 Add(discoveryLink); 405 Add(discoveryRestUrl); 406 Add(documentationLink); 407 Add(icons.x16); 408 Add(icons.x32); 409 Add(DoComma(labels)); 410 end; 411 end; 412 UpdateCaption; 413 finally 414 LVServices.Items.EndUpdate; 415 end; 416end; 417 418procedure TMainForm.DoFetch; 419 420begin 421 // Free any previous list. 422 FreeAndNil(FDirectory); 423 // Get the new list using a default ApisResource. 424 FDirectory:=FDiscoveryAPI.ApisResource.List(); 425 ShowDiscovery(MIPreferredOnly.Checked,EFilter.Text); 426end; 427 428end. 429 430