diff --git a/applications/foobot/latest_stable/foobot.ico b/applications/foobot/latest_stable/foobot.ico
new file mode 100644
index 000000000..7dc835c17
Binary files /dev/null and b/applications/foobot/latest_stable/foobot.ico differ
diff --git a/applications/foobot/latest_stable/foobot.lpi b/applications/foobot/latest_stable/foobot.lpi
new file mode 100644
index 000000000..dbea26791
--- /dev/null
+++ b/applications/foobot/latest_stable/foobot.lpi
@@ -0,0 +1,338 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/applications/foobot/latest_stable/foobot.lpr b/applications/foobot/latest_stable/foobot.lpr
new file mode 100644
index 000000000..04b446249
--- /dev/null
+++ b/applications/foobot/latest_stable/foobot.lpr
@@ -0,0 +1,53 @@
+program foobot;
+{ Foobot Interrogator
+
+ Copyright (C)2016 Gordon Bamber minsadorada@charcodelvalle.com
+
+ This source is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 of the License, or (at your option)
+ any later version.
+
+ This code is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+ details.
+
+ A copy of the GNU General Public License is available on the World Wide Web
+ at . You can also obtain it by writing
+ to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA.
+}
+
+{$ifdef Linux}
+ {$ifdef FPC_CROSSCOMPILING}
+ {$ifdef CPUARM}
+ //if GUI, then uncomment
+ //{$linklib GLESv2}
+ {$endif}
+ {$linklib libc_nonshared.a}
+ {$endif}
+{$endif}
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, umainform, foobot_objects, foobot_httpclient, ulogin, udataform,
+foobot_utility
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ Application.Title:='Foobot Interrogator';
+ RequireDerivedFormResource:=True;
+ Application.Initialize;
+ Application.CreateForm(Tmainform, mainform);
+ Application.CreateForm(Tloginform, loginform);
+ Application.CreateForm(Tdataform, dataform);
+ Application.Run;
+end.
+
diff --git a/applications/foobot/latest_stable/foobot.lps b/applications/foobot/latest_stable/foobot.lps
new file mode 100644
index 000000000..6e70d8de6
--- /dev/null
+++ b/applications/foobot/latest_stable/foobot.lps
@@ -0,0 +1,339 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/applications/foobot/latest_stable/foobot.res b/applications/foobot/latest_stable/foobot.res
new file mode 100644
index 000000000..5efaa1c11
Binary files /dev/null and b/applications/foobot/latest_stable/foobot.res differ
diff --git a/applications/foobot/latest_stable/foobot_httpclient.pas b/applications/foobot/latest_stable/foobot_httpclient.pas
new file mode 100644
index 000000000..a002bcb96
--- /dev/null
+++ b/applications/foobot/latest_stable/foobot_httpclient.pas
@@ -0,0 +1,1969 @@
+{
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2011 by the Free Pascal development team
+
+ HTTP client component.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit foobot_httpclient;
+
+{ ---------------------------------------------------------------------
+ Todo:
+ * Proxy support ?
+ ---------------------------------------------------------------------}
+{
+ TFPHTTPClient does not implement a timeout/aborting mechanism(2016.10.01), which
+ is useful when downloading a large file for example. opkman_httpclient and opkman_downloader
+ fix this issue.
+}
+
+{$mode objfpc}{$H+}
+
+{$IF FPC_VERSION = 3}
+ {$IF FPC_RELEASE > 0}
+ {$IF FPC_PATCH > 0}
+ {$DEFINE FPC311}
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+
+interface
+
+uses
+ Classes, SysUtils, ssockets, httpdefs, uriparser, base64;
+
+Const
+ // Socket Read buffer size
+ ReadBufLen = 4096;
+ // Default for MaxRedirects Request redirection is aborted after this number of redirects.
+ DefMaxRedirects = 16;
+
+Type
+ TRedirectEvent = Procedure (Sender : TObject; Const ASrc : String; Var ADest: String) of object;
+ TPasswordEvent = Procedure (Sender : TObject; Var RepeatRequest : Boolean) of object;
+ // During read of headers, ContentLength equals 0.
+ // During read of content, of Server did not specify contentlength, -1 is passed.
+ // CurrentPos is reset to 0 when the actual content is read, i.e. it is the position in the data, discarding header size.
+ TDataEvent = Procedure (Sender : TObject; Const ContentLength, CurrentPos : Int64) of object;
+ // Use this to set up a socket handler. UseSSL is true if protocol was https
+ TGetSocketHandlerEvent = Procedure (Sender : TObject; Const UseSSL : Boolean; Out AHandler : TSocketHandler) of object;
+
+ TFPCustomHTTPClient = Class;
+
+ { TProxyData }
+
+ TProxyData = Class (TPersistent)
+ private
+ FHost: string;
+ FPassword: String;
+ FPort: Word;
+ FUserName: String;
+ FHTTPClient : TFPCustomHTTPClient;
+ Protected
+ Function GetProxyHeaders : String; virtual;
+ Property HTTPClient : TFPCustomHTTPClient Read FHTTPClient;
+ Public
+ Procedure Assign(Source: TPersistent); override;
+ Property Host: string Read FHost Write FHost;
+ Property Port: Word Read FPort Write FPort;
+ Property UserName : String Read FUserName Write FUserName;
+ Property Password : String Read FPassword Write FPassword;
+ end;
+
+ { TFPCustomHTTPClient }
+ TFPCustomHTTPClient = Class(TComponent)
+ private
+ FDataRead : Int64;
+ FContentLength : Int64;
+ FAllowRedirect: Boolean;
+ FMaxRedirects: Byte;
+ FOnDataReceived: TDataEvent;
+ FOnHeaders: TNotifyEvent;
+ FOnPassword: TPasswordEvent;
+ FOnRedirect: TRedirectEvent;
+ FPassword: String;
+ FIOTimeout: Integer;
+ FSentCookies,
+ FCookies: TStrings;
+ FHTTPVersion: String;
+ FRequestBody: TStream;
+ FRequestHeaders: TStrings;
+ FResponseHeaders: TStrings;
+ FResponseStatusCode: Integer;
+ FResponseStatusText: String;
+ FServerHTTPVersion: String;
+ FSocket : TInetSocket;
+ FBuffer : Ansistring;
+ FUserName: String;
+ FOnGetSocketHandler : TGetSocketHandlerEvent;
+ FNeedToBreak: Boolean;
+ FProxy : TProxyData;
+ function CheckContentLength: Int64;
+ function CheckTransferEncoding: string;
+ function GetCookies: TStrings;
+ function GetProxy: TProxyData;
+ Procedure ResetResponse;
+ Procedure SetCookies(const AValue: TStrings);
+ procedure SetProxy(AValue: TProxyData);
+ Procedure SetRequestHeaders(const AValue: TStrings);
+ procedure SetIOTimeout(AValue: Integer);
+ protected
+ Function NoContentAllowed(ACode : Integer) : Boolean;
+ // True if we need to use a proxy: ProxyData Assigned and Hostname Set
+ Function ProxyActive : Boolean;
+ // Override this if you want to create a custom instance of proxy.
+ Function CreateProxyData : TProxyData;
+ // Called whenever data is read.
+ Procedure DoDataRead; virtual;
+ // Parse response status line. Saves status text and protocol, returns numerical code. Exception if invalid line.
+ Function ParseStatusLine(AStatusLine : String) : Integer;
+ // Construct server URL for use in request line.
+ function GetServerURL(URI: TURI): String;
+ // Read 1 line of response. Fills FBuffer
+ function ReadString: String;
+ // Check if response code is in AllowedResponseCodes. if not, an exception is raised.
+ // If AllowRedirect is true, and the result is a Redirect status code, the result is also true
+ // If the OnPassword event is set, then a 401 will also result in True.
+ function CheckResponseCode(ACode: Integer; const AllowedResponseCodes: array of Integer): Boolean; virtual;
+ // Read response from server, and write any document to Stream.
+ Procedure ReadResponse(Stream: TStream; const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); virtual;
+ // Read server response line and headers. Returns status code.
+ Function ReadResponseHeaders : integer; virtual;
+ // Allow header in request ? (currently checks only if non-empty and contains : token)
+ function AllowHeader(var AHeader: String): Boolean; virtual;
+ // Connect to the server. Must initialize FSocket.
+ Procedure ConnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
+ // Disconnect from server. Must free FSocket.
+ Procedure DisconnectFromServer; virtual;
+ // Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
+ // If non-empty, AllowedResponseCodes contains an array of response codes considered valid responses.
+ // If HandleRedirect is True, then Redirect status is accepted as a correct status, but request is not repeated.
+ // No authorization callback.
+ Procedure DoMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
+ // Send request to server: construct request line and send headers and request body.
+ Procedure SendRequest(const AMethod: String; URI: TURI); virtual;
+ // Create socket handler for protocol AProtocol. Calls OnGetSocketHandler.
+ Function GetSocketHandler(Const UseSSL : Boolean) : TSocketHandler; virtual;
+ Public
+ Constructor Create(AOwner: TComponent); override;
+ Destructor Destroy; override;
+ // Add header Aheader with value AValue to HTTPHeaders, replacing exiting values
+ Class Procedure AddHeader(HTTPHeaders : TStrings; Const AHeader,AValue : String);
+ // Index of header AHeader in httpheaders.
+ Class Function IndexOfHeader(HTTPHeaders : TStrings; Const AHeader : String) : Integer;
+ // Return value of header AHeader from httpheaders. Returns empty if it doesn't exist yet.
+ Class Function GetHeader(HTTPHeaders : TStrings; Const AHeader : String) : String;
+ // Request Header management
+ // Return index of header, -1 if not present.
+ Function IndexOfHeader(Const AHeader : String) : Integer;
+ // Add header, replacing an existing one if it exists.
+ Procedure AddHeader(Const AHeader,AValue : String);
+ // Return header value, empty if not present.
+ Function GetHeader(Const AHeader : String) : String;
+ // General-purpose call. Handles redirect and authorization retry (OnPassword).
+ Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
+ // Execute GET on server, store result in Stream, File, StringList or string
+ Procedure Get(Const AURL : String; Stream : TStream);
+ Procedure Get(Const AURL : String; const LocalFileName : String);
+ Procedure Get(Const AURL : String; Response : TStrings);
+ Function Get(Const AURL : String) : String;
+ // Check if responsecode is a redirect code that this class handles (301,302,303,307,308)
+ Class Function IsRedirect(ACode : Integer) : Boolean; virtual;
+ // If the code is a redirect, then this method must return TRUE if the next request should happen with a GET (307/308)
+ Class Function RedirectForcesGET(ACode : Integer) : Boolean; virtual;
+ // Simple class methods
+ Class Procedure SimpleGet(Const AURL : String; Stream : TStream);
+ Class Procedure SimpleGet(Const AURL : String; const LocalFileName : String);
+ Class Procedure SimpleGet(Const AURL : String; Response : TStrings);
+ Class Function SimpleGet(Const AURL : String) : String;
+ // Simple post
+ // Post URL, and Requestbody. Return response in Stream, File, TstringList or String;
+ Procedure Post(const URL: string; const Response: TStream);
+ Procedure Post(const URL: string; Response : TStrings);
+ Procedure Post(const URL: string; const LocalFileName: String);
+ function Post(const URL: string) : String;
+ // Simple class methods.
+ Class Procedure SimplePost(const URL: string; const Response: TStream);
+ Class Procedure SimplePost(const URL: string; Response : TStrings);
+ Class Procedure SimplePost(const URL: string; const LocalFileName: String);
+ Class function SimplePost(const URL: string) : String;
+ // Simple Put
+ // Put URL, and Requestbody. Return response in Stream, File, TstringList or String;
+ Procedure Put(const URL: string; const Response: TStream);
+ Procedure Put(const URL: string; Response : TStrings);
+ Procedure Put(const URL: string; const LocalFileName: String);
+ function Put(const URL: string) : String;
+ // Simple class methods.
+ Class Procedure SimplePut(const URL: string; const Response: TStream);
+ Class Procedure SimplePut(const URL: string; Response : TStrings);
+ Class Procedure SimplePut(const URL: string; const LocalFileName: String);
+ Class function SimplePut(const URL: string) : String;
+ // Simple Delete
+ // Delete URL, and Requestbody. Return response in Stream, File, TstringList or String;
+ Procedure Delete(const URL: string; const Response: TStream);
+ Procedure Delete(const URL: string; Response : TStrings);
+ Procedure Delete(const URL: string; const LocalFileName: String);
+ function Delete(const URL: string) : String;
+ // Simple class methods.
+ Class Procedure SimpleDelete(const URL: string; const Response: TStream);
+ Class Procedure SimpleDelete(const URL: string; Response : TStrings);
+ Class Procedure SimpleDelete(const URL: string; const LocalFileName: String);
+ Class function SimpleDelete(const URL: string) : String;
+ // Simple Options
+ // Options from URL, and Requestbody. Return response in Stream, File, TstringList or String;
+ Procedure Options(const URL: string; const Response: TStream);
+ Procedure Options(const URL: string; Response : TStrings);
+ Procedure Options(const URL: string; const LocalFileName: String);
+ function Options(const URL: string) : String;
+ // Simple class methods.
+ Class Procedure SimpleOptions(const URL: string; const Response: TStream);
+ Class Procedure SimpleOptions(const URL: string; Response : TStrings);
+ Class Procedure SimpleOptions(const URL: string; const LocalFileName: String);
+ Class function SimpleOptions(const URL: string) : String;
+ // Get HEAD
+ Class Procedure Head(AURL : String; Headers: TStrings);
+ // Post Form data (www-urlencoded).
+ // Formdata in string (urlencoded) or TStrings (plain text) format.
+ // Form data will be inserted in the requestbody.
+ // Return response in Stream, File, TStringList or String;
+ Procedure FormPost(const URL, FormData: string; const Response: TStream);
+ Procedure FormPost(const URL : string; FormData: TStrings; const Response: TStream);
+ Procedure FormPost(const URL, FormData: string; const Response: TStrings);
+ Procedure FormPost(const URL : string; FormData: TStrings; const Response: TStrings);
+ function FormPost(const URL, FormData: string): String;
+ function FormPost(const URL: string; FormData : TStrings): String;
+ // Simple form
+ Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStream);
+ Class Procedure SimpleFormPost(const URL : string; FormData: TStrings; const Response: TStream);
+ Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStrings);
+ Class Procedure SimpleFormPost(const URL : string; FormData: TStrings; const Response: TStrings);
+ Class function SimpleFormPost(const URL, FormData: string): String;
+ Class function SimpleFormPost(const URL: string; FormData : TStrings): String;
+ // Post a file
+ Procedure FileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
+ // Post form with a file
+ Procedure FileFormPost(const AURL: string; FormData: TStrings; AFieldName, AFileName: string; const Response: TStream);
+ // Post a stream
+ Procedure StreamFormPost(const AURL, AFieldName, AFileName: string; const AStream: TStream; const Response: TStream);
+ // Post form with a stream
+ Procedure StreamFormPost(const AURL: string; FormData: TStrings; const AFieldName, AFileName: string; const AStream: TStream; const Response: TStream);
+ // Simple form of Posting a file
+ Class Procedure SimpleFileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
+ Protected
+ // Timeouts
+ Property IOTimeout : Integer read FIOTimeout write SetIOTimeout;
+ // Before request properties.
+ // Additional headers for request. Host; and Authentication are automatically added.
+ Property RequestHeaders : TStrings Read FRequestHeaders Write SetRequestHeaders;
+ // Cookies. Set before request to send cookies to server.
+ // After request the property is filled with the cookies sent by the server.
+ Property Cookies : TStrings Read GetCookies Write SetCookies;
+ // Optional body to send (mainly in POST request)
+ Property RequestBody : TStream read FRequestBody Write FRequestBody;
+ // used HTTP version when constructing the request.
+ Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
+ // After request properties.
+ // After request, this contains the headers sent by server.
+ Property ResponseHeaders : TStrings Read FResponseHeaders;
+ // After request, HTTP version of server reply.
+ Property ServerHTTPVersion : String Read FServerHTTPVersion;
+ // After request, HTTP response status of the server.
+ Property ResponseStatusCode : Integer Read FResponseStatusCode;
+ // After request, HTTP response status text of the server.
+ Property ResponseStatusText : String Read FResponseStatusText;
+ // Allow redirect in HTTPMethod ?
+ Property AllowRedirect : Boolean Read FAllowRedirect Write FAllowRedirect;
+ // Maximum number of redirects. When this number is reached, an exception is raised.
+ Property MaxRedirects : Byte Read FMaxRedirects Write FMaxRedirects default DefMaxRedirects;
+ // Called On redirect. Dest URL can be edited.
+ // If The DEST url is empty on return, the method is aborted (with redirect status).
+ Property OnRedirect : TRedirectEvent Read FOnRedirect Write FOnRedirect;
+ // Proxy support
+ Property Proxy : TProxyData Read GetProxy Write SetProxy;
+ // Authentication.
+ // When set, they override the credentials found in the URI.
+ // They also override any Authenticate: header in Requestheaders.
+ Property UserName : String Read FUserName Write FUserName;
+ Property Password : String Read FPassword Write FPassword;
+ // If a request returns a 401, then the OnPassword event is fired.
+ // It can modify the username/password and set RepeatRequest to true;
+ Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
+ // Called whenever data is read from the connection.
+ Property OnDataReceived : TDataEvent Read FOnDataReceived Write FOnDataReceived;
+ // Called when headers have been processed.
+ Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
+ // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
+ Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
+ Property NeedToBreak: Boolean read FNeedToBreak write FNeedToBreak;
+ end;
+
+
+ TFPHTTPClient = Class(TFPCustomHTTPClient)
+ Published
+ Property IOTimeout;
+ Property RequestHeaders;
+ Property RequestBody;
+ Property ResponseHeaders;
+ Property HTTPversion;
+ Property ServerHTTPVersion;
+ Property ResponseStatusCode;
+ Property ResponseStatusText;
+ Property Cookies;
+ Property AllowRedirect;
+ Property MaxRedirects;
+ Property OnRedirect;
+ Property UserName;
+ Property Password;
+ Property OnPassword;
+ Property OnDataReceived;
+ Property OnHeaders;
+ Property OnGetSocketHandler;
+ Property Proxy;
+ Property NeedToBreak;
+ end;
+
+ EHTTPClient = Class(EHTTP);
+
+Function EncodeURLElement(S : String) : String;
+Function DecodeURLElement(Const S : String) : String;
+
+implementation
+{$if not defined(hasamiga)}
+uses sslsockets;
+{$endif}
+
+resourcestring
+ SErrInvalidProtocol = 'Invalid protocol: "%s"';
+ SErrReadingSocket = 'Error reading data from socket';
+ SErrInvalidProtocolVersion = 'Invalid protocol version in response: "%s"';
+ SErrInvalidStatusCode = 'Invalid response status code: %s';
+ SErrUnexpectedResponse = 'Unexpected response status code: %d';
+ SErrChunkTooBig = 'Chunk too big';
+ SErrChunkLineEndMissing = 'Chunk line end missing';
+ SErrMaxRedirectsReached = 'Maximum allowed redirects reached: %d';
+ //SErrRedirectAborted = 'Redirect aborted.';
+
+Const
+ CRLF = #13#10;
+
+function EncodeURLElement(S: String): String;
+
+Const
+ NotAllowed = [ ';', '/', '?', ':', '@', '=', '&', '#', '+', '_', '<', '>',
+ '"', '%', '{', '}', '|', '\', '^', '~', '[', ']', '`' ];
+
+var
+ i, o, l : Integer;
+ h: string[2];
+ P : PChar;
+ c: AnsiChar;
+begin
+ l:=Length(S);
+ If (l=0) then Exit;
+ SetLength(Result,l*3);
+ P:=Pchar(Result);
+ for I:=1 to L do
+ begin
+ C:=S[i];
+ O:=Ord(c);
+ if (O<=$20) or (O>=$7F) or (c in NotAllowed) then
+ begin
+ P^ := '%';
+ Inc(P);
+ h := IntToHex(Ord(c), 2);
+ p^ := h[1];
+ Inc(P);
+ p^ := h[2];
+ Inc(P);
+ end
+ else
+ begin
+ P^ := c;
+ Inc(p);
+ end;
+ end;
+ SetLength(Result,P-PChar(Result));
+end;
+
+function DecodeURLElement(Const S: AnsiString): AnsiString;
+
+var
+ i,l,o : Integer;
+ c: AnsiChar;
+ p : pchar;
+ h : string;
+
+begin
+ l := Length(S);
+ if l=0 then exit;
+ SetLength(Result, l);
+ P:=PChar(Result);
+ i:=1;
+ While (I<=L) do
+ begin
+ c := S[i];
+ if (c<>'%') then
+ begin
+ P^:=c;
+ Inc(P);
+ end
+ else if (I=0) and (O<=255) then
+ begin
+ P^:=char(O);
+ Inc(P);
+ Inc(I,2);
+ end;
+ end;
+ Inc(i);
+ end;
+ SetLength(Result, P-Pchar(Result));
+end;
+
+{ TProxyData }
+
+function TProxyData.GetProxyHeaders: String;
+begin
+ Result:='';
+ if (UserName<>'') then
+ Result:='Proxy-Authorization: Basic ' + EncodeStringBase64(UserName+':'+UserName);
+end;
+
+procedure TProxyData.Assign(Source: TPersistent);
+
+Var
+ D : TProxyData;
+
+begin
+ if Source is TProxyData then
+ begin
+ D:=Source as TProxyData;
+ Host:=D.Host;
+ Port:=D.Port;
+ UserName:=D.UserName;
+ Password:=D.Password;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+{ TFPCustomHTTPClient }
+
+procedure TFPCustomHTTPClient.SetRequestHeaders(const AValue: TStrings);
+begin
+ if FRequestHeaders=AValue then exit;
+ FRequestHeaders.Assign(AValue);
+end;
+
+procedure TFPCustomHTTPClient.SetIOTimeout(AValue: Integer);
+begin
+ if AValue=FIOTimeout then exit;
+ FIOTimeout:=AValue;
+ {$IFDEF FPC311}
+ if Assigned(FSocket) then
+ FSocket.IOTimeout:=AValue;
+ {$ENDIF}
+end;
+
+function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
+begin
+ Result:=((ACode div 100)=1) or ((ACode=204) or (ACode=304))
+end;
+
+function TFPCustomHTTPClient.ProxyActive: Boolean;
+begin
+ Result:=Assigned(FProxy) and (FProxy.Host<>'') and (FProxy.Port>0);
+end;
+
+function TFPCustomHTTPClient.CreateProxyData: TProxyData;
+begin
+ Result:=TProxyData.Create;
+end;
+
+procedure TFPCustomHTTPClient.DoDataRead;
+begin
+ If Assigned(FOnDataReceived) Then
+ FOnDataReceived(Self,FContentLength,FDataRead);
+end;
+
+function TFPCustomHTTPClient.IndexOfHeader(const AHeader: String): Integer;
+begin
+ Result:=IndexOfHeader(RequestHeaders,AHeader);
+end;
+
+procedure TFPCustomHTTPClient.AddHeader(const AHeader, AValue: String);
+
+begin
+ AddHeader(RequestHeaders,AHeader,AValue);
+end;
+
+function TFPCustomHTTPClient.GetHeader(const AHeader: String): String;
+
+
+begin
+ Result:=GetHeader(RequestHeaders,AHeader);
+end;
+
+function TFPCustomHTTPClient.GetServerURL(URI: TURI): String;
+
+Var
+ D : String;
+
+begin
+ D:=URI.Path;
+ If Length(D) = 0 then
+ D := '/'
+ else If (D[1]<>'/') then
+ D:='/'+D;
+ If (D[Length(D)]<>'/') then
+ D:=D+'/';
+ Result:=D+URI.Document;
+ if (URI.Params<>'') then
+ Result:=Result+'?'+URI.Params;
+ if ProxyActive then
+ begin
+ if URI.Port>0 then
+ Result:=':'+IntToStr(URI.Port)+Result;
+ Result:=URI.Protocol+'://'+URI.Host+Result;
+ end;
+end;
+
+function TFPCustomHTTPClient.GetSocketHandler(const UseSSL: Boolean): TSocketHandler;
+
+begin
+ Result:=Nil;
+ if Assigned(FonGetSocketHandler) then
+ FOnGetSocketHandler(Self,UseSSL,Result);
+ if (Result=Nil) then
+ {$if not defined(HASAMIGA)}
+ If UseSSL then
+ Result:=TSSLSocketHandler.Create
+ else
+ {$endif}
+ Result:=TSocketHandler.Create;
+end;
+
+procedure TFPCustomHTTPClient.ConnectToServer(const AHost: String;
+ APort: Integer; UseSSL : Boolean = False);
+
+Var
+ G : TSocketHandler;
+
+
+begin
+ if (Aport=0) then
+ if UseSSL then
+ Aport:=443
+ else
+ Aport:=80;
+ G:=GetSocketHandler(UseSSL);
+ FSocket:=TInetSocket.Create(AHost,APort,G);
+ try
+ {$IFDEF FPC311}
+ if FIOTimeout <> 0 then
+ FSocket.IOTimeout := FIOTimeout;
+ {$ENDIF}
+ FSocket.Connect;
+ except
+ FreeAndNil(FSocket);
+ Raise;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.DisconnectFromServer;
+
+begin
+ FreeAndNil(FSocket);
+end;
+
+function TFPCustomHTTPClient.AllowHeader(var AHeader: String): Boolean;
+
+begin
+ Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
+end;
+
+procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
+
+Var
+ PH,UN,PW,S,L : String;
+ I : Integer;
+
+begin
+ S:=Uppercase(AMethod)+' '+GetServerURL(URI)+' '+'HTTP/'+FHTTPVersion+CRLF;
+ UN:=URI.Username;
+ PW:=URI.Password;
+ if (UserName<>'') then
+ begin
+ UN:=UserName;
+ PW:=Password;
+ end;
+ If (UN<>'') then
+ begin
+ S:=S+'Authorization: Basic ' + EncodeStringBase64(UN+':'+PW)+CRLF;
+ I:=IndexOfHeader('Authorization');
+ If I<>-1 then
+ RequestHeaders.Delete(i);
+ end;
+ if Assigned(FProxy) and (FProxy.Host<>'') then
+ begin
+ PH:=FProxy.GetProxyHeaders;
+ if (PH<>'') then
+ S:=S+PH+CRLF;
+ end;
+ S:=S+'Host: '+URI.Host;
+ If (URI.Port<>0) then
+ S:=S+':'+IntToStr(URI.Port);
+ S:=S+CRLF;
+ If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
+ AddHeader('Content-Length',IntToStr(RequestBody.Size));
+ For I:=0 to FRequestHeaders.Count-1 do
+ begin
+ l:=FRequestHeaders[i];
+ If AllowHeader(L) then
+ S:=S+L+CRLF;
+ end;
+ if Assigned(FCookies) then
+ begin
+ L:='Cookie:';
+ For I:=0 to FCookies.Count-1 do
+ begin
+ If (I>0) then
+ L:=L+'; ';
+ L:=L+FCookies[i];
+ end;
+ if AllowHeader(L) then
+ S:=S+L+CRLF;
+ end;
+ FreeAndNil(FSentCookies);
+ FSentCookies:=FCookies;
+ FCookies:=Nil;
+ S:=S+CRLF;
+ FSocket.WriteBuffer(S[1],Length(S));
+ If Assigned(FRequestBody) then
+ FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
+end;
+
+function TFPCustomHTTPClient.ReadString : String;
+
+ Procedure FillBuffer;
+
+ Var
+ R : Integer;
+
+ begin
+ SetLength(FBuffer,ReadBufLen);
+ r:=FSocket.Read(FBuffer[1],ReadBufLen);
+ If r<0 then
+ Raise EHTTPClient.Create(SErrReadingSocket);
+ if (r#10) then
+ Result:=Result+#13
+ else
+ begin
+ System.Delete(FBuffer,1,1);
+ Done:=True;
+ end;
+ end;
+ if not Done then
+ begin
+ P:=Pos(#13#10,FBuffer);
+ If P=0 then
+ begin
+ L:=Length(FBuffer);
+ CheckLF:=FBuffer[L]=#13;
+ if CheckLF then
+ Result:=Result+Copy(FBuffer,1,L-1)
+ else
+ Result:=Result+FBuffer;
+ FBuffer:='';
+ end
+ else
+ begin
+ Result:=Result+Copy(FBuffer,1,P-1);
+ System.Delete(FBuffer,1,P+1);
+ Done:=True;
+ end;
+ end;
+ until Done;
+end;
+Function GetNextWord(Var S : String) : string;
+
+Const
+ WhiteSpace = [' ',#9];
+
+Var
+ P : Integer;
+
+begin
+ While (Length(S)>0) and (S[1] in WhiteSpace) do
+ Delete(S,1,1);
+ P:=Pos(' ',S);
+ If (P=0) then
+ P:=Pos(#9,S);
+ If (P=0) then
+ P:=Length(S)+1;
+ Result:=Copy(S,1,P-1);
+ Delete(S,1,P);
+end;
+
+function TFPCustomHTTPClient.ParseStatusLine(AStatusLine: String): Integer;
+
+Var
+ S : String;
+
+begin
+ S:=Uppercase(GetNextWord(AStatusLine));
+ If (Copy(S,1,5)<>'HTTP/') then
+ Raise EHTTPClient.CreateFmt(SErrInvalidProtocolVersion,[S]);
+ System.Delete(S,1,5);
+ FServerHTTPVersion:=S;
+ S:=GetNextWord(AStatusLine);
+ Result:=StrToIntDef(S,-1);
+ if Result=-1 then
+ Raise EHTTPClient.CreateFmt(SErrInvalidStatusCode,[S]);
+ FResponseStatusText:=AStatusLine;
+end;
+
+function TFPCustomHTTPClient.ReadResponseHeaders: integer;
+
+ Procedure DoCookies(S : String);
+
+ Var
+ P : Integer;
+ C : String;
+
+ begin
+ If Assigned(FCookies) then
+ FCookies.Clear;
+ P:=Pos(':',S);
+ System.Delete(S,1,P);
+ Repeat
+ if NeedToBreak then
+ Break;
+ P:=Pos(';',S);
+ If (P=0) then
+ P:=Length(S)+1;
+ C:=Trim(Copy(S,1,P-1));
+ Cookies.Add(C);
+ System.Delete(S,1,P);
+ Until (S='');
+ end;
+
+Const
+ SetCookie = 'set-cookie';
+
+Var
+ StatusLine,S : String;
+
+begin
+ StatusLine:=ReadString;
+ Result:=ParseStatusLine(StatusLine);
+ Repeat
+ if NeedToBreak then
+ Break;
+ S:=ReadString;
+ if (S<>'') then
+ begin
+ ResponseHeaders.Add(S);
+ If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
+ DoCookies(S);
+ end
+ Until (S='');
+ If Assigned(FOnHeaders) then
+ FOnHeaders(Self);
+end;
+
+function TFPCustomHTTPClient.CheckResponseCode(ACode: Integer;
+ const AllowedResponseCodes: array of Integer): Boolean;
+
+Var
+ I : Integer;
+
+begin
+ Result:=(High(AllowedResponseCodes)=-1);
+ if not Result then
+ begin
+ I:=Low(AllowedResponseCodes);
+ While (Not Result) and (I<=High(AllowedResponseCodes)) do
+ begin
+ Result:=(AllowedResponseCodes[i]=ACode);
+ Inc(I);
+ end
+ end;
+ If (Not Result) then
+ begin
+ if AllowRedirect then
+ Result:=IsRedirect(ACode);
+ If (ACode=401) then
+ Result:=Assigned(FOnPassword);
+ end;
+end;
+
+function TFPCustomHTTPClient.CheckContentLength: Int64;
+
+Const CL ='content-length:';
+
+Var
+ S : String;
+ I : integer;
+
+begin
+ Result:=-1;
+ I:=0;
+ While (Result=-1) and (I0) then
+ begin
+ FDataRead:=FDataRead+Result;
+ DoDataRead;
+ Stream.Write(FBuffer[1],Result);
+ end;
+ end;
+
+ Procedure ReadChunkedResponse;
+ { HTTP 1.1 chunked response:
+ There is no content-length. The response consists of several chunks of
+ data, each
+ - beginning with a line
+ - starting with a hex number DataSize,
+ - an optional parameter,
+ - ending with #13#10,
+ - followed by the data,
+ - ending with #13#10 (not in DataSize),
+ It ends when the DataSize is 0.
+ After the last chunk there can be a some optional entity header fields.
+ This trailer is not yet implemented. }
+ var
+ BufPos: Integer;
+
+ function FetchData(out Cnt: integer): boolean;
+
+ begin
+ SetLength(FBuffer,ReadBuflen);
+ Cnt:=FSocket.Read(FBuffer[1],length(FBuffer));
+ If Cnt<0 then
+ Raise EHTTPClient.Create(SErrReadingSocket);
+ SetLength(FBuffer,Cnt);
+ BufPos:=1;
+ Result:=Cnt>0;
+ FDataRead:=FDataRead+Cnt;
+ DoDataRead;
+ end;
+
+ Function ReadData(Data: PByte; Cnt: integer): integer;
+
+ var
+ l: Integer;
+ begin
+ Result:=0;
+ while Cnt>0 do
+ begin
+ l:=length(FBuffer)-BufPos+1;
+ if l=0 then
+ if not FetchData(l) then
+ exit; // end of stream
+ if l>Cnt then
+ l:=Cnt;
+ System.Move(FBuffer[BufPos],Data^,l);
+ inc(BufPos,l);
+ inc(Data,l);
+ inc(Result,l);
+ dec(Cnt,l);
+ end;
+ end;
+
+ var
+ c: char;
+ ChunkSize: Integer;
+ l: Integer;
+ begin
+ BufPos:=1;
+ repeat
+ if NeedToBreak then
+ Break;
+ // read ChunkSize
+ ChunkSize:=0;
+ repeat
+ if NeedToBreak then
+ Break;
+ if ReadData(@c,1)<1 then exit;
+ case c of
+ '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
+ 'a'..'f': ChunkSize:=ChunkSize*16+ord(c)-ord('a')+10;
+ 'A'..'F': ChunkSize:=ChunkSize*16+ord(c)-ord('A')+10;
+ else break;
+ end;
+ if ChunkSize>1000000 then
+ Raise EHTTPClient.Create(SErrChunkTooBig);
+ until false;
+ // read till line end
+ while (c<>#10) do
+ if ReadData(@c,1)<1 then exit;
+ if ChunkSize=0 then exit;
+ // read data
+ repeat
+ if NeedToBreak then
+ Break;
+ l:=length(FBuffer)-BufPos+1;
+ if l=0 then
+ if not FetchData(l) then
+ exit; // end of stream
+ if l>ChunkSize then
+ l:=ChunkSize;
+ if l>0 then
+ begin
+ // copy chunk data to output
+ Stream.Write(FBuffer[BufPos],l);
+ inc(BufPos,l);
+ dec(ChunkSize,l);
+ end;
+ until ChunkSize=0;
+ // read #13#10
+ if ReadData(@c,1)<1 then exit;
+ if c<>#13 then
+ Raise EHTTPClient.Create(SErrChunkLineEndMissing);
+ if ReadData(@c,1)<1 then exit;
+ if c<>#10 then
+ Raise EHTTPClient.Create(SErrChunkLineEndMissing);
+ // next chunk
+ until false;
+ end;
+
+Var
+ L : Int64;
+ LB,R : Integer;
+
+begin
+ FDataRead:=0;
+ FContentLength:=0;
+ SetLength(FBuffer,0);
+ FResponseStatusCode:=ReadResponseHeaders;
+ if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
+ Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
+ if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
+ exit;
+ if CompareText(CheckTransferEncoding,'chunked')=0 then
+ ReadChunkedResponse
+ else
+ begin
+ // Write remains of buffer to output.
+ LB:=Length(FBuffer);
+ FDataRead:=LB;
+ If (LB>0) then
+ Stream.WriteBuffer(FBuffer[1],LB);
+ // Now read the rest, if any.
+ SetLength(FBuffer,ReadBuflen);
+ L:=CheckContentLength;
+ If (L>LB) then
+ begin
+ // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
+ L:=L-LB;
+ Repeat
+ if NeedToBreak then
+ Break;
+ LB:=ReadBufLen;
+ If (LB>L) then
+ LB:=L;
+ R:=Transfer(LB);
+ L:=L-R;
+ until (L=0) or (R=0);
+ end
+ else if (L<0) and (Not NoContentAllowed(ResponseStatusCode)) then
+ begin
+ // No content-length, so we read till no more data available.
+ Repeat
+ if NeedToBreak then
+ Break;
+ R:=Transfer(ReadBufLen);
+ until (R=0);
+ end;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
+ Stream: TStream; const AllowedResponseCodes: array of Integer);
+
+Var
+ URI : TURI;
+ P,CHost : String;
+ CPort : Word;
+
+begin
+ ResetResponse;
+ URI:=ParseURI(AURL,False);
+ p:=LowerCase(URI.Protocol);
+ If Not ((P='http') or (P='https')) then
+ Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
+ if ProxyActive then
+ begin
+ CHost:=Proxy.Host;
+ CPort:=Proxy.Port;
+ end
+ else
+ begin
+ CHost:=URI.Host;
+ CPort:=URI.Port;
+ end;
+ ConnectToServer(CHost,CPort,P='https');
+ try
+ SendRequest(AMethod,URI);
+ ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
+ finally
+ DisconnectFromServer;
+ end;
+end;
+
+constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ // Infinite timeout on most platforms
+ FIOTimeout:=0;
+ FRequestHeaders:=TStringList.Create;
+ FResponseHeaders:=TStringList.Create;
+ FHTTPVersion:='1.1';
+ FMaxRedirects:=DefMaxRedirects;
+end;
+
+destructor TFPCustomHTTPClient.Destroy;
+begin
+ FreeAndNil(FProxy);
+ FreeAndNil(FCookies);
+ FreeAndNil(FSentCookies);
+ FreeAndNil(FRequestHeaders);
+ FreeAndNil(FResponseHeaders);
+ inherited Destroy;
+end;
+
+class procedure TFPCustomHTTPClient.AddHeader(HTTPHeaders: TStrings;
+ const AHeader, AValue: String);
+Var
+J: Integer;
+begin
+ j:=IndexOfHeader(HTTPHeaders,Aheader);
+ if (J<>-1) then
+ HTTPHeaders.Delete(j);
+ HTTPHeaders.Add(AHeader+': '+Avalue);
+end;
+
+
+class function TFPCustomHTTPClient.IndexOfHeader(HTTPHeaders: TStrings;
+ const AHeader: String): Integer;
+
+Var
+ L : Integer;
+ H : String;
+begin
+ H:=LowerCase(Aheader);
+ l:=Length(AHeader);
+ Result:=HTTPHeaders.Count-1;
+ While (Result>=0) and ((LowerCase(Copy(HTTPHeaders[Result],1,l)))<>h) do
+ Dec(Result);
+end;
+
+class function TFPCustomHTTPClient.GetHeader(HTTPHeaders: TStrings;
+ const AHeader: String): String;
+Var
+ I : Integer;
+begin
+ I:=IndexOfHeader(HTTPHeaders,AHeader);
+ if (I=-1) then
+ Result:=''
+ else
+ begin
+ Result:=HTTPHeaders[i];
+ I:=Pos(':',Result);
+ if (I=0) then
+ I:=Length(Result);
+ System.Delete(Result,1,I);
+ Result:=TrimLeft(Result);
+ end;
+end;
+
+procedure TFPCustomHTTPClient.ResetResponse;
+
+begin
+ FResponseStatusCode:=0;
+ FResponseStatusText:='';
+ FResponseHeaders.Clear;
+ FServerHTTPVersion:='';
+ FBuffer:='';
+end;
+
+
+procedure TFPCustomHTTPClient.HTTPMethod(const AMethod, AURL: String;
+ Stream: TStream; const AllowedResponseCodes: array of Integer);
+
+Var
+ M,L,NL : String;
+ RC : Integer;
+ RR : Boolean; // Repeat request ?
+
+begin
+ L:=AURL;
+ RC:=0;
+ RR:=False;
+ M:=AMethod;
+ Repeat
+ if FNeedToBreak then
+ Break;
+ if Not AllowRedirect then
+ DoMethod(M,L,Stream,AllowedResponseCodes)
+ else
+ begin
+ DoMethod(M,L,Stream,AllowedResponseCodes);
+ if IsRedirect(FResponseStatusCode) then
+ begin
+ Inc(RC);
+ if (RC>MaxRedirects) then
+ Raise EHTTPClient.CreateFmt(SErrMaxRedirectsReached,[RC]);
+ NL:=GetHeader(FResponseHeaders,'Location');
+ if Not Assigned(FOnRedirect) then
+ L:=NL
+ else
+ FOnRedirect(Self,L,NL);
+ if (RedirectForcesGET(FResponseStatusCode)) then
+ M:='GET';
+ L:=NL;
+ // Request has saved cookies in sentcookies.
+ FreeAndNil(FCookies);
+ FCookies:=FSentCookies;
+ FSentCookies:=Nil;
+ end;
+ end;
+ if (FResponseStatusCode=401) then
+ begin
+ RR:=False;
+ if Assigned(FOnPassword) then
+ FOnPassword(Self,RR);
+ end
+ else
+ RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'')
+ until not RR;
+end;
+
+procedure TFPCustomHTTPClient.Get(const AURL: String; Stream: TStream);
+begin
+ HTTPMethod('GET',AURL,Stream,[200]);
+end;
+
+procedure TFPCustomHTTPClient.Get(const AURL: String;
+ const LocalFileName: String);
+
+Var
+ F : TFileStream;
+
+begin
+ F:=TFileStream.Create(LocalFileName,fmCreate);
+ try
+ Get(AURL,F);
+ finally
+ F.Free;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.Get(const AURL: String; Response: TStrings);
+begin
+ Response.Text:=Get(AURL);
+end;
+
+function TFPCustomHTTPClient.Get(const AURL: String): String;
+
+Var
+ SS : TStringStream;
+
+begin
+ SS:=TStringStream.Create('');
+ try
+ Get(AURL,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+class function TFPCustomHTTPClient.IsRedirect(ACode: Integer): Boolean;
+begin
+ Case ACode of
+ 301,
+ 302,
+ 303,
+ 307,808 : Result:=True;
+ else
+ Result:=False;
+ end;
+end;
+
+class function TFPCustomHTTPClient.RedirectForcesGET(ACode: Integer): Boolean;
+begin
+ Result:=(ACode=303)
+end;
+
+
+class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
+ Stream: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Get(AURL,Stream);
+ finally
+ Free;
+ end;
+end;
+
+
+class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
+ const LocalFileName: String);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Get(AURL,LocalFileName);
+ finally
+ Free;
+ end;
+end;
+
+
+class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
+ Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Get(AURL,Response);
+ finally
+ Free;
+ end;
+end;
+
+
+class function TFPCustomHTTPClient.SimpleGet(const AURL: String): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ Result:=Get(AURL);
+ finally
+ Free;
+ end;
+end;
+
+
+procedure TFPCustomHTTPClient.Post(const URL: string; const Response: TStream);
+begin
+ HTTPMethod('POST',URL,Response,[]);
+end;
+
+
+procedure TFPCustomHTTPClient.Post(const URL: string; Response: TStrings);
+begin
+ Response.Text:=Post(URL);
+end;
+
+
+procedure TFPCustomHTTPClient.Post(const URL: string;
+ const LocalFileName: String);
+
+Var
+ F : TFileStream;
+
+begin
+ F:=TFileStream.Create(LocalFileName,fmCreate);
+ try
+ Post(URL,F);
+ finally
+ F.Free;
+ end;
+end;
+
+
+function TFPCustomHTTPClient.Post(const URL: string): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ Post(URL,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+
+class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
+ const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Post(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+
+class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
+ Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Post(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+
+class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
+ const LocalFileName: String);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Post(URL,LocalFileName);
+ finally
+ Free;
+ end;
+end;
+
+
+class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=Post(URL);
+ finally
+ Free;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.Put(const URL: string; const Response: TStream);
+begin
+ HTTPMethod('PUT',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Put(const URL: string; Response: TStrings);
+begin
+ Response.Text:=Put(URL);
+end;
+
+procedure TFPCustomHTTPClient.Put(const URL: string; const LocalFileName: String
+ );
+
+Var
+ F : TFileStream;
+
+begin
+ F:=TFileStream.Create(LocalFileName,fmCreate);
+ try
+ Put(URL,F);
+ finally
+ F.Free;
+ end;
+end;
+
+function TFPCustomHTTPClient.Put(const URL: string): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ Put(URL,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+ const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Put(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+ Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Put(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+ const LocalFileName: String);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Put(URL,LocalFileName);
+ finally
+ Free;
+ end;
+end;
+
+class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=Put(URL);
+ finally
+ Free;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string; const Response: TStream
+ );
+begin
+ HTTPMethod('DELETE',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string; Response: TStrings);
+begin
+ Response.Text:=Delete(URL);
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string;
+ const LocalFileName: String);
+
+Var
+ F : TFileStream;
+
+begin
+ F:=TFileStream.Create(LocalFileName,fmCreate);
+ try
+ Delete(URL,F);
+ finally
+ F.Free;
+ end;
+end;
+
+function TFPCustomHTTPClient.Delete(const URL: string): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ Delete(URL,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+ const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Delete(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+ Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Delete(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+ const LocalFileName: String);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Delete(URL,LocalFileName);
+ finally
+ Free;
+ end;
+end;
+
+class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=Delete(URL);
+ finally
+ Free;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string; const Response: TStream
+ );
+begin
+ HTTPMethod('OPTIONS',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string; Response: TStrings);
+begin
+ Response.Text:=Options(URL);
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string;
+ const LocalFileName: String);
+
+Var
+ F : TFileStream;
+
+begin
+ F:=TFileStream.Create(LocalFileName,fmCreate);
+ try
+ Options(URL,F);
+ finally
+ F.Free;
+ end;
+end;
+
+function TFPCustomHTTPClient.Options(const URL: string): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ Options(URL,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+ const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Options(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+ Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Options(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+ const LocalFileName: String);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Options(URL,LocalFileName);
+ finally
+ Free;
+ end;
+end;
+
+class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=Options(URL);
+ finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ HTTPMethod('HEAD', AURL, Nil, [200]);
+ Headers.Assign(ResponseHeaders);
+ Finally
+ Free;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
+ const Response: TStream);
+
+begin
+ RequestBody:=TStringStream.Create(FormData);
+ try
+ AddHeader('Content-Type','application/x-www-form-urlencoded');
+ Post(URL,Response);
+ finally
+ RequestBody.Free;
+ RequestBody:=Nil;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings;
+ const Response: TStream);
+
+Var
+ I : Integer;
+ S,N,V : String;
+
+begin
+ S:='';
+ For I:=0 to FormData.Count-1 do
+ begin
+ If (S<>'') then
+ S:=S+'&';
+ FormData.GetNameValue(i,n,v);
+ S:=S+EncodeURLElement(N)+'='+EncodeURLElement(V);
+ end;
+ FormPost(URL,S,Response);
+end;
+
+procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
+ const Response: TStrings);
+begin
+ Response.Text:=FormPost(URL,FormData);
+end;
+
+procedure TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings;
+ const Response: TStrings);
+begin
+ Response.Text:=FormPost(URL,FormData);
+end;
+
+function TFPCustomHTTPClient.FormPost(const URL, FormData: string): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ FormPost(URL,FormData,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+function TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ FormPost(URL,FormData,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
+ const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ FormPost(URL,FormData,Response);
+ Finally
+ Free;
+ end;
+end;
+
+
+class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
+ FormData: TStrings; const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ FormPost(URL,FormData,Response);
+ Finally
+ Free;
+ end;
+end;
+
+
+class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
+ const Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ FormPost(URL,FormData,Response);
+ Finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
+ FormData: TStrings; const Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ FormPost(URL,FormData,Response);
+ Finally
+ Free;
+ end;
+end;
+
+class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
+ ): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=FormPost(URL,FormData);
+ Finally
+ Free;
+ end;
+end;
+
+class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
+ FormData: TStrings): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=FormPost(URL,FormData);
+ Finally
+ Free;
+ end;
+end;
+
+
+procedure TFPCustomHTTPClient.FileFormPost(const AURL, AFieldName,
+ AFileName: string; const Response: TStream);
+begin
+ FileFormPost(AURL, nil, AFieldName, AFileName, Response);
+end;
+
+procedure TFPCustomHTTPClient.FileFormPost(const AURL: string;
+ FormData: TStrings; AFieldName, AFileName: string; const Response: TStream);
+var
+ F: TFileStream;
+begin
+ F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
+ try
+ StreamFormPost(AURL, FormData, AFieldName, ExtractFileName(AFileName), F, Response);
+ finally
+ F.Free;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.StreamFormPost(const AURL, AFieldName,
+ AFileName: string; const AStream: TStream; const Response: TStream);
+begin
+ StreamFormPost(AURL, nil, AFieldName, AFileName, AStream, Response);
+end;
+
+procedure TFPCustomHTTPClient.StreamFormPost(const AURL: string;
+ FormData: TStrings; const AFieldName, AFileName: string;
+ const AStream: TStream; const Response: TStream);
+Var
+ S, Sep : string;
+ SS : TStringStream;
+ I: Integer;
+ N,V: String;
+begin
+ Sep:=Format('%.8x_multipart_boundary',[Random($ffffff)]);
+ AddHeader('Content-Type','multipart/form-data; boundary='+Sep);
+ SS:=TStringStream.Create('');
+ try
+ if (FormData<>Nil) then
+ for I:=0 to FormData.Count -1 do
+ begin
+ // not url encoded
+ FormData.GetNameValue(I,N,V);
+ S :='--'+Sep+CRLF;
+ S:=S+Format('Content-Disposition: form-data; name="%s"'+CRLF+CRLF+'%s'+CRLF,[N, V]);
+ SS.WriteBuffer(S[1],Length(S));
+ end;
+ S:='--'+Sep+CRLF;
+ s:=s+Format('Content-Disposition: form-data; name="%s"; filename="%s"'+CRLF,[AFieldName,ExtractFileName(AFileName)]);
+ s:=s+'Content-Type: application/octet-string'+CRLF+CRLF;
+ SS.WriteBuffer(S[1],Length(S));
+ AStream.Seek(0, soFromBeginning);
+ SS.CopyFrom(AStream,AStream.Size);
+ S:=CRLF+'--'+Sep+'--'+CRLF;
+ SS.WriteBuffer(S[1],Length(S));
+ SS.Position:=0;
+ RequestBody:=SS;
+ Post(AURL,Response);
+ finally
+ RequestBody:=Nil;
+ SS.Free;
+ end;
+end;
+
+
+class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
+ AFileName: string; const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ FileFormPost(AURL,AFieldName,AFileName,Response);
+ Finally
+ Free;
+ end;
+end;
+
+end.
+
diff --git a/applications/foobot/latest_stable/foobot_objects.pas b/applications/foobot/latest_stable/foobot_objects.pas
new file mode 100644
index 000000000..3d10689a6
--- /dev/null
+++ b/applications/foobot/latest_stable/foobot_objects.pas
@@ -0,0 +1,197 @@
+unit foobot_objects;
+{ Objects for Foobot Interrogator
+
+ Copyright (C)2016 Gordon Bamber minsadorada@charcodelvalle.com
+
+ This source is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 of the License, or (at your option)
+ any later version.
+
+ This code is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+ details.
+
+ A copy of the GNU General Public License is available on the World Wide Web
+ at . You can also obtain it by writing
+ to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA.
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, ugenericcollection, fpjsonrtti;
+
+{TFoobotIdentities}
+type
+ TFoobotIdentities = class(TCollectionItem)
+ // JSON fields here as properties
+ private
+ Fuuid: string;
+ FuserId: integer;
+ FMac: string;
+ FName: string;
+ public
+ published
+ property uuid: string read Fuuid write Fuuid;
+ property userId: integer read FuserId write FuserId;
+ property mac: string read FMac write FMac;
+ property name: string read FName write FName;
+ end;
+
+ {TFoobotIdentityList}
+ TFoobotIdentityList = specialize TGenericCollection;
+
+{TFoobotIdentityObject}
+// Contains a list of TFoobotIdentities as a TCollection
+type
+ TFoobotIdentityObject = class(TPersistent)
+ private
+ FFoobotIdentityList: TFoobotIdentityList;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function SaveToFile(const AFilename: string): boolean;
+ function LoadFromFile(const AFileName: string): boolean;
+ published
+ property FoobotIdentityList: TFoobotIdentityList
+ read FFoobotIdentityList write FFoobotIdentityList;
+ end;
+
+
+type
+ TFoobotDataObject = class(TPersistent)
+ private
+ FDataPoints:Variant;
+ FSensors:TStrings;
+ FUnits:TStrings;
+ Fuuid:String;
+ FStart:Int64;
+ FEnd:Int64;
+ public
+ constructor Create;
+ Destructor Destroy; override;
+ function SaveToFile(const AFilename: string): boolean;
+ published
+ property uuid:String read Fuuid write Fuuid;
+ property start:Int64 read FStart write FStart;
+ property &end:Int64 read FEnd write FEnd;
+ property sensors:TStrings
+ read FSensors write FSensors;
+ property units:TStrings
+ read FUnits write FUnits;
+ property datapoints : Variant read FDataPoints write FDataPoints;
+ end;
+
+
+implementation
+
+constructor TFoobotDataObject.Create;
+begin
+ inherited;
+ FSensors:=TStringList.Create;
+ FUnits:=TstringList.Create;
+end;
+
+Destructor TFoobotDataObject.Destroy;
+begin
+ FSensors.Free;
+ FUnits.Free;
+ inherited Destroy;
+end;
+
+{TFoobotIdentityObject}
+constructor TFoobotIdentityObject.Create;
+begin
+ inherited;
+ FFoobotIdentityList := TFoobotIdentityList.Create;
+end;
+
+destructor TFoobotIdentityObject.Destroy;
+var
+ c: TCollectionItem;
+begin
+ for c in FFoobotIdentityList do
+ c.Free;
+ FFoobotIdentityList.Free;
+ inherited Destroy;
+end;
+
+function TFoobotIdentityObject.LoadFromFile(const AFileName: string): boolean;
+var
+ DeStreamer: TJSONDeStreamer;
+ s: TStringList;
+begin
+ Result := True;
+ s := TStringList.Create;
+ try
+ s.LoadFromFile(AFileName);
+ DeStreamer := TJSONDeStreamer.Create(nil);
+ try
+ DeStreamer.JSONToObject(s.Text, Self);
+ except
+ // Eat the exception
+ On E: Exception do
+ Result := False;
+ end;
+ finally
+ DeStreamer.Free;
+ s.Free;
+ end;
+
+end;
+
+function TFoobotIdentityObject.SaveToFile(const AFilename: string): boolean;
+var
+ Streamer: TJSONStreamer;
+ s: TStringList;
+begin
+ Result := True;
+ s := TStringList.Create;
+ try
+ Streamer := TJSONStreamer.Create(nil);
+ Streamer.Options := Streamer.Options + [jsoUseFormatString];
+ s.AddText(Streamer.ObjectToJSONString(Self));
+ try
+ s.SaveToFile(AFileName);
+ except
+ // Eat the exception
+ On E: Exception do
+ Result := False;
+ end;
+ finally
+ Streamer.Free;
+ s.Free;
+ end;
+end;
+
+
+function TFoobotDataObject.SaveToFile(const AFilename: string): boolean;
+var
+ Streamer: TJSONStreamer;
+ s: TStringList;
+begin
+ Result := True;
+ s := TStringList.Create;
+ try
+ Streamer := TJSONStreamer.Create(nil);
+ Streamer.Options := Streamer.Options + [jsoUseFormatString];
+ s.AddText(Streamer.ObjectToJSONString(Self));
+ try
+ s.SaveToFile(AFileName);
+ except
+ // Eat the exception
+ On E: Exception do
+ Result := False;
+ end;
+ finally
+ Streamer.Free;
+ s.Free;
+ end;
+end;
+
+end.
diff --git a/applications/foobot/latest_stable/foobot_utility.pas b/applications/foobot/latest_stable/foobot_utility.pas
new file mode 100644
index 000000000..b91434f8d
--- /dev/null
+++ b/applications/foobot/latest_stable/foobot_utility.pas
@@ -0,0 +1,533 @@
+unit foobot_utility;
+
+{ Foobot Interrogator Utilities
+
+ Copyright (C)2016 Gordon Bamber minsadorada@charcodelvalle.com
+
+ This source is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 of the License, or (at your option)
+ any later version.
+
+ This code is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+ details.
+
+ A copy of the GNU General Public License is available on the World Wide Web
+ at . You can also obtain it by writing
+ to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA.
+
+VERSION HISTORY
+===============
+* HighLow routines
+* Use GetAppGonfigFile for IniFile location
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Dialogs,
+ foobot_httpclient, foobot_objects, fpjson, fpjsonrtti, base64, variants,
+ DateUtils,INIFiles;
+
+const
+ FOOBOT_USER_URL = 'https://api.foobot.io/v2/user/%s/login/';
+ FOOBOT_IDENTITY_URL = 'https://api.foobot.io/v2/owner/%s/device/';
+ FOOBOT_DATA_LAST_URL = 'https://api.foobot.io/v2/device/%s/datapoint/%s/%s/%s/';
+ FOOBOT_DATA_START_FINISH_URL =
+ 'https://api.foobot.io/v2/device/%s/datapoint/%s/%s/%s/';
+ HIGHLOWMAX = 6;
+
+type
+ TDataFetchType = (dfLast, dfStartEnd);
+ TSensorType = (st_time,st_pm,st_tmp,st_hum,st_co2,st_voc,st_allpollu);
+
+function EncodeStringBase64(const s: string): string;
+function FetchAuthenticationKey(aUsername, aUserPassword: string): boolean;
+
+// Populates FoobotIdentityObject.TFoobotIdentityList collection
+function FetchFoobotIdentity(aUsername, aSecretKey: string): boolean;
+
+// Populates FoobotIdentityObject
+function FetchFoobotData(DataFetchType: TDataFetchType = dfLast;
+ iCurrentFoobot: integer = 0; iLastIntervalSeconds: integer = 3600;
+ iLastAverageBySeconds: integer = 0; iStartTimeSeconds: int64 = 0;
+ iEndTimeSeconds: int64 = 0; aSecretKey: string = 'unknown'): boolean;
+
+// Populates datapoint arrays from FoobotIdentityObject for easy access
+// - also populates HighLow arrays
+function FoobotDataObjectToArrays: boolean;
+
+// Utility functions
+function ResetArrays: boolean;
+function ResetObjects: boolean;
+Function ResetHighLows:Boolean;
+function SaveHighLows:Boolean;
+Function LoadHighLows:Boolean;
+
+var
+ HttpClient: TFPHTTPClient;
+ FoobotIdentityObject: TFoobotIdentityObject;
+ FoobotDataObject: TFoobotDataObject;
+ sAuthenticationKey: string;
+ SensorType:TSensorType;
+ SaveLoadHighLows:Boolean;
+ TheCurrentFoobot:Integer;
+ HLINI:TIniFile;
+ // Easier access to datapoints
+ // Call FoobotDataObjectToArrays to populate them
+ FoobotData_time: array of TDateTime;
+ FoobotData_pm: array of double;
+ FoobotData_tmp: array of double;
+ FoobotData_hum: array of double;
+ FoobotData_co2: array of integer;
+ FoobotData_voc: array of integer;
+ FoobotData_allpollu: array of double;
+ // Set in FoobotDataObjectToArrays
+ FoobotDataHighs:Array[0..HIGHLOWMAX]of Variant;
+ FoobotDataLows:Array[0..HIGHLOWMAX]of Variant;
+ FoobotDataHighTimes:Array[0..HIGHLOWMAX]of Variant;
+ FoobotDataLowTimes:Array[0..HIGHLOWMAX]of Variant;
+
+implementation
+function SaveHighLows:Boolean;
+Var sFoobotName:String;
+begin
+ If SaveLoadHighLows=FALSE then Exit(FALSE);
+ sFoobotName:=FoobotIdentityObject.FoobotIdentityList[TheCurrentFoobot].name;
+ If Not Assigned(HLINI) then
+ HLINI:=TIniFile.Create(ChangeFileExt(GetAppConfigFile(False),'.ini'));
+ // Store current Foobot info
+ HLINI.WriteInteger('Foobot','CurrentFoobot',TheCurrentFoobot);
+ HLINI.WriteString('Foobot','CurrentFoobotName',sFoobotName);
+
+ // Particulates
+ HLINI.WriteFloat(sFoobotName,'pmHigh',Double(FoobotDataHighs[1]));
+ HLINI.WriteDateTime(sFoobotName,'pmHighTime',TDateTime(FoobotDataHighTimes[1]));
+ HLINI.WriteFloat(sFoobotName,'pmLow',Double(FoobotDataLows[1]));
+ HLINI.WriteDateTime(sFoobotName,'pmLowTime',TDateTime(FoobotDataLowTimes[1]));
+ // Temp
+ HLINI.WriteFloat(sFoobotName,'tmpHigh',Double(FoobotDataHighs[2]));
+ HLINI.WriteDateTime(sFoobotName,'tmpHighTime',TDateTime(FoobotDataHighTimes[2]));
+ HLINI.WriteFloat(sFoobotName,'tmpLow',Double(FoobotDataLows[2]));
+ HLINI.WriteDateTime(sFoobotName,'tmpLowTime',TDateTime(FoobotDataLowTimes[2]));
+ // Humidity
+ HLINI.WriteFloat(sFoobotName,'humHigh',Double(FoobotDataHighs[3]));
+ HLINI.WriteDateTime(sFoobotName,'humHighTime',TDateTime(FoobotDataHighTimes[3]));
+ HLINI.WriteFloat(sFoobotName,'humLow',Double(FoobotDataLows[3]));
+ HLINI.WriteDateTime(sFoobotName,'humLowTime',TDateTime(FoobotDataLowTimes[3]));
+ // CO2
+ HLINI.WriteInteger(sFoobotName,'co2High',Integer(FoobotDataHighs[4]));
+ HLINI.WriteDateTime(sFoobotName,'co2HighTime',TDateTime(FoobotDataHighTimes[4]));
+ HLINI.WriteInteger(sFoobotName,'co2Low',Integer(FoobotDataLows[4]));
+ HLINI.WriteDateTime(sFoobotName,'co2LowTime',TDateTime(FoobotDataLowTimes[4]));
+ // Volatile Compounds
+ HLINI.WriteInteger(sFoobotName,'vocHigh',Integer(FoobotDataHighs[5]));
+ HLINI.WriteDateTime(sFoobotName,'vocHighTime',TDateTime(FoobotDataHighTimes[5]));
+ HLINI.WriteInteger(sFoobotName,'vocLow',Integer(FoobotDataLows[5]));
+ HLINI.WriteDateTime(sFoobotName,'vocLowTime',TDateTime(FoobotDataLowTimes[5]));
+ // All Pollution
+ HLINI.WriteFloat(sFoobotName,'allpolluHigh',Double(FoobotDataHighs[6]));
+ HLINI.WriteDateTime(sFoobotName,'allpolluHighTime',TDateTime(FoobotDataHighTimes[6]));
+ HLINI.WriteFloat(sFoobotName,'allpolluLow',Double(FoobotDataLows[6]));
+ HLINI.WriteDateTime(sFoobotName,'allpolluLowTime',TDateTime(FoobotDataLowTimes[6]));
+end;
+
+Function LoadHighLows:Boolean;
+Var sFoobotName:String;
+begin
+ If SaveLoadHighLows=FALSE then Exit(FALSE);
+ sFoobotName:=FoobotIdentityObject.FoobotIdentityList[TheCurrentFoobot].name;
+ If Not Assigned(HLINI) then
+ HLINI:=TIniFile.Create(ChangeFileExt(GetAppConfigFile(False),'.ini'));
+ // Make sure the High-Lows are for the current Foobot
+ if (HLINI.ReadString('Foobot','CurrentFoobotName','unknown') <> sFoobotName)
+ then Exit(FALSE);
+
+ // Particulates
+ FoobotDataHighs[1]:=HLINI.ReadFloat(sFoobotName,'pmHigh',0);
+ FoobotDataHighTimes[1]:=HLINI.ReadDateTime(sFoobotName,'pmHighTime',Now);
+ FoobotDataLows[1]:=HLINI.ReadFloat(sFoobotName,'pmLow',0);
+ FoobotDataLowTimes[1]:=HLINI.ReadDateTime(sFoobotName,'pmLowTime',Now);
+ // Temp
+ FoobotDataHighs[2]:=HLINI.ReadFloat(sFoobotName,'tmpHigh',0);
+ FoobotDataHighTimes[2]:=HLINI.ReadDateTime(sFoobotName,'tmpHighTime',Now);
+ FoobotDataLows[2]:=HLINI.ReadFloat(sFoobotName,'tmpLow',0);
+ FoobotDataLowTimes[2]:=HLINI.ReadDateTime(sFoobotName,'tmpLowTime',Now);
+ // Humidity
+ FoobotDataHighs[3]:=HLINI.ReadFloat(sFoobotName,'humHigh',0);
+ FoobotDataHighTimes[3]:=HLINI.ReadDateTime(sFoobotName,'humHighTime',Now);
+ FoobotDataLows[3]:=HLINI.ReadFloat(sFoobotName,'humLow',0);
+ FoobotDataLowTimes[3]:=HLINI.ReadDateTime(sFoobotName,'humLowTime',Now);
+ // CO2
+ FoobotDataHighs[4]:=HLINI.ReadInteger(sFoobotName,'co2High',0);
+ FoobotDataHighTimes[4]:=HLINI.ReadDateTime(sFoobotName,'co2HighTime',Now);
+ FoobotDataLows[4]:=HLINI.ReadInteger(sFoobotName,'co2Low',0);
+ FoobotDataLowTimes[4]:=HLINI.ReadDateTime(sFoobotName,'co2LowTime',Now);
+ // Volatile Compounds
+ FoobotDataHighs[5]:=HLINI.ReadInteger(sFoobotName,'vocHigh',0);
+ FoobotDataHighTimes[5]:=HLINI.ReadDateTime(sFoobotName,'vocHighTime',Now);
+ FoobotDataLows[5]:=HLINI.ReadInteger(sFoobotName,'vocLow',0);
+ FoobotDataLowTimes[5]:=HLINI.ReadDateTime(sFoobotName,'vocLowTime',Now);
+ // All Pollution
+ FoobotDataHighs[6]:=HLINI.ReadFloat(sFoobotName,'allpolluHigh',0);
+ FoobotDataHighTimes[6]:=HLINI.ReadDateTime(sFoobotName,'allpolluHighTime',Now);
+ FoobotDataLows[6]:=HLINI.ReadFloat(sFoobotName,'allpolluLow',0);
+ FoobotDataLowTimes[6]:=HLINI.ReadDateTime(sFoobotName,'allpolluLowTime',Now);
+end;
+
+// ToDo: Multiple Foobots?
+function FoobotDataObjectToArrays: boolean;
+var
+ J, K: integer;
+ Mydatapoint: variant;
+ {
+ dtDate, dtStart, dtEnd: TDateTime;
+ sStart, sEnd: string;
+ }
+ iUnixSecs: int64;
+// ========= Internal routines start ===========
+procedure SetHigh(iMember:Integer;aValue:Variant;aDateTime:TDateTime);
+begin
+ If aValue > FoobotDataHighs[iMember] then
+ begin
+ FoobotDataHighs[iMember]:=aValue;
+ FoobotDataHighTimes[iMember]:=aDateTime;
+ end;
+end;
+procedure SetLow(iMember:Integer;aValue:Variant;aDateTime:TDateTime);
+begin
+ If (aValue < FoobotDataLows[iMember]) OR (FoobotDataLows[iMember] = 0) then
+ begin
+ FoobotDataLows[iMember]:=aValue;
+ FoobotDataLowTimes[iMember]:=aDateTime;
+ end;
+end;
+// ========== Internal routines end =============
+begin
+ ResetArrays;
+ Result := True;
+ LoadHighLows;
+ if FoobotIdentityObject.FoobotIdentityList.Count = 0 then
+ Exit(False);
+ if FooBotDataObject.sensors.Count = 0 then
+ Exit(False);
+ if FooBotDataObject.units.Count = 0 then
+ Exit(False);
+ // J=Column, K=Row
+ for K := VarArrayLowBound(FoobotDataObject.datapoints, 1)
+ to VarArrayHighBound(FoobotDataObject.datapoints, 1) do
+ begin
+ for J := VarArrayLowBound(FoobotDataObject.datapoints[K], 1)
+ to VarArrayHighBound(FoobotDataObject.datapoints[K], 1) do
+ begin
+ Mydatapoint := FoobotDataObject.datapoints[K][J];
+ case J of
+ 0: // First field is a DateTime
+ begin
+ iUnixSecs := int64(Mydatapoint);
+ SetLength(FoobotData_time, K + 1);
+ FoobotData_time[K] := UnixToDateTime(iUnixSecs);
+ end;
+ 1: // Particulate matter
+ begin
+ SetLength(FoobotData_pm, K + 1);
+ FoobotData_pm[K] := double(MyDataPoint);
+ SetHigh(J,FoobotData_pm[K],FoobotData_time[K]);
+ SetLow(J,FoobotData_pm[K],FoobotData_time[K]);
+ end;
+ 2: // Temperature
+ begin
+ SetLength(FoobotData_tmp, K + 1);
+ FoobotData_tmp[K] := double(MyDataPoint);
+ SetHigh(J,FoobotData_tmp[K],FoobotData_time[K]);
+ SetLow(J,FoobotData_tmp[K],FoobotData_time[K]);
+ end;
+ 3: // Humidity
+ begin
+ SetLength(FoobotData_hum, K + 1);
+ FoobotData_hum[K] := double(MyDataPoint);
+ SetHigh(J,FoobotData_hum[K],FoobotData_time[K]);
+ SetLow(J,FoobotData_hum[K],FoobotData_time[K]);
+ end;
+ 4: // CO2
+ begin
+ SetLength(FoobotData_co2, K + 1);
+ FoobotData_co2[K] := integer(MyDataPoint);
+ SetHigh(J,FoobotData_co2[K],FoobotData_time[K]);
+ SetLow(J,FoobotData_co2[K],FoobotData_time[K]);
+ end;
+ 5: // Volatile compounds
+ begin
+ SetLength(FoobotData_voc, K + 1);
+ FoobotData_voc[K] := integer(MyDataPoint);
+ SetHigh(J,FoobotData_voc[K],FoobotData_time[K]);
+ SetLow(J,FoobotData_voc[K],FoobotData_time[K]);
+ end;
+ 6: // All Pollution
+ begin
+ SetLength(FoobotData_allpollu, K + 1);
+ FoobotData_allpollu[K] := double(MyDataPoint);
+ SetHigh(J,FoobotData_allpollu[K],FoobotData_time[K]);
+ SetLow(J,FoobotData_allpollu[K],FoobotData_time[K]);
+ end;
+ end; // of Case
+ end;
+ end;
+ SaveHighLows;
+end;
+Function ResetHighLows:Boolean;
+Var iCount:Integer;
+begin
+ For iCount:=0 to HIGHLOWMAX do begin
+ FoobotDataHighs[iCount]:=0;
+ FoobotDataLows[iCount]:=0;
+ end;
+ Result:=TRUE;
+end;
+
+function ResetArrays: boolean;
+begin
+ Result := True;
+ try
+ SetLength(FoobotData_time, 0);
+ SetLength(FoobotData_pm, 0);
+ SetLength(FoobotData_tmp, 0);
+ SetLength(FoobotData_hum, 0);
+ SetLength(FoobotData_co2, 0);
+ SetLength(FoobotData_voc, 0);
+ SetLength(FoobotData_allpollu, 0);
+ except
+ Result := False;
+ raise;
+ end;
+end;
+
+function ResetObjects: boolean;
+var
+ J, K: integer;
+begin
+ Result := True;
+ try
+ for K := VarArrayLowBound(FoobotDataObject.datapoints, 1)
+ to VarArrayHighBound(FoobotDataObject.datapoints, 1) do
+ for J := VarArrayLowBound(FoobotDataObject.datapoints[K], 1)
+ to VarArrayHighBound(FoobotDataObject.datapoints[K], 1) do
+ FoobotDataObject.datapoints[K][J] := 0;
+ FooBotDataObject.sensors.Clear;
+ FooBotDataObject.units.Clear;
+ FoobotIdentityObject.FoobotIdentityList.Clear;
+ except
+ Result := False;
+ raise;
+ end;
+end;
+
+function EncodeStringBase64(const s: string): string;
+
+var
+ outstream: TStringStream;
+ encoder: TBase64EncodingStream;
+begin
+ outstream := TStringStream.Create('');
+ try
+ encoder := TBase64EncodingStream.Create(outstream);
+ try
+ encoder.Write(s[1], length(s));
+ finally
+ encoder.Free;
+ end;
+ outstream.position := 0;
+ Result := outstream.readstring(outstream.size);
+ finally
+ outstream.Free;
+ end;
+end;
+
+function FetchAuthenticationKey(aUsername, aUserPassword: string): boolean;
+var
+ sRequestURL: string;
+ iCount: integer;
+begin
+ // FOOBOT_USER_URL = 'http://api.foobot.io/v2/user/%s/login/';
+ // sAuthenticationKey
+ // Looking for "x-auth-token"
+ Result := False;
+ try
+ with httpclient do
+ begin
+ ResponseHeaders.NameValueSeparator := ':';
+ AddHeader('Authorization', EncodeStringBase64(aUsername + ':' + aUserPassword));
+ sRequestURL := Format(FOOBOT_USER_URL, [aUsername]);
+ Get(sRequestURL);
+ if ResponseStatusCode <> 200 then
+ begin
+ ShowMessageFmt('Failed - Foobot server refused with code %d',
+ [ResponseStatusCode]);
+ Exit(False);
+ end;
+ for iCount := 0 to ResponseHeaders.Count do
+ ShowMessage(ResponseHeaders[iCount]);
+ Result := True;
+ end;
+ finally
+ end;
+
+end;
+
+function FetchFoobotIdentity(aUsername, aSecretKey: string): boolean;
+var
+ sUserNameURL: string;
+ JSON: TJSONStringType;
+ DeStreamer: TJSONDeStreamer;
+begin
+ Result := True; // Assume success: Look for failure
+ sAuthenticationKey:=aSecretKey;
+ try
+ with httpclient do
+ begin
+ DeStreamer := TJSONDeStreamer.Create(nil);
+ DeStreamer.Options := [jdoIgnorePropertyErrors];
+ sUserNameURL := Format(FOOBOT_IDENTITY_URL, [aUsername]);
+ ResponseHeaders.NameValueSeparator := ':';
+ AddHeader('Accept', 'application/json;charset=UTF-8');
+ AddHeader('X-API-KEY-TOKEN', aSecretKey);
+ JSON := Get(sUserNameURL);
+ if (ResponseStatusCode <> 200) then
+ case ResponseStatusCode of
+ 429:
+ begin
+ ShowMessageFmt('Cannot retieve data - too many requests to the Foobot server%s%s',
+ [LineEnding, JSON]);
+ Exit(False);
+ end;
+ else
+ begin
+ ShowMessageFmt('Cannot retieve data - Foobot server refused with code %d',
+ [ResponseStatusCode]);
+ Exit(False);
+ end;
+ end;
+ try
+ // Stream it to the object list
+ DeStreamer.JSONToObject(JSON, FoobotIdentityObject.FoobotIdentityList);
+ except
+ On E: Exception do
+ showmessagefmt('Cannot retieve data - Foobot server refused with code %s', [E.Message]);
+ On E: Exception do
+ Result := False;
+ end;
+ end;
+ finally
+ DeStreamer.Free;
+ end;
+end;
+
+function FetchFoobotData(DataFetchType: TDataFetchType;
+ iCurrentFoobot, iLastIntervalSeconds, iLastAverageBySeconds: integer;
+ iStartTimeSeconds, iEndTimeSeconds: int64; aSecretKey: string): boolean;
+var
+ sUserNameURL: string;
+ JSON: TJSONStringType;
+ DeStreamer: TJSONDeStreamer;
+ uuid: string;
+ //FOOBOT_DATA_LAST_URL = 'http://api.foobot.io/v2/device/%s/datapoint/%s/%s/%s/';
+ //FOOBOT_DATA_START_FINISH_URL = 'http://api.foobot.io/v2/device/%s/datapoint/%s/%s/%s/';
+begin
+ Result := True; // Assume success: Look for failure
+ TheCurrentFoobot:=iCurrentFoobot;
+ // Checks for integrity
+ if (FoobotIdentityObject.FoobotIdentityList.Count = 0) then
+ Exit(False);
+ if (DataFetchType = dfStartEnd) and ((iStartTimeSeconds = 0) or
+ (iEndTimeSeconds = 0)) then
+ Exit(False);
+ if (aSecretKey = 'unknown') then
+ Exit(False);
+
+ try
+ with httpclient do
+ begin
+ DeStreamer := TJSONDeStreamer.Create(nil);
+ DeStreamer.Options := [jdoIgnorePropertyErrors];
+ // secretkey := INI.ReadString('Foobot', 'Secret Key', '');
+ uuid := FoobotIdentityObject.FoobotIdentityList.Items[iCurrentFoobot].uuid;
+ case DataFetchType of
+ dfLast:
+ sUserNameURL := Format(FOOBOT_DATA_LAST_URL,
+ [uuid, IntToStr(iLastIntervalSeconds), 'last',
+ IntToStr(iLastAverageBySeconds)]);
+ dfStartEnd:
+ sUserNameURL := Format(FOOBOT_DATA_START_FINISH_URL,
+ [uuid, IntToStr(iStartTimeSeconds), IntToStr(iEndTimeSeconds),
+ IntToStr(iLastAverageBySeconds)]);
+ else
+ begin
+ Result := False;
+ Exit;
+ end;
+ end;
+ ResponseHeaders.NameValueSeparator := ':';
+
+ AddHeader('Accept', 'application/json;charset=UTF-8');
+ AddHeader('X-API-KEY-TOKEN', aSecretKey);
+ JSON := Get(sUserNameURL);
+ if (ResponseStatusCode <> 200) then
+ case ResponseStatusCode of
+ 429:
+ begin
+ ShowMessageFmt('Failed - Too many requests to the Foobot server%s%s',
+ [LineEnding, JSON]);
+ Exit(False);
+ end;
+ else
+ begin
+ ShowMessageFmt('Failed - Foobot server refused with code %d',
+ [ResponseStatusCode]);
+ Exit(False);
+ end;
+ end;
+ try
+ // Stream it to the object list
+ DeStreamer.JSONToObject(JSON, FoobotDataObject);
+ except
+ On E: Exception do
+ showmessagefmt('Failed - Foobot server refused with code %s', [E.Message]);
+ On E: Exception do
+ Result := False;
+ end;
+ end;
+ finally
+ DeStreamer.Free;
+ end;
+end;
+
+initialization
+ begin
+ HttpClient := TFPHTTPClient.Create(nil);
+ FoobotIdentityObject := TFoobotIdentityObject.Create;
+ FoobotDataObject := TFoobotDataObject.Create;
+ SaveLoadHighLows:=TRUE;
+ TheCurrentFoobot:=0;
+ end;
+
+finalization
+ begin
+ If Assigned(HLINI) then FreeAndNil(HLINI);
+ FreeAndNil(HttpClient);
+ FreeAndNil(FoobotIdentityObject);
+ FreeAndNil(FoobotDataObject);
+ SetLength(FoobotData_time, 0);
+ SetLength(FoobotData_pm, 0);
+ SetLength(FoobotData_tmp, 0);
+ SetLength(FoobotData_hum, 0);
+ SetLength(FoobotData_co2, 0);
+ SetLength(FoobotData_voc, 0);
+ SetLength(FoobotData_allpollu, 0);
+ end;
+
+end.
diff --git a/applications/foobot/latest_stable/udataform.lfm b/applications/foobot/latest_stable/udataform.lfm
new file mode 100644
index 000000000..ee6999a5f
--- /dev/null
+++ b/applications/foobot/latest_stable/udataform.lfm
@@ -0,0 +1,63 @@
+object dataform: Tdataform
+ Left = 840
+ Height = 425
+ Top = 140
+ Width = 668
+ BorderStyle = bsSingle
+ Caption = 'dataform'
+ ClientHeight = 425
+ ClientWidth = 668
+ OnCreate = FormCreate
+ OnShow = FormShow
+ Position = poMainFormCenter
+ LCLVersion = '1.7'
+ object grp_data: TGroupBox
+ Left = 0
+ Height = 368
+ Top = 0
+ Width = 668
+ Align = alTop
+ Caption = 'grp_data'
+ ClientHeight = 348
+ ClientWidth = 664
+ TabOrder = 0
+ object datagrid: TStringGrid
+ Left = 0
+ Height = 348
+ Top = 0
+ Width = 664
+ Align = alClient
+ AutoEdit = False
+ AutoFillColumns = True
+ ColCount = 7
+ ExtendedSelect = False
+ FixedCols = 0
+ Flat = True
+ HeaderHotZones = []
+ HeaderPushZones = []
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goSmoothScroll]
+ RowCount = 1
+ TabOrder = 0
+ ColWidths = (
+ 94
+ 94
+ 94
+ 94
+ 94
+ 94
+ 99
+ )
+ end
+ end
+ object BitBtn1: TBitBtn
+ Left = 297
+ Height = 30
+ Top = 382
+ Width = 75
+ Anchors = [akBottom]
+ DefaultCaption = True
+ Kind = bkClose
+ ModalResult = 11
+ TabOrder = 1
+ end
+end
diff --git a/applications/foobot/latest_stable/udataform.pas b/applications/foobot/latest_stable/udataform.pas
new file mode 100644
index 000000000..9c52968b9
--- /dev/null
+++ b/applications/foobot/latest_stable/udataform.pas
@@ -0,0 +1,120 @@
+unit udataform;
+{ Foobot Interrogator data display
+
+ Copyright (C)2016 Gordon Bamber minsadorada@charcodelvalle.com
+
+ This source is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 of the License, or (at your option)
+ any later version.
+
+ This code is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+ details.
+
+ A copy of the GNU General Public License is available on the World Wide Web
+ at . You can also obtain it by writing
+ to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA.
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
+ StdCtrls, Buttons, Variants, dateutils;
+
+type
+
+ { Tdataform }
+
+ Tdataform = class(TForm)
+ BitBtn1: TBitBtn;
+ datagrid: TStringGrid;
+ grp_data: TGroupBox;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ private
+
+ public
+
+ end;
+
+var
+ dataform: Tdataform;
+
+implementation
+
+uses umainform,foobot_utility;
+
+{$R *.lfm}
+
+{ Tdataform }
+
+procedure Tdataform.FormCreate(Sender: TObject);
+begin
+ Icon := Application.Icon;
+ Caption := Application.Title + ' Data';
+end;
+
+procedure Tdataform.FormShow(Sender: TObject);
+var
+ J, K, iCount: integer;
+ Mydatapoint: variant;
+ dtDate, dtStart, dtEnd: TDateTime;
+ sStart, sEnd: string;
+ iUnixSecs: int64;
+begin
+ with mainform do
+ begin
+ dtStart := UnixToDateTime(FoobotDataObject.Start);
+ dtEnd := UnixToDateTime(FoobotDataObject.&end);
+ sStart := FormatDateTime('dd/mm tt', dtStart);
+ sEnd := FormatDateTime('dd/mm tt', dtEnd);
+
+ grp_data.Caption := 'Foobot ' +
+ FoobotIdentityObject.FoobotIdentityList.Items[CurrentFoobot].Name +
+ ' From ' + sStart + ' to ' + sEnd;
+ if mainform.FetchType = dfLast then
+ grp_data.Caption := grp_data.Caption + ' Capture last = ' +
+ mainform.rg_interval.Items[mainform.rg_interval.ItemIndex] + ', ';
+ grp_data.Caption := grp_data.Caption + 'Average by = ' +
+ mainform.rg_intervalAverageBy.Items[mainform.rg_intervalAverageBy.ItemIndex] + ')';
+
+ for iCount := 0 to Pred(FoobotDataObject.sensors.Count) do
+ begin
+ datagrid.Cells[iCount, 0] :=
+ FoobotDataObject.sensors[iCount] + ' (' + FoobotDataObject.units[iCount] + ')';
+ end;
+ // J=Column, K=Row
+ for K := VarArrayLowBound(FoobotDataObject.datapoints, 1)
+ to VarArrayHighBound(FoobotDataObject.datapoints, 1) do
+ begin
+ for J := VarArrayLowBound(FoobotDataObject.datapoints[K], 1)
+ to VarArrayHighBound(FoobotDataObject.datapoints[K], 1) do
+ begin
+ Mydatapoint := FoobotDataObject.datapoints[K][J];
+ dataGrid.RowCount := K + 2;
+ if J = 0 then // First field is a DateTime
+ begin
+ if K = VarArrayHighBound(FoobotDataObject.datapoints, 1) then
+ datagrid.Cells[J, K + 1] := 'Latest' // Last entry is always latest
+ else
+ begin
+ iUnixSecs := int64(Mydatapoint);
+ dtDate := UnixToDateTime(iUnixSecs);
+ datagrid.Cells[J, K + 1] := FormatDateTime('dd/mm - tt', dtDate);
+ end;
+ end
+ else
+ datagrid.Cells[J, K + 1] := VarToStr(Mydatapoint);
+ end;
+ end;
+
+ end;
+end;
+
+end.
diff --git a/applications/foobot/latest_stable/ugenericcollection.pas b/applications/foobot/latest_stable/ugenericcollection.pas
new file mode 100644
index 000000000..4d9655516
--- /dev/null
+++ b/applications/foobot/latest_stable/ugenericcollection.pas
@@ -0,0 +1,50 @@
+unit ugenericcollection;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+type
+
+ { TGenericCollection }
+
+ generic TGenericCollection = class(TCollection)
+ private
+ function GetItems(Index: integer): T;
+ procedure SetItems(Index: integer; AValue: T);
+ public
+ constructor Create;
+ public
+ function Add: T;
+ public
+ property Items[Index: integer]: T read GetItems write SetItems; default;
+ end;
+
+implementation
+
+{ TGenericCollection }
+
+function TGenericCollection.GetItems(Index: integer): T;
+begin
+ Result := T(inherited Items[Index]);
+end;
+
+procedure TGenericCollection.SetItems(Index: integer; AValue: T);
+begin
+ Items[Index].Assign(AValue);
+end;
+
+constructor TGenericCollection.Create;
+begin
+ inherited Create(T);
+end;
+
+function TGenericCollection.Add: T;
+begin
+ Result := T(inherited Add);
+end;
+
+end.
diff --git a/applications/foobot/latest_stable/ulogin.lfm b/applications/foobot/latest_stable/ulogin.lfm
new file mode 100644
index 000000000..f69e11b4f
--- /dev/null
+++ b/applications/foobot/latest_stable/ulogin.lfm
@@ -0,0 +1,84 @@
+object loginform: Tloginform
+ Left = 256
+ Height = 141
+ Top = 472
+ Width = 442
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsSingle
+ Caption = 'Foobot Login'
+ ClientHeight = 141
+ ClientWidth = 442
+ OnCloseQuery = FormCloseQuery
+ OnCreate = FormCreate
+ Position = poMainFormCenter
+ LCLVersion = '1.7'
+ Scaled = True
+ object GroupBox1: TGroupBox
+ Left = 0
+ Height = 88
+ Top = 0
+ Width = 442
+ Align = alTop
+ Caption = 'Your FooBot information'
+ ClientHeight = 68
+ ClientWidth = 438
+ TabOrder = 0
+ object edt_emailaddress: TLabeledEdit
+ Left = 16
+ Height = 23
+ Hint = 'This is your Foobot LogIn name'
+ Top = 24
+ Width = 192
+ EditLabel.AnchorSideLeft.Control = edt_emailaddress
+ EditLabel.AnchorSideRight.Control = edt_emailaddress
+ EditLabel.AnchorSideRight.Side = asrBottom
+ EditLabel.AnchorSideBottom.Control = edt_emailaddress
+ EditLabel.Left = 16
+ EditLabel.Height = 15
+ EditLabel.Top = 6
+ EditLabel.Width = 192
+ EditLabel.Caption = 'User Name (Email address)'
+ EditLabel.ParentColor = False
+ ParentShowHint = False
+ ShowHint = True
+ TabOrder = 0
+ Text = 'myname@myserver.com'
+ end
+ object edt_password: TLabeledEdit
+ Left = 230
+ Height = 23
+ Hint = 'This is your Foobot LogIn password'
+ Top = 24
+ Width = 192
+ EchoMode = emPassword
+ EditLabel.AnchorSideLeft.Control = edt_password
+ EditLabel.AnchorSideRight.Control = edt_password
+ EditLabel.AnchorSideRight.Side = asrBottom
+ EditLabel.AnchorSideBottom.Control = edt_password
+ EditLabel.Left = 230
+ EditLabel.Height = 15
+ EditLabel.Top = 6
+ EditLabel.Width = 192
+ EditLabel.Caption = 'Foobot password'
+ EditLabel.ParentColor = False
+ ParentShowHint = False
+ PasswordChar = '*'
+ ShowHint = True
+ TabOrder = 1
+ Text = 'mypassword'
+ end
+ end
+ object cmd_OK: TBitBtn
+ Left = 184
+ Height = 30
+ Top = 96
+ Width = 75
+ Anchors = [akLeft, akRight, akBottom]
+ Default = True
+ DefaultCaption = True
+ Kind = bkOK
+ ModalResult = 1
+ OnClick = cmd_OKClick
+ TabOrder = 1
+ end
+end
diff --git a/applications/foobot/latest_stable/ulogin.pas b/applications/foobot/latest_stable/ulogin.pas
new file mode 100644
index 000000000..05c227500
--- /dev/null
+++ b/applications/foobot/latest_stable/ulogin.pas
@@ -0,0 +1,109 @@
+unit ulogin;
+
+{ Foobot Interrogator
+
+ Copyright (C)2016 Gordon Bamber minsadorada@charcodelvalle.com
+
+ This source is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 of the License, or (at your option)
+ any later version.
+
+ This code is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+ details.
+
+ A copy of the GNU General Public License is available on the World Wide Web
+ at . You can also obtain it by writing
+ to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA.
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+ ExtCtrls, Buttons;
+
+type
+
+ { Tloginform }
+
+ Tloginform = class(TForm)
+ cmd_OK: TBitBtn;
+ edt_emailaddress: TLabeledEdit;
+ edt_password: TLabeledEdit;
+ GroupBox1: TGroupBox;
+ procedure cmd_OKClick(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
+ procedure FormCreate(Sender: TObject);
+ private
+ function ValidEmail(sEmail: string): boolean;
+ public
+
+ end;
+
+var
+ loginform: Tloginform;
+
+implementation
+
+{$R *.lfm}
+uses umainform;
+
+{ Tloginform }
+
+procedure Tloginform.FormCreate(Sender: TObject);
+begin
+ Icon := Application.Icon;
+ Caption := Application.Title + ' Login';
+ edt_emailaddress.Text := mainform.INI.ReadString('Foobot', 'Foobot User',
+ 'myname@myserver.com');
+ edt_password.Text := mainform.INI.ReadString('Foobot', 'Foobot Password', 'password');
+end;
+
+procedure Tloginform.cmd_OKClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure Tloginform.FormCloseQuery(Sender: TObject; var CanClose: boolean);
+begin
+ if not ValidEmail(edt_emailaddress.Text) then
+ begin
+ MessageDlg(Application.Title, edt_emailaddress.Text + LineEnding +
+ ' is not a valid email address', mtError, [mbOK], 0);
+ CanClose := False;
+ end
+ else
+ CanClose := True;
+ mainform.INI.WriteString('Foobot', 'Foobot User', edt_emailaddress.Text);
+ mainform.INI.WriteString('Foobot', 'Foobot Password', edt_password.Text);
+end;
+
+function Tloginform.ValidEmail(sEmail: string): boolean;
+var
+ at, dot, i: integer;
+ bOkay: boolean;
+begin
+ at := Pos('@', sEmail);
+ dot := LastDelimiter('.', sEmail);
+ bOkay := (at > 0) and (dot > at);
+ if bOkay then
+ begin
+ for i := 1 to Length(sEmail) do
+ begin
+ if not (sEmail[i] in ['a'..'z', 'A'..'Z', '0'..'9', '-', '_', '.', '@']) then
+ begin
+ bOkay := False;
+ break;
+ end;
+ end;
+ end;
+ Result := bOkay;
+end;
+
+end.
diff --git a/applications/foobot/latest_stable/umainform.lfm b/applications/foobot/latest_stable/umainform.lfm
new file mode 100644
index 000000000..e328fee97
--- /dev/null
+++ b/applications/foobot/latest_stable/umainform.lfm
@@ -0,0 +1,262 @@
+object mainform: Tmainform
+ Left = 547
+ Height = 377
+ Top = 198
+ Width = 510
+ BorderIcons = [biSystemMenu, biMinimize]
+ BorderStyle = bsSingle
+ Caption = 'mainform'
+ ClientHeight = 357
+ ClientWidth = 510
+ DefaultMonitor = dmDesktop
+ Menu = MainMenu1
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnShow = FormShow
+ Position = poScreenCenter
+ LCLVersion = '1.7'
+ Scaled = True
+ object GroupBox3: TGroupBox
+ Left = 0
+ Height = 209
+ Top = 0
+ Width = 510
+ Align = alTop
+ Caption = 'Your Foobots'
+ ClientHeight = 189
+ ClientWidth = 506
+ TabOrder = 0
+ object tv_Identity: TTreeView
+ Left = 0
+ Height = 136
+ Top = 53
+ Width = 506
+ Align = alBottom
+ AutoExpand = True
+ DefaultItemHeight = 18
+ ExpandSignType = tvestPlusMinus
+ MultiSelectStyle = [msVisibleOnly]
+ ReadOnly = True
+ RowSelect = True
+ ShowLines = False
+ ShowRoot = False
+ TabOrder = 0
+ OnClick = tv_IdentityClick
+ Options = [tvoAutoExpand, tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoRowSelect, tvoShowButtons, tvoToolTips, tvoThemedDraw]
+ end
+ object cmd_GetIdentity: TButton
+ Left = 8
+ Height = 30
+ Hint = 'Click to fetch your Foobot details'
+ Top = 8
+ Width = 128
+ Caption = 'Fetch all Foobots'
+ OnClick = cmd_GetIdentityClick
+ ParentShowHint = False
+ ShowHint = True
+ TabOrder = 1
+ end
+ object cmd_FetchData: TButton
+ Left = 144
+ Height = 30
+ Top = 8
+ Width = 248
+ Caption = 'Fetch data from selected Foobot'
+ Enabled = False
+ OnClick = cmd_FetchDataClick
+ ParentFont = False
+ TabOrder = 2
+ end
+ object cmd_Close: TBitBtn
+ Left = 422
+ Height = 30
+ Top = 8
+ Width = 75
+ Anchors = []
+ DefaultCaption = True
+ Kind = bkClose
+ ModalResult = 11
+ OnClick = mnu_fileExitClick
+ TabOrder = 3
+ end
+ end
+ object sb: TStatusBar
+ Left = 0
+ Height = 23
+ Top = 334
+ Width = 510
+ Panels = <>
+ end
+ object rg_interval: TRadioGroup
+ Left = 264
+ Height = 105
+ Top = 216
+ Width = 96
+ AutoFill = True
+ Caption = 'Previous...'
+ ChildSizing.LeftRightSpacing = 6
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsHomogenousChildResize
+ ChildSizing.ShrinkHorizontal = crsScaleChilds
+ ChildSizing.ShrinkVertical = crsScaleChilds
+ ChildSizing.Layout = cclLeftToRightThenTopToBottom
+ ChildSizing.ControlsPerLine = 1
+ ClientHeight = 85
+ ClientWidth = 92
+ Enabled = False
+ ItemIndex = 0
+ Items.Strings = (
+ 'Now'
+ 'Hour'
+ '2 Hours'
+ '4 Hours'
+ '8 Hours'
+ )
+ OnSelectionChanged = rg_intervalSelectionChanged
+ TabOrder = 2
+ end
+ object rg_intervalAverageBy: TRadioGroup
+ Left = 360
+ Height = 105
+ Top = 216
+ Width = 145
+ AutoFill = True
+ Caption = 'Average by..'
+ ChildSizing.LeftRightSpacing = 6
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsHomogenousChildResize
+ ChildSizing.ShrinkHorizontal = crsScaleChilds
+ ChildSizing.ShrinkVertical = crsScaleChilds
+ ChildSizing.Layout = cclLeftToRightThenTopToBottom
+ ChildSizing.ControlsPerLine = 1
+ ClientHeight = 85
+ ClientWidth = 141
+ Enabled = False
+ ItemIndex = 0
+ Items.Strings = (
+ 'No average'
+ 'Hourly average'
+ '8-Hourly average'
+ '24-Hourly average'
+ 'Total average'
+ )
+ OnSelectionChanged = rg_intervalAverageBySelectionChanged
+ TabOrder = 3
+ end
+ object rg_mode: TRadioGroup
+ Left = 8
+ Height = 105
+ Top = 216
+ Width = 112
+ AutoFill = True
+ Caption = 'Mode'
+ ChildSizing.LeftRightSpacing = 6
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsHomogenousChildResize
+ ChildSizing.ShrinkHorizontal = crsScaleChilds
+ ChildSizing.ShrinkVertical = crsScaleChilds
+ ChildSizing.Layout = cclLeftToRightThenTopToBottom
+ ChildSizing.ControlsPerLine = 1
+ ClientHeight = 85
+ ClientWidth = 108
+ Enabled = False
+ ItemIndex = 0
+ Items.Strings = (
+ 'Previous'
+ 'Date Range'
+ )
+ OnSelectionChanged = rg_modeSelectionChanged
+ TabOrder = 4
+ end
+ object grp_daterange: TGroupBox
+ Left = 128
+ Height = 105
+ Top = 216
+ Width = 129
+ Caption = 'Date Range'
+ ClientHeight = 85
+ ClientWidth = 125
+ Enabled = False
+ TabOrder = 5
+ object lbl_fromdate: TLabel
+ Left = 8
+ Height = 15
+ Top = 12
+ Width = 55
+ Caption = 'From Date'
+ ParentColor = False
+ end
+ object lbl_to: TLabel
+ Left = 8
+ Height = 15
+ Top = 36
+ Width = 11
+ Caption = 'to'
+ ParentColor = False
+ end
+ object lbl_toDate: TLabel
+ Left = 8
+ Height = 15
+ Top = 60
+ Width = 39
+ Caption = 'To date'
+ ParentColor = False
+ end
+ object spd_fromdate: TSpeedButton
+ Left = 88
+ Height = 22
+ Top = 8
+ Width = 23
+ Caption = '...'
+ OnClick = spd_fromdateClick
+ end
+ object spd_todate: TSpeedButton
+ Left = 88
+ Height = 22
+ Top = 56
+ Width = 23
+ Caption = '...'
+ OnClick = spd_todateClick
+ end
+ end
+ object Button1: TButton
+ Left = 0
+ Height = 25
+ Top = 312
+ Width = 75
+ Caption = 'Button1'
+ OnClick = Button1Click
+ TabOrder = 6
+ end
+ object MainMenu1: TMainMenu
+ Left = 304
+ Top = 24
+ object mnu_file: TMenuItem
+ Caption = '&File'
+ object mnu_fileExit: TMenuItem
+ Caption = 'E&xit'
+ OnClick = mnu_fileExitClick
+ end
+ end
+ object mnu_help: TMenuItem
+ Caption = '&Help'
+ object mnu_helpAbout: TMenuItem
+ Caption = '&About...'
+ OnClick = mnu_helpAboutClick
+ end
+ end
+ end
+ object ApplicationProperties1: TApplicationProperties
+ ExceptionDialog = aedOkMessageBox
+ OnHint = ApplicationProperties1Hint
+ Left = 264
+ Top = 16
+ end
+ object CalendarDialog1: TCalendarDialog
+ Date = 42730
+ OKCaption = '&OK'
+ CancelCaption = 'Cancel'
+ Left = 373
+ Top = 25
+ end
+end
diff --git a/applications/foobot/latest_stable/umainform.pas b/applications/foobot/latest_stable/umainform.pas
new file mode 100644
index 000000000..d295ef425
--- /dev/null
+++ b/applications/foobot/latest_stable/umainform.pas
@@ -0,0 +1,346 @@
+unit umainform;
+
+{ Foobot Interrogator
+
+ Copyright (C)2016 Gordon Bamber minsadorada@charcodelvalle.com
+
+ This source is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 of the License, or (at your option)
+ any later version.
+
+ This code is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+ details.
+
+ A copy of the GNU General Public License is available on the World Wide Web
+ at . You can also obtain it by writing
+ to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA.
+}
+
+{
+== VERSION HISTORY ==
+V0.1.0.0: Intial version by minesadorada
+V0.1.1.0: ??
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+ Buttons, Menus, ExtCtrls, ComCtrls, ExtDlgs,
+ ucryptini, dateutils, ulogin, udataform, foobot_utility;
+
+type
+ { Tmainform }
+
+ Tmainform = class(TForm)
+ ApplicationProperties1: TApplicationProperties;
+ Button1: TButton;
+ CalendarDialog1: TCalendarDialog;
+ cmd_Close: TBitBtn;
+ cmd_FetchData: TButton;
+ cmd_GetIdentity: TButton;
+ grp_daterange: TGroupBox;
+ GroupBox3: TGroupBox;
+ lbl_fromdate: TLabel;
+ lbl_to: TLabel;
+ lbl_toDate: TLabel;
+ MainMenu1: TMainMenu;
+ mnu_helpAbout: TMenuItem;
+ mnu_help: TMenuItem;
+ mnu_fileExit: TMenuItem;
+ mnu_file: TMenuItem;
+ rg_intervalAverageBy: TRadioGroup;
+ rg_interval: TRadioGroup;
+ rg_mode: TRadioGroup;
+ sb: TStatusBar;
+ spd_fromdate: TSpeedButton;
+ spd_todate: TSpeedButton;
+ tv_Identity: TTreeView;
+ procedure ApplicationProperties1Hint(Sender: TObject);
+ procedure Button1Click(Sender: TObject);
+ procedure cmd_FetchDataClick(Sender: TObject);
+ procedure cmd_GetIdentityClick(Sender: TObject);
+ procedure cmd_testClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure mnu_fileExitClick(Sender: TObject);
+ procedure mnu_helpAboutClick(Sender: TObject);
+ procedure rg_intervalAverageBySelectionChanged(Sender: TObject);
+ procedure rg_intervalSelectionChanged(Sender: TObject);
+ procedure rg_modeSelectionChanged(Sender: TObject);
+ procedure spd_fromdateClick(Sender: TObject);
+ procedure spd_todateClick(Sender: TObject);
+ procedure tv_IdentityClick(Sender: TObject);
+ private
+ sFoobotUserName: string;
+ sFoobotPassword: string;
+ iLastIntervalSeconds: integer;
+ iLastAverageBySeconds: integer;
+ iStartTimeSeconds, iEndTimeSeconds: int64;
+ function PopulateIdentityTreeView: boolean;
+ public
+ INI: TCryptIniFile;
+ CurrentFoobot: integer;
+ FetchType: TDataFetchType;
+
+ end;
+
+
+var
+ mainform: Tmainform;
+
+implementation
+
+{$R *.lfm}
+
+{ Tmainform }
+
+procedure Tmainform.FormCreate(Sender: TObject);
+begin
+ Icon := Application.Icon;
+ Caption := Application.Title;
+ INI := TCryptINIFile.Create(GetAppConfigFile(False));
+ if INI.IsVirgin then
+ begin
+ INI.WriteIdent('Gordon Bamber', '(c)2016', 'GPLV2',
+ 'minesadorada@charcodelvalle.com', True);
+ // PUT YOUR SECRET API KEY HERE IF YOU LIKE
+ // INI.WriteString('Foobot', 'Secret Key',
+ '');
+ end;
+ if not INI.VerifyIdent('41d10218d247980fc5e871b6b7844483') then
+ begin
+ ShowMessage(Application.Title +
+ ' has been tampered wth. Please re-install from a trusted source.');
+ Application.Terminate;
+ end;
+ CurrentFoobot := 0;
+ Hint := 'Welcome to ' + Application.Title;
+ sb.SimpleText := Hint;
+ FetchType := dfLast;
+end;
+
+procedure Tmainform.FormDestroy(Sender: TObject);
+begin
+ FreeAndNil(INI);
+end;
+
+procedure Tmainform.FormShow(Sender: TObject);
+begin
+ loginform.showmodal;
+ sFoobotUserName := INI.ReadString('Foobot', 'Foobot User', 'myname@myserver.com');
+ sFoobotPassword := INI.ReadString('Foobot', 'Foobot Password', 'password');
+end;
+
+procedure Tmainform.cmd_testClick(Sender: TObject);
+begin
+end;
+
+function Tmainform.PopulateIdentityTreeView: boolean;
+var
+ iCount: integer;
+ mainnode, node: TTreeNode;
+begin
+ Result := False;
+ if FoobotIdentityObject.FoobotIdentityList.Count > 0 then
+ begin
+ // TTreeView
+ TV_Identity.Items.Add(nil, 'All Foobots'); // Root
+ try
+ // Loop through all the detected Foobot instances
+ for iCount := 0 to Pred(FoobotIdentityObject.FoobotIdentityList.Count) do
+ begin
+ mainnode := TV_Identity.Items[iCount];
+ node := TV_Identity.Items.AddChild(mainnode,
+ Format('Foobot #%d', [Succ(iCount)]));
+ TV_Identity.Items.AddChild(node, 'Name: ' +
+ FoobotIdentityObject.FoobotIdentityList.Items[iCount].Name);
+ TV_Identity.Items.AddChild(node, 'UserID: ' +
+ Format('%d', [FoobotIdentityObject.FoobotIdentityList.Items[
+ iCount].userID]));
+ TV_Identity.Items.AddChild(node, 'Mac: ' +
+ FoobotIdentityObject.FoobotIdentityList.Items[iCount].mac);
+ TV_Identity.Items.AddChild(node, 'uuID: ' +
+ FoobotIdentityObject.FoobotIdentityList.Items[iCount].uuid);
+ node.Expanded := False;
+ Result := True;
+ end;
+ except
+ On E: Exception do
+ showmessagefmt('PopulateIdentityTreeView: Failed because %s', [E.Message]);
+ end;
+ end;
+end;
+
+procedure Tmainform.cmd_GetIdentityClick(Sender: TObject);
+var
+ sSecretKey: string;
+begin
+ sSecretKey := INI.ReadString('Foobot', 'Secret Key', '');
+ if FetchFoobotIdentity(sFoobotUserName, sSecretKey) then
+ if PopulateIdentityTreeView then
+ begin
+ cmd_GetIdentity.Enabled := False;
+ tv_Identity.Hint := 'Click on a Foobot instance in the panel to interrogate it';
+ tv_Identity.ShowHint := True;
+ end;
+end;
+
+procedure Tmainform.ApplicationProperties1Hint(Sender: TObject);
+begin
+ if Application.Hint <> '' then
+ sb.SimpleText := Application.Hint
+ else
+ sb.SimpleText := mainform.hint;
+end;
+
+procedure Tmainform.Button1Click(Sender: TObject);
+begin
+ FetchAuthenticationKey(sFoobotUserName, sFoobotPassword);
+end;
+
+procedure Tmainform.cmd_FetchDataClick(Sender: TObject);
+var
+ sSecretKey: string;
+begin
+ sSecretKey := INI.ReadString('Foobot', 'Secret Key', '');
+
+ if FetchFoobotData(FetchType, CurrentFoobot, iLastIntervalSeconds,
+ iLastAverageBySeconds, iStartTimeSeconds, iEndTimeSeconds, sSecretKey) then
+ begin
+ //DEBUG FoobotDataObject.SaveToFile('FoobotDataObject.json');
+ dataform.ShowModal;
+ end;
+end;
+
+procedure Tmainform.mnu_fileExitClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure Tmainform.mnu_helpAboutClick(Sender: TObject);
+var
+ s: string;
+begin
+ s := Application.Title + LineEnding;
+ s += 'Version: ' + INI.ReadUnencryptedString('ProgramInfo', IDENT_APPVERSION, '') +
+ LineEnding + LineEnding;
+ s += INI.ReadUnencryptedString('ProgramInfo', IDENT_COPYRIGHT, '');
+ s += ' by ' + INI.ReadUnencryptedString('ProgramInfo', IDENT_AUTHOR, '') + LineEnding;
+ s += 'Licence: ' + INI.ReadUnencryptedString('ProgramInfo', IDENT_LICENSE, '') +
+ LineEnding;
+ s += 'Made with LCL v ' + INI.ReadUnencryptedString('ProgramInfo',
+ IDENT_LCLVERSION, '');
+ s += ' FPC v ' + INI.ReadUnencryptedString('ProgramInfo', IDENT_FPCVERSION, '') +
+ LineEnding;
+ s += 'Compiled ' + INI.ReadUnencryptedString('ProgramInfo', IDENT_LASTCOMPILED, '') +
+ LineEnding;
+ s += ' for ' + INI.ReadUnencryptedString('ProgramInfo', IDENT_TARGET, '');
+ MessageDlg('About ' + Application.Title, s,
+ mtInformation, [mbOK], 0);
+end;
+
+procedure Tmainform.rg_intervalAverageBySelectionChanged(Sender: TObject);
+begin
+ case rg_intervalAverageBy.ItemIndex of
+ 0:
+ begin
+ if FetchType = dfStartEnd then
+ begin
+ MessageDlg(Application.Title, 'Setting minimum average = Hourly',
+ mtError, [mbOK], 0);
+ iLastAverageBySeconds := 3600;
+ end
+ else
+ iLastAverageBySeconds := 0;
+ end;
+ 1: iLastAverageBySeconds := 3600;
+ 2: iLastAverageBySeconds := 8 * 3600;
+ 3: iLastAverageBySeconds := 24 * 3600;
+ 4: iLastAverageBySeconds := iLastIntervalSeconds;
+ end;
+end;
+
+procedure Tmainform.rg_intervalSelectionChanged(Sender: TObject);
+begin
+ case rg_interval.ItemIndex of
+ 0: iLastIntervalSeconds := 0;
+ 1: iLastIntervalSeconds := 3600;
+ 2: iLastIntervalSeconds := 2 * 3600;
+ 3: iLastIntervalSeconds := 4 * 3600;
+ 4: iLastIntervalSeconds := 8 * 3600;
+ end;
+end;
+
+procedure Tmainform.rg_modeSelectionChanged(Sender: TObject);
+begin
+ case rg_mode.ItemIndex of
+ 0:
+ begin
+ FetchType := dfLast;
+ rg_interval.Enabled := True;
+ grp_daterange.Enabled := False;
+ end;
+ 1:
+ begin
+ FetchType := dfStartEnd;
+ rg_interval.Enabled := False;
+ grp_daterange.Enabled := True;
+ end;
+ end;
+end;
+
+procedure Tmainform.spd_fromdateClick(Sender: TObject);
+begin
+ if CalendarDialog1.Execute then
+ begin
+ iStartTimeSeconds := DateTimeToUnix(CalendarDialog1.Date);
+ lbl_fromdate.Caption := FormatDateTime('dd/mm/yyyy', CalendarDialog1.Date);
+ end;
+end;
+
+procedure Tmainform.spd_todateClick(Sender: TObject);
+begin
+ if CalendarDialog1.Execute then
+ begin
+ iEndTimeSeconds := DateTimeToUnix(CalendarDialog1.Date);
+ lbl_todate.Caption := FormatDateTime('dd/mm/yyyy', CalendarDialog1.Date);
+
+ end;
+end;
+
+procedure Tmainform.tv_IdentityClick(Sender: TObject);
+var
+ node: TTreeNode;
+begin
+ if tv_Identity.Items.Count > 0 then
+ begin
+ node := tv_Identity.Selected;
+ if not Assigned(Node) then
+ Exit;
+ if node.Level = 1 then
+ begin
+ CurrentFoobot := node.Index; // Zero-based
+ cmd_FetchData.Enabled := True;
+ cmd_FetchData.Font.Style := [fsBold];
+ rg_mode.Enabled := True;
+ rg_interval.Enabled := True;
+ rg_intervalAverageBy.Enabled := True;
+ end
+ else
+ begin
+ cmd_FetchData.Enabled := False;
+ cmd_FetchData.Font.Style := [];
+ end;
+ end;
+end;
+
+
+end.
diff --git a/applications/foobot/monitor/foobotmonitor.ico b/applications/foobot/monitor/foobotmonitor.ico
new file mode 100644
index 000000000..4ec112d04
Binary files /dev/null and b/applications/foobot/monitor/foobotmonitor.ico differ
diff --git a/applications/foobot/monitor/foobotmonitor.lpi b/applications/foobot/monitor/foobotmonitor.lpi
new file mode 100644
index 000000000..5c6f615f9
--- /dev/null
+++ b/applications/foobot/monitor/foobotmonitor.lpi
@@ -0,0 +1,278 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/applications/foobot/monitor/foobotmonitor.lpr b/applications/foobot/monitor/foobotmonitor.lpr
new file mode 100644
index 000000000..d8464d656
--- /dev/null
+++ b/applications/foobot/monitor/foobotmonitor.lpr
@@ -0,0 +1,31 @@
+program foobotmonitor;
+{$ifdef Linux}
+ {$ifdef FPC_CROSSCOMPILING}
+ {$ifdef CPUARM}
+ //if GUI, then uncomment
+ //{$linklib GLESv2}
+ {$endif}
+ {$linklib libc_nonshared.a}
+ {$endif}
+{$endif}
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, umainform, uconfigform
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ Application.Title:='Foobot monitor';
+ RequireDerivedFormResource:=True;
+ Application.Initialize;
+ Application.CreateForm(Tmainform, mainform);
+ Application.CreateForm(Tconfigform, configform);
+ Application.Run;
+end.
+
diff --git a/applications/foobot/monitor/foobotmonitor.lps b/applications/foobot/monitor/foobotmonitor.lps
new file mode 100644
index 000000000..58b59bd21
--- /dev/null
+++ b/applications/foobot/monitor/foobotmonitor.lps
@@ -0,0 +1,237 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/applications/foobot/monitor/foobotmonitor.res b/applications/foobot/monitor/foobotmonitor.res
new file mode 100644
index 000000000..71fa2a772
Binary files /dev/null and b/applications/foobot/monitor/foobotmonitor.res differ
diff --git a/applications/foobot/monitor/uconfigform.lfm b/applications/foobot/monitor/uconfigform.lfm
new file mode 100644
index 000000000..b84f81250
--- /dev/null
+++ b/applications/foobot/monitor/uconfigform.lfm
@@ -0,0 +1,89 @@
+object configform: Tconfigform
+ Left = 654
+ Height = 197
+ Top = 285
+ Width = 592
+ BorderIcons = []
+ BorderStyle = bsToolWindow
+ Caption = 'configform'
+ ClientHeight = 197
+ ClientWidth = 592
+ OnCloseQuery = FormCloseQuery
+ OnCreate = FormCreate
+ Position = poMainFormCenter
+ LCLVersion = '1.7'
+ object grp_main: TGroupBox
+ Left = 0
+ Height = 145
+ Top = 0
+ Width = 592
+ Align = alTop
+ Caption = 'Your Foobot'
+ ClientHeight = 125
+ ClientWidth = 588
+ TabOrder = 0
+ object edt_username: TLabeledEdit
+ Left = 104
+ Height = 23
+ Top = 8
+ Width = 472
+ EditLabel.AnchorSideTop.Control = edt_username
+ EditLabel.AnchorSideTop.Side = asrCenter
+ EditLabel.AnchorSideRight.Control = edt_username
+ EditLabel.AnchorSideBottom.Control = edt_username
+ EditLabel.AnchorSideBottom.Side = asrBottom
+ EditLabel.Left = 7
+ EditLabel.Height = 15
+ EditLabel.Top = 12
+ EditLabel.Width = 94
+ EditLabel.Caption = 'Foobot Username'
+ EditLabel.ParentColor = False
+ LabelPosition = lpLeft
+ TabOrder = 0
+ Text = '(email address)'
+ OnEditingDone = edt_usernameEditingDone
+ end
+ object Memo1: TMemo
+ Left = 0
+ Height = 69
+ Top = 56
+ Width = 588
+ Align = alBottom
+ Lines.Strings = (
+ 'Copy + Paste here'
+ )
+ OnEditingDone = Memo1EditingDone
+ TabOrder = 1
+ end
+ object Label1: TLabel
+ Left = 8
+ Height = 15
+ Top = 32
+ Width = 75
+ Caption = 'API Secret Key'
+ ParentColor = False
+ end
+ end
+ object BitBtn1: TBitBtn
+ Left = 259
+ Height = 30
+ Top = 160
+ Width = 75
+ Default = True
+ DefaultCaption = True
+ Kind = bkOK
+ ModalResult = 1
+ TabOrder = 1
+ end
+ object BitBtn2: TBitBtn
+ Left = 512
+ Height = 30
+ Top = 160
+ Width = 75
+ Cancel = True
+ DefaultCaption = True
+ Kind = bkCancel
+ ModalResult = 11
+ TabOrder = 2
+ end
+end
diff --git a/applications/foobot/monitor/uconfigform.pas b/applications/foobot/monitor/uconfigform.pas
new file mode 100644
index 000000000..208f6eef7
--- /dev/null
+++ b/applications/foobot/monitor/uconfigform.pas
@@ -0,0 +1,124 @@
+unit uconfigform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+ ExtCtrls, Buttons;
+
+type
+
+ { Tconfigform }
+
+ Tconfigform = class(TForm)
+ BitBtn1: TBitBtn;
+ BitBtn2: TBitBtn;
+ grp_main: TGroupBox;
+ edt_username: TLabeledEdit;
+ Label1: TLabel;
+ Memo1: TMemo;
+ procedure edt_usernameEditingDone(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
+ procedure FormCreate(Sender: TObject);
+ procedure Memo1EditingDone(Sender: TObject);
+ private
+ bDoneUsername,bDoneSecretKey:Boolean;
+ function ValidEmail(sEmail: string): boolean;
+ public
+ FoobotUsername,FoobotSecretKey:String;
+ bValid:Boolean;
+ end;
+
+var
+ configform: Tconfigform;
+
+implementation
+Uses umainform;
+{$R *.lfm}
+
+{ Tconfigform }
+function Tconfigform.ValidEmail(sEmail: string): boolean;
+var
+ at, dot, i: integer;
+ bOkay: boolean;
+begin
+ at := Pos('@', sEmail);
+ dot := LastDelimiter('.', sEmail);
+ bOkay := (at > 0) and (dot > at);
+ if bOkay then
+ begin
+ for i := 1 to Length(sEmail) do
+ begin
+ if not (sEmail[i] in ['a'..'z', 'A'..'Z', '0'..'9', '-', '_', '.', '@']) then
+ begin
+ bOkay := False;
+ break;
+ end;
+ end;
+ end;
+ Result := bOkay;
+end;
+
+procedure Tconfigform.FormCreate(Sender: TObject);
+begin
+ Caption:='Configure ' + Application.Title;
+ Icon:=Application.Icon;
+ bDoneUsername:=FALSE;
+ bDoneSecretKey:=FALSE;
+ bValid:=False;
+ FoobotUsername:= mainform.INI.ReadString('Foobot', 'Foobot User', 'unknown');
+ FoobotSecretKey:= mainform.INI.ReadString('Foobot', 'Secret Key', 'unknown');
+
+
+end;
+
+procedure Tconfigform.Memo1EditingDone(Sender: TObject);
+begin
+ If (Memo1.Text='Copy + Paste here') then
+ begin
+ MessageDlg(Application.Title,
+ edt_username.Text + ' is not a valid API key. Try again',
+ mtWarning,[MBOK],0);
+ Exit;
+ end
+ else
+ FoobotSecretKey:=Memo1.Text;
+ bDoneSecretKey:=TRUE;
+end;
+
+procedure Tconfigform.edt_usernameEditingDone(Sender: TObject);
+begin
+ If NOT ValidEmail(edt_username.Text) then
+ begin
+ MessageDlg(Application.Title,
+ edt_username.Text + ' is not a valid email address. Try again',
+ mtWarning,[MBOK],0);
+ Exit;
+ end
+ else
+ begin
+ FoobotUsername:=edt_username.Text;
+ bDoneUsername:=TRUE;
+ end;
+end;
+
+procedure Tconfigform.FormCloseQuery(Sender: TObject; var CanClose: boolean);
+begin
+ If ( bDoneUsername=FALSE) OR (bDoneSecretKey=FALSE) then
+ begin
+ CanClose:=FALSE;
+ If MessageDlg('You haven''t completed all the fields. Are you sure you want to quit?',
+ mtConfirmation,[MBYES,MBNO],0,MBNO) = mrYes then CanClose:=TRUE;
+ end
+ else
+ begin
+ bValid:=TRUE;
+ CanClose:=TRUE;
+ end;
+
+end;
+
+end.
+
diff --git a/applications/foobot/monitor/umainform.lfm b/applications/foobot/monitor/umainform.lfm
new file mode 100644
index 000000000..54a159071
--- /dev/null
+++ b/applications/foobot/monitor/umainform.lfm
@@ -0,0 +1,383 @@
+object mainform: Tmainform
+ Left = 615
+ Height = 262
+ Top = 154
+ Width = 782
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsToolWindow
+ Caption = 'mainform'
+ ClientHeight = 242
+ ClientWidth = 782
+ DefaultMonitor = dmDesktop
+ Menu = MainMenu1
+ OnActivate = FormActivate
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnShow = FormShow
+ Position = poWorkAreaCenter
+ LCLVersion = '1.7'
+ Scaled = True
+ object grp_sensorDisplay: TGroupBox
+ Left = 0
+ Height = 120
+ Top = 0
+ Width = 782
+ Align = alTop
+ Caption = 'Current Values'
+ ChildSizing.ControlsPerLine = 6
+ ClientHeight = 100
+ ClientWidth = 778
+ TabOrder = 0
+ object as_pm: TAnalogSensor
+ Left = 0
+ Height = 100
+ Top = 0
+ Width = 130
+ Align = alLeft
+ ClientHeight = 100
+ ClientWidth = 130
+ TabOrder = 0
+ ShowText = True
+ ShowLevel = True
+ Value = 0
+ ValueMin = 0
+ ValueMax = 300
+ ValueRed = 0
+ ValueYellow = 0
+ AnalogKind = akAnalog
+ end
+ object as_tmp: TAnalogSensor
+ Left = 130
+ Height = 100
+ Top = 0
+ Width = 130
+ Align = alLeft
+ ClientHeight = 100
+ ClientWidth = 130
+ TabOrder = 1
+ ShowText = True
+ ShowLevel = True
+ Value = 0
+ ValueMin = 0
+ ValueMax = 40
+ ValueRed = 0
+ ValueYellow = 0
+ AnalogKind = akAnalog
+ end
+ object as_hum: TAnalogSensor
+ Left = 260
+ Height = 100
+ Top = 0
+ Width = 130
+ Align = alLeft
+ ClientHeight = 100
+ ClientWidth = 130
+ TabOrder = 2
+ ShowText = True
+ ShowLevel = True
+ Value = 0
+ ValueMin = 0
+ ValueMax = 100
+ ValueRed = 0
+ ValueYellow = 0
+ AnalogKind = akAnalog
+ end
+ object as_co2: TAnalogSensor
+ Left = 390
+ Height = 100
+ Top = 0
+ Width = 130
+ Align = alLeft
+ ClientHeight = 100
+ ClientWidth = 130
+ TabOrder = 3
+ ShowText = True
+ ShowLevel = True
+ Value = 0
+ ValueMin = 0
+ ValueMax = 3000
+ ValueRed = 0
+ ValueYellow = 0
+ AnalogKind = akAnalog
+ end
+ object as_voc: TAnalogSensor
+ Left = 520
+ Height = 100
+ Top = 0
+ Width = 130
+ Align = alLeft
+ ClientHeight = 100
+ ClientWidth = 130
+ TabOrder = 4
+ ShowText = True
+ ShowLevel = True
+ Value = 0
+ ValueMin = 0
+ ValueMax = 1000
+ ValueRed = 0
+ ValueYellow = 0
+ AnalogKind = akAnalog
+ end
+ object as_allpollu: TAnalogSensor
+ Left = 650
+ Height = 100
+ Top = 0
+ Width = 130
+ Align = alLeft
+ ClientHeight = 100
+ ClientWidth = 130
+ TabOrder = 5
+ ShowText = True
+ ShowLevel = True
+ Value = 0
+ ValueMin = 0
+ ValueMax = 300
+ ValueRed = 0
+ ValueYellow = 0
+ AnalogKind = akAnalog
+ end
+ end
+ object grp_highlow: TGroupBox
+ Left = 0
+ Height = 119
+ Top = 120
+ Width = 782
+ Align = alTop
+ Caption = 'Highs and Lows'
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsScaleChilds
+ ChildSizing.ControlsPerLine = 6
+ ClientHeight = 99
+ ClientWidth = 778
+ TabOrder = 1
+ object grp_pm: TGroupBox
+ Left = 0
+ Height = 99
+ Top = 0
+ Width = 130
+ Align = alLeft
+ Caption = 'Particulates'
+ ClientHeight = 79
+ ClientWidth = 126
+ TabOrder = 0
+ object lbl_pmhigh: TLabel
+ Left = 8
+ Height = 15
+ Top = 8
+ Width = 60
+ Caption = 'lbl_pmhigh'
+ ParentColor = False
+ end
+ object lbl_pmlow: TLabel
+ Left = 8
+ Height = 15
+ Top = 40
+ Width = 55
+ Caption = 'lbl_pmlow'
+ ParentColor = False
+ end
+ end
+ object grp_tmp: TGroupBox
+ Left = 130
+ Height = 99
+ Top = 0
+ Width = 130
+ Align = alLeft
+ Caption = 'Temperature'
+ ClientHeight = 79
+ ClientWidth = 126
+ TabOrder = 1
+ object lbl_tmphigh: TLabel
+ Left = 8
+ Height = 15
+ Top = 8
+ Width = 64
+ Caption = 'lbl_tmphigh'
+ ParentColor = False
+ end
+ object lbl_tmplow: TLabel
+ Left = 8
+ Height = 15
+ Top = 40
+ Width = 59
+ Caption = 'lbl_tmplow'
+ ParentColor = False
+ end
+ end
+ object grp_hum: TGroupBox
+ Left = 260
+ Height = 99
+ Top = 0
+ Width = 130
+ Align = alLeft
+ Caption = 'Humidity'
+ ClientHeight = 79
+ ClientWidth = 126
+ TabOrder = 2
+ object lbl_humhigh: TLabel
+ Left = 8
+ Height = 15
+ Top = 8
+ Width = 67
+ Caption = 'lbl_humhigh'
+ ParentColor = False
+ end
+ object lbl_humlow: TLabel
+ Left = 8
+ Height = 15
+ Top = 40
+ Width = 62
+ Caption = 'lbl_humlow'
+ ParentColor = False
+ end
+ end
+ object grp_co2: TGroupBox
+ Left = 390
+ Height = 99
+ Top = 0
+ Width = 130
+ Align = alLeft
+ Caption = 'CO2'
+ ClientHeight = 79
+ ClientWidth = 126
+ TabOrder = 3
+ object lbl_co2high: TLabel
+ Left = 8
+ Height = 15
+ Top = 8
+ Width = 61
+ Caption = 'lbl_co2high'
+ ParentColor = False
+ end
+ object lbl_co2low: TLabel
+ Left = 8
+ Height = 15
+ Top = 40
+ Width = 56
+ Caption = 'lbl_co2low'
+ ParentColor = False
+ end
+ end
+ object grp_voc: TGroupBox
+ Left = 520
+ Height = 99
+ Top = 0
+ Width = 130
+ Align = alLeft
+ Caption = 'Volatile VOC'
+ ClientHeight = 79
+ ClientWidth = 126
+ TabOrder = 4
+ object lbl_vochigh: TLabel
+ Left = 8
+ Height = 15
+ Top = 8
+ Width = 61
+ Caption = 'lbl_vochigh'
+ ParentColor = False
+ end
+ object lbl_voclow: TLabel
+ Left = 8
+ Height = 15
+ Top = 40
+ Width = 56
+ Caption = 'lbl_voclow'
+ ParentColor = False
+ end
+ end
+ object grp_allpollu: TGroupBox
+ Left = 650
+ Height = 99
+ Top = 0
+ Width = 130
+ Align = alLeft
+ Caption = 'All Pollution'
+ ClientHeight = 79
+ ClientWidth = 126
+ TabOrder = 5
+ object lbl_allpolluhigh: TLabel
+ Left = 8
+ Height = 15
+ Top = 8
+ Width = 81
+ Caption = 'lbl_allpolluhigh'
+ ParentColor = False
+ end
+ object lbl_allpollulow: TLabel
+ Left = 8
+ Height = 15
+ Top = 40
+ Width = 76
+ Caption = 'lbl_allpollulow'
+ ParentColor = False
+ end
+ end
+ end
+ object tmr_foobot: TTimer
+ Enabled = False
+ Interval = 3600
+ OnTimer = tmr_foobotTimer
+ Left = 16
+ end
+ object MainMenu1: TMainMenu
+ Left = 56
+ Top = 8
+ object mnu_file: TMenuItem
+ Caption = '&File'
+ object mnu_fileExit: TMenuItem
+ Caption = 'E&xit'
+ OnClick = mnu_fileExitClick
+ end
+ end
+ object mnu_options: TMenuItem
+ Caption = '&Options'
+ object mnu_optionsShowHighsAndLows: TMenuItem
+ AutoCheck = True
+ Caption = 'Show Highs and Lows'
+ Checked = True
+ OnClick = mnu_optionsShowHighsAndLowsClick
+ end
+ object mnu_optionsTakeReadingNow: TMenuItem
+ Caption = 'Take reading now'
+ OnClick = mnu_optionsTakeReadingNowClick
+ end
+ object mnu_optionsSampleEvery: TMenuItem
+ Caption = 'Sample every...'
+ object mnu_SampleEvery1Hour: TMenuItem
+ AutoCheck = True
+ Caption = 'Hour (default)'
+ Checked = True
+ GroupIndex = 1
+ OnClick = mnu_SampleEvery1HourClick
+ end
+ object mnu_SampleEvery2Hours: TMenuItem
+ AutoCheck = True
+ Caption = '2 Hours'
+ OnClick = mnu_SampleEvery2HoursClick
+ end
+ object mnu_SampleEvery4Hours: TMenuItem
+ AutoCheck = True
+ Caption = '4 Hours'
+ OnClick = mnu_SampleEvery4HoursClick
+ end
+ object mnu_SampleEvery8Hours: TMenuItem
+ AutoCheck = True
+ Caption = '8 Hours'
+ OnClick = mnu_SampleEvery8HoursClick
+ end
+ object mnu_SampleEvery24Hours: TMenuItem
+ AutoCheck = True
+ Caption = '24 Hours'
+ GroupIndex = 1
+ OnClick = mnu_SampleEvery24HoursClick
+ end
+ end
+ object mnu_optionsSaveHighLows: TMenuItem
+ AutoCheck = True
+ Caption = 'Save/Load High-Lows to disk'
+ Checked = True
+ OnClick = mnu_optionsSaveHighLowsClick
+ end
+ end
+ end
+end
diff --git a/applications/foobot/monitor/umainform.pas b/applications/foobot/monitor/umainform.pas
new file mode 100644
index 000000000..d2ff8c703
--- /dev/null
+++ b/applications/foobot/monitor/umainform.pas
@@ -0,0 +1,406 @@
+unit umainform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Sensors, Forms, Controls, Graphics, Dialogs,
+ ExtCtrls, StdCtrls, Menus, foobot_utility, uCryptIni, Variants, dateutils,
+ uconfigform;
+
+CONST
+ ONEMINUTE = 60000;
+ ONEHOUR = ONEMINUTE * 60;
+ TWOHOURS = ONEHOUR * 2;
+ FOURHOURS = ONEHOUR * 4;
+ EIGHTHOURS = ONEHOUR * 8;
+ TWENTYFOURHOURS = ONEHOUR * 24;
+
+
+type
+
+ { Tmainform }
+
+ Tmainform = class(TForm)
+ as_allpollu: TAnalogSensor;
+ as_co2: TAnalogSensor;
+ as_hum: TAnalogSensor;
+ as_pm: TAnalogSensor;
+ as_tmp: TAnalogSensor;
+ as_voc: TAnalogSensor;
+ grp_pm: TGroupBox;
+ grp_tmp: TGroupBox;
+ grp_hum: TGroupBox;
+ grp_co2: TGroupBox;
+ grp_voc: TGroupBox;
+ grp_allpollu: TGroupBox;
+ grp_highlow: TGroupBox;
+ grp_sensorDisplay: TGroupBox;
+ lbl_pmhigh: TLabel;
+ lbl_tmphigh: TLabel;
+ lbl_humhigh: TLabel;
+ lbl_co2high: TLabel;
+ lbl_vochigh: TLabel;
+ lbl_allpolluhigh: TLabel;
+ lbl_pmlow: TLabel;
+ lbl_tmplow: TLabel;
+ lbl_humlow: TLabel;
+ lbl_co2low: TLabel;
+ lbl_voclow: TLabel;
+ lbl_allpollulow: TLabel;
+ MainMenu1: TMainMenu;
+ mnu_optionsSaveHighLows: TMenuItem;
+ mnu_SampleEvery24Hours: TMenuItem;
+ mnu_SampleEvery8Hours: TMenuItem;
+ mnu_SampleEvery4Hours: TMenuItem;
+ mnu_SampleEvery2Hours: TMenuItem;
+ mnu_SampleEvery1Hour: TMenuItem;
+ mnu_optionsSampleEvery: TMenuItem;
+ mnu_optionsTakeReadingNow: TMenuItem;
+ mnu_optionsShowHighsAndLows: TMenuItem;
+ mnu_options: TMenuItem;
+ mnu_fileExit: TMenuItem;
+ mnu_file: TMenuItem;
+ tmr_foobot: TTimer;
+ procedure FormActivate(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure mnu_fileExitClick(Sender: TObject);
+ procedure mnu_optionsSaveHighLowsClick(Sender: TObject);
+ procedure mnu_optionsShowHighsAndLowsClick(Sender: TObject);
+ procedure mnu_optionsTakeReadingNowClick(Sender: TObject);
+ procedure mnu_SampleEvery1HourClick(Sender: TObject);
+ procedure mnu_SampleEvery24HoursClick(Sender: TObject);
+ procedure mnu_SampleEvery2HoursClick(Sender: TObject);
+ procedure mnu_SampleEvery4HoursClick(Sender: TObject);
+ procedure mnu_SampleEvery8HoursClick(Sender: TObject);
+ procedure tmr_foobotTimer(Sender: TObject);
+ private
+ sSecretKey, sFoobotUserName, sUUID: string;
+ bShowHighsAndLows: boolean;
+ iFudgeFactor: integer;
+ iSampleInterval:Integer;
+ procedure DisplayReadings;
+ procedure UpdateGuage(Sender: TAnalogSensor; SensorNumber: integer);
+ procedure UpdateHighLow(SensorNumber: integer);
+ public
+ INI: TCryptINIfile;
+ end;
+
+var
+ mainform: Tmainform;
+
+implementation
+
+{$R *.lfm}
+
+{ Tmainform }
+
+procedure Tmainform.FormCreate(Sender: TObject);
+begin
+ Caption := Application.Title;
+ Icon := Application.Icon;
+ INI := TCryptINIfile.Create(GetAppConfigFile(False));
+ if INI.IsVirgin then
+ begin
+ INI.WriteIdent('Gordon Bamber', '(c)2016', 'GPLV2',
+ 'minesadorada@charcodelvalle.com', True);
+ end;
+ if not INI.VerifyIdent('41d10218d247980fc5e871b6b7844483') then
+ begin
+ ShowMessage(Application.Title +
+ ' has been tampered wth. Please re-install from a trusted source.');
+ FreeAndNil(INI);
+ Application.Terminate;
+ end;
+ INI.SectionHashing:=FALSE;
+ ResetHighLows;
+ iFudgeFactor := 20;
+ ClientHeight := grp_sensorDisplay.Height + grp_highlow.Height + iFudgeFactor;
+ bShowHighsAndLows := True;
+end;
+
+procedure Tmainform.FormActivate(Sender: TObject);
+Var sTempFoobotUserName,sTempSecretKey:String;
+
+begin
+ // Allow user to enter values in INIFile
+ sTempFoobotUserName:=INI.ReadUnencryptedString('Config','Foobot User','unknown');
+ sTempSecretKey:=INI.ReadUnencryptedString('Config', 'Secret Key', 'unknown');
+ if ((sTempFoobotUserName <> 'unknown') and (sTempSecretKey <> 'unknown')) then
+ begin
+ INI.WriteString('Foobot', 'Foobot User', sTempFoobotUserName);
+ INI.DeleteKey('Config','Foobot User');
+ INI.WriteString('Foobot', 'Secret Key', sTempSecretKey);
+ INI.DeleteKey('Config','Secret Key');
+ end;
+ // Fetch Username and API_KEY
+ sFoobotUserName := INI.ReadString('Foobot', 'Foobot User', 'unknown');
+ sSecretKey := INI.ReadString('Foobot', 'Secret Key', 'unknown');
+ if ((sFoobotUserName <> 'unknown') and (sSecretKey <> 'unknown')) then
+ begin
+ Hide;
+ if FetchFoobotIdentity(sFoobotUserName, sSecretKey) then
+ begin
+ if FoobotIdentityObject.FoobotIdentityList.Count > 0 then
+ begin
+ sUUID := FoobotIdentityObject.FoobotIdentityList.Items[0].uuid;
+ SaveLoadHighLows:=INI.ReadBool('Foobot','SaveLoadHighLows',TRUE);
+ mnu_optionsSaveHighLows.Checked:=SaveLoadHighLows;
+ If SaveLoadHighLows then LoadHighLows;
+ mnu_optionsTakeReadingNow.Click;
+ // Switch off for testing
+ tmr_foobot.Interval:=ONEHOUR;
+ tmr_foobot.Enabled:=TRUE;
+ Show;
+ end;
+ end
+ else Close;
+ end
+ else
+ begin
+ // No valid cfg. Show config form
+ Hide;
+ Application.ProcessMessages;
+ configform.ShowModal;
+ // If user quit without data, then bail out
+ If NOT configform.bValid then
+ begin
+ Close;
+ end;
+ // Store encrypted Username and API_KEY
+ INI.WriteString('Foobot', 'Foobot User', configform.FoobotUsername);
+ INI.WriteString('Foobot', 'Secret Key', configform.FoobotSecretKey);
+ //sFoobotUserName := INI.ReadString('Foobot', 'Foobot User', 'unknown');
+ //sSecretKey := INI.ReadString('Foobot', 'Secret Key', 'unknown');
+ ShowMessage('Click OK to store settings and close the app.' + LineEnding + 'New settings are applied on resart.');
+ Close;
+ end;
+end;
+
+procedure Tmainform.FormDestroy(Sender: TObject);
+begin
+ FreeAndNil(INI);
+end;
+
+procedure Tmainform.FormShow(Sender: TObject);
+begin
+end;
+
+procedure Tmainform.mnu_fileExitClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure Tmainform.mnu_optionsSaveHighLowsClick(Sender: TObject);
+begin
+ SaveLoadHighLows:=mnu_optionsSaveHighLows.Checked;
+ INI.WriteBool('Foobot','SaveLoadHighLows',SaveLoadHighLows);
+end;
+
+procedure Tmainform.mnu_optionsShowHighsAndLowsClick(Sender: TObject);
+begin
+ if mnu_optionsShowHighsAndLows.Checked then
+ mainform.ClientHeight := grp_sensorDisplay.Height + grp_highlow.Height + iFudgeFactor
+ else
+ mainform.ClientHeight := grp_sensorDisplay.Height + iFudgeFactor;
+ bShowHighsAndLows := mnu_optionsShowHighsAndLows.Checked;
+end;
+
+procedure Tmainform.mnu_optionsTakeReadingNowClick(Sender: TObject);
+begin
+ mainform.Cursor := crHourGlass;
+ // Only Foobot #0
+ if FetchFoobotData(dfLast, 0, 0, 0, 0, 0, sSecretKey) then
+ DisplayReadings
+ else
+ ShowMessage('Sorry - no readings available');
+ mainform.Cursor := crDefault;
+end;
+
+procedure Tmainform.mnu_SampleEvery1HourClick(Sender: TObject);
+begin
+ tmr_foobot.Enabled:=FALSE;
+ tmr_foobot.Interval:=ONEHOUR;
+ tmr_foobot.Enabled:=TRUE;
+end;
+
+procedure Tmainform.mnu_SampleEvery24HoursClick(Sender: TObject);
+begin
+ tmr_foobot.Enabled:=FALSE;
+ tmr_foobot.Interval:=TWENTYFOURHOURS;
+ tmr_foobot.Enabled:=TRUE;
+end;
+
+procedure Tmainform.mnu_SampleEvery2HoursClick(Sender: TObject);
+begin
+ tmr_foobot.Enabled:=FALSE;
+ tmr_foobot.Interval:=TWOHOURS;
+ tmr_foobot.Enabled:=TRUE;
+end;
+
+procedure Tmainform.mnu_SampleEvery4HoursClick(Sender: TObject);
+begin
+ tmr_foobot.Enabled:=FALSE;
+ tmr_foobot.Interval:=FOURHOURS;
+ tmr_foobot.Enabled:=TRUE;
+end;
+
+procedure Tmainform.mnu_SampleEvery8HoursClick(Sender: TObject);
+begin
+ tmr_foobot.Enabled:=FALSE;
+ tmr_foobot.Interval:=EIGHTHOURS;
+ tmr_foobot.Enabled:=TRUE;
+end;
+
+procedure Tmainform.tmr_foobotTimer(Sender: TObject);
+begin
+ if FetchFoobotData(dfLast, 0, 0, 0, 0, 0, sSecretKey) then
+ DisplayReadings;
+end;
+
+procedure Tmainform.UpdateHighLow(SensorNumber: integer);
+begin
+ case SensorNumber of
+ 1:
+ begin
+ lbl_pmhigh.Caption := Format(
+ 'High: %f %s', [double(FoobotDataHighs[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) + LineEnding + 'on ' +
+ FormatDateTime('dd/mm tt', TDateTime(FoobotDataHighTimes[SensorNumber]));
+ lbl_pmLow.Caption := Format(
+ 'Low: %f %s', [double(FoobotDataLows[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) +
+ LineEnding + 'on ' + FormatDateTime('dd/mm tt', TDateTime(
+ FoobotDataLowTimes[SensorNumber]));
+ end;
+ 2:
+ begin
+ lbl_tmphigh.Caption := Format(
+ 'High: %f %s', [double(FoobotDataHighs[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) + LineEnding + 'on ' +
+ FormatDateTime('dd/mm tt', TDateTime(FoobotDataHighTimes[SensorNumber]));
+ lbl_tmpLow.Caption := Format(
+ 'Low: %f %s', [double(FoobotDataLows[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) +
+ LineEnding + 'on ' + FormatDateTime('dd/mm tt', TDateTime(
+ FoobotDataLowTimes[SensorNumber]));
+ end;
+ 3:
+ begin
+ lbl_humhigh.Caption := Format(
+ 'High: %f %s', [double(FoobotDataHighs[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) + LineEnding + 'on ' +
+ FormatDateTime('dd/mm tt', TDateTime(FoobotDataHighTimes[SensorNumber]));
+ lbl_humLow.Caption := Format(
+ 'Low: %f %s', [double(FoobotDataLows[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) +
+ LineEnding + 'on ' + FormatDateTime('dd/mm tt', TDateTime(
+ FoobotDataLowTimes[SensorNumber]));
+ end;
+ 4:
+ begin
+ lbl_co2high.Caption := Format(
+ 'High: %f %s', [double(FoobotDataHighs[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) + LineEnding + 'on ' +
+ FormatDateTime('dd/mm tt', TDateTime(FoobotDataHighTimes[SensorNumber]));
+ lbl_co2Low.Caption := Format(
+ 'Low: %f %s', [double(FoobotDataLows[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) +
+ LineEnding + 'on ' + FormatDateTime('dd/mm tt', TDateTime(
+ FoobotDataLowTimes[SensorNumber]));
+ end;
+ 5:
+ begin
+ lbl_vochigh.Caption := Format(
+ 'High: %f %s', [double(FoobotDataHighs[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) + LineEnding + 'on ' +
+ FormatDateTime('dd/mm tt', TDateTime(FoobotDataHighTimes[SensorNumber]));
+ lbl_vocLow.Caption := Format(
+ 'Low: %f %s', [double(FoobotDataLows[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) +
+ LineEnding + 'on ' + FormatDateTime('dd/mm tt', TDateTime(
+ FoobotDataLowTimes[SensorNumber]));
+ end;
+ 6:
+ begin
+ lbl_allpolluhigh.Caption :=
+ Format('High: %f %s', [double(FoobotDataHighs[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) + LineEnding + 'on ' +
+ FormatDateTime('dd/mm tt', TDateTime(FoobotDataHighTimes[SensorNumber]));
+ lbl_allpollulow.Caption :=
+ Format('Low: %f %s', [double(FoobotDataLows[SensorNumber]),
+ FoobotDataObject.Units[SensorNumber]]) + LineEnding + 'on ' +
+ FormatDateTime('dd/mm tt', TDateTime(FoobotDataLowTimes[SensorNumber]));
+ end;
+ end;
+end;
+
+procedure Tmainform.UpdateGuage(Sender: TAnalogSensor; SensorNumber: integer);
+begin
+ with Sender do
+ begin
+ case SensorNumber of
+ 1:
+ begin
+ Value := FoobotData_pm[0];
+ Caption := Format('PM (%s): ', [FoobotDataObject.Units[SensorNumber]]);
+ end;
+ 2:
+ begin
+ Value := FoobotData_tmp[0];
+ Caption := Format('Temp (%s): ', [FoobotDataObject.Units[SensorNumber]]);
+ end;
+ 3:
+ begin
+ Value := FoobotData_hum[0];
+ Caption := Format('Hum. (%s): ', [FoobotDataObject.Units[SensorNumber]]);
+ end;
+ 4:
+ begin
+ Value := FoobotData_co2[0];
+ Caption := Format('CO2 (%s): ', [FoobotDataObject.Units[SensorNumber]]);
+ end;
+ 5:
+ begin
+ Value := FoobotData_voc[0];
+ Caption := Format('VOC (%s): ', [FoobotDataObject.Units[SensorNumber]]);
+ end;
+ 6:
+ begin
+ Value := FoobotData_allpollu[0];
+ Caption := Format('All (%s): ', [FoobotDataObject.Units[SensorNumber]]);
+ end;
+ end;
+ if Value > ValueMax then
+ ValueMax := Value;
+ ValueYellow := ValueMax;
+ if Value > ValueRed then
+ ValueRed := Value;
+ end;
+end;
+
+procedure Tmainform.DisplayReadings;
+var
+ iCount: integer;
+begin
+ if FoobotDataObjectToArrays = True then
+ begin
+ mainform.Caption := Format('Foobot "%s" - ',
+ [FoobotIdentityObject.FoobotIdentityList[0].Name]) +
+ FormatDateTime('dd/mm/yyyy - tt', FoobotData_time[0]);
+ UpdateGuage(as_pm, 1);
+ UpdateGuage(as_tmp, 2);
+ UpdateGuage(as_hum, 3);
+ UpdateGuage(as_co2, 4);
+ UpdateGuage(as_voc, 5);
+ UpdateGuage(as_allpollu, 6);
+ if bShowHighsAndLows then
+ for iCount := 1 to 6 do
+ UpdateHighLow(iCount);
+ end;
+end;
+
+end.