unit frmmain; {$mode objfpc}{$H+} interface uses Classes, SysUtils, db, BufDataset, fphttpclient, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, DBCtrls, DBGrids, IniPropStorage, ComCtrls, fpJSON, SynEdit, SynHighlighterXML, XMLDatapacketReader, csvdataset; type { TMainForm } TMainForm = class(TForm) BGetresources: TButton; BFetchResource: TButton; CSVResource: TCSVDataset; DSResource: TDataSource; GResource: TDBGrid; HTCResource: TFPHTTPClient; NavResource: TDBNavigator; EURL: TEdit; EUserName: TEdit; EPassword: TEdit; GBServer: TGroupBox; PCData: TPageControl; PSMain: TIniPropStorage; LEURL: TLabel; LUserName: TLabel; LPassword: TLabel; LBResources: TListBox; PResource: TPanel; PData: TPanel; SERawData: TSynEdit; SHXML: TSynXMLSyn; TSGrid: TTabSheet; TSRaw: TTabSheet; procedure BFetchResourceClick(Sender: TObject); procedure BGetresourcesClick(Sender: TObject); procedure PSMainRestoreProperties(Sender: TObject); procedure PSMainSaveProperties(Sender: TObject); private function ConfigConnection: String; procedure DisplayResources(J: TJSONObject); procedure GetResourceData; procedure GetResources; public end; var MainForm: TMainForm; implementation uses strutils,httpprotocol, jsonparser, URIParser; {$R *.lfm} { TMainForm } Function TMainForm.ConfigConnection : String; Var P : String; begin HTCResource.UserName:=EUserName.Text; HTCResource.Password:=EPassword.Text; Result:=EURL.Text; if (Result='') then Raise Exception.Create('Need a URL to perform request'); P:=LowerCase(ParseUri(Result,False).Protocol); if (P<>'http') and (P<>'https') then Result:='http://'+Result; Result:=IncludeHTTPPathDelimiter(Result); end; procedure TMainForm.DisplayResources(J : TJSONObject); Var A : TJSONArray; I : Integer; R : TJSONObject; N : String; begin LBResources.Items.Clear; A:=J.Get('data',TJSONArray(Nil)); if not assigned(A) then exit; For I:=0 to A.Count-1 do begin R:=A.Objects[i]; N:=R.Get('name',''); if N<>'' then LBResources.Items.Add(N); end; end; procedure TMainForm.GetResources; Var S : TMemoryStream; URL : String; D : TJSONData; J : TJSONObject absolute D; begin URL:=ConfigConnection; S:=TMemoryStream.Create; try HTCResource.Get(URL+'metadata/?fmt=json&humanreadable=0',S); S.Position:=0; D:=GetJSON(S); if D is TJSONObject then DisplayResources(J); finally S.Free; end; end; procedure TMainForm.GetResourceData; Var S : TMemoryStream; URL : String; begin URL:=ConfigConnection; if LBResources.ItemIndex<>-1 then URL:=URL+LBResources.Items[LBResources.ItemIndex]; S:=TMemoryStream.Create; try // Metadata=1 enables fieldnames in 1st line HTCResource.Get(URL+'?fmt=csv&metadata=1',S); S.Position:=0; SERawData.Lines.LoadFromStream(S); S.Position:=0; CSVResource.LoadFromStream(S); finally S.Free; end; end; procedure TMainForm.BGetresourcesClick(Sender: TObject); begin GetResources; end; procedure TMainForm.PSMainRestoreProperties(Sender: TObject); Var S: String; begin S:=PSMAin.ReadString('pwd',''); if (S<>'') then EPassword.Text:=XorDecode('secret',S) else EPassword.Clear; end; procedure TMainForm.PSMainSaveProperties(Sender: TObject); Var S: String; begin S:=EPassword.Text; If (S<>'') then PSMAin.WriteString('pwd',XorEncode('secret',S)); end; procedure TMainForm.BFetchResourceClick(Sender: TObject); begin GetResourceData; end; end.