diff --git a/components/tvplanit/examples/fulldemo/demo.lpi b/components/tvplanit/examples/fulldemo/demo.lpi
index 3316d39ff..ad915031e 100644
--- a/components/tvplanit/examples/fulldemo/demo.lpi
+++ b/components/tvplanit/examples/fulldemo/demo.lpi
@@ -26,6 +26,7 @@
+
diff --git a/components/tvplanit/examples/fulldemo/mormotdatamodule.pas b/components/tvplanit/examples/fulldemo/mormotdatamodule.pas
index d535a6e69..e0b5d5d45 100644
--- a/components/tvplanit/examples/fulldemo/mormotdatamodule.pas
+++ b/components/tvplanit/examples/fulldemo/mormotdatamodule.pas
@@ -9,17 +9,19 @@ uses
type
+
{ TDemoDM }
TDemoDM = class(TDataModule)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
- FNoServer: Boolean;
+ FHostIP: String;
procedure ReadCmdLine;
public
Datastore: TVpmORMotDatastore;
constructor Create(AOwner: TComponent); override;
+ destructor Destroy;
end;
var
@@ -29,6 +31,11 @@ implementation
{$R *.lfm}
+const
+ // IP address of AWS (amazon web service) tvplanit demoserver
+ AWS_HOST_IP = '54.194.211.233';
+
+
constructor TDemoDM.Create(AOwner: TComponent);
begin
inherited;
@@ -39,12 +46,14 @@ begin
with Datastore do
begin
- // if the HostIP is set, it will look for a running server on this IP address when connecting.
- // leave blank (comment out) for a local (and private) database
- if FNoServer then
- HostIP := '' else
- HostIP := 'localhost';
+ // if the HostIP is set, it will look for a running server on this IP
+ // address when connecting.
+ // leave blank (comment out) for a local (and private) database
+ HostIP := FHostIP;
+ HostPort := '8888';
+ EnableLogging := True;
+
Directory := 'data';
Connected := true;
@@ -58,18 +67,29 @@ begin
Timer1.Enabled := true;
end;
+destructor TDemoDM.Destroy;
+begin
+ Timer1.Enabled := false;
+ inherited;
+end;
+
+{ Use to commandline to switch between different servers.
+ - noserver --> don't use server, for a local (and private) database)
+ - localhost --> use server on local system
+ - (empty) --> use AWS (amazon web service) tvplanit demo server
+ - else --> specify ip address of server }
procedure TDemoDM.ReadCmdLine;
var
s: String;
i: Integer;
begin
+ FHostIP := AWS_HOST_IP;
for i:=1 to ParamCount do begin
s := lowercase(ParamStr(i));
- if (s[1] = '-') or (s[1] = '/') then begin
- Delete(s, 1, 1);
- if s = 'noserver' then
- FNoServer := true;
- end;
+ if s = 'noserver' then
+ FHostIP := ''
+ else
+ FHostIP := s;
end;
end;
diff --git a/components/tvplanit/examples/fulldemo/mormotdemo.lpi b/components/tvplanit/examples/fulldemo/mormotdemo.lpi
index 9dfee0fef..c70d57c71 100644
--- a/components/tvplanit/examples/fulldemo/mormotdemo.lpi
+++ b/components/tvplanit/examples/fulldemo/mormotdemo.lpi
@@ -80,7 +80,6 @@
-
diff --git a/components/tvplanit/examples/fulldemo/mormotdemo.lpr b/components/tvplanit/examples/fulldemo/mormotdemo.lpr
index f7dcc631c..a92d78e18 100644
--- a/components/tvplanit/examples/fulldemo/mormotdemo.lpr
+++ b/components/tvplanit/examples/fulldemo/mormotdemo.lpr
@@ -1,7 +1,16 @@
program mormotdemo;
+{ IMPORTANT NOTE:
+ If compilation aborts with an error that libkernel32a, libgcc.a and libmsvcrt.a
+ cannot be found then do a rebuild ("Run" / "Build"). Or add the corresponding
+ folder to the library path of the project, the obj files are in folder
+ mORMotSourceHere/fpc-win32, etc. }
+
{ commandline parameters:
- -noserver ---> run without server, otherwise HostIP is localhost }
+ - noserver ---> run without server
+ - localhost ---> server ip is localhost
+ - empty ---> server is tvplanit demo server on Amazon Web Services
+ - xxx.xxx.xxx.xxx ---> ip address for server connection. }
{$mode objfpc}{$H+}
diff --git a/components/tvplanit/examples/mormot/RESTServerClass.pas b/components/tvplanit/examples/mormot/RESTServerClass.pas
index fd33b8079..d800ccd99 100644
--- a/components/tvplanit/examples/mormot/RESTServerClass.pas
+++ b/components/tvplanit/examples/mormot/RESTServerClass.pas
@@ -4,7 +4,7 @@ interface
{$I Synopse.inc}
-{.$define USEWRAPPERS}
+{$define USEWRAPPERS}
uses
SysUtils,
@@ -72,7 +72,7 @@ begin
// define the log level
with TSQLLog.Family do begin
Level := LOG_VERBOSE; // LOG_STACKTRACE;
- DestinationPath := fRootFolder+'..\log\';
+ DestinationPath := fRootFolder+'..'+DirectorySeparator+'log'+DirectorySeparator;
if not FileExists(DestinationPath) then
CreateDir(DestinationPath);
PerThreadLog := ptIdentifiedInOnFile;
diff --git a/components/tvplanit/examples/mormot/VpRESTserver.lpi b/components/tvplanit/examples/mormot/VpRESTserver.lpi
index 6ff933de5..478c460d7 100644
--- a/components/tvplanit/examples/mormot/VpRESTserver.lpi
+++ b/components/tvplanit/examples/mormot/VpRESTserver.lpi
@@ -25,7 +25,7 @@
-
+
@@ -45,6 +45,24 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/tvplanit/examples/mormot/VpRESTserver.lpr b/components/tvplanit/examples/mormot/VpRESTserver.lpr
index 7918c5617..7f8230bb7 100644
--- a/components/tvplanit/examples/mormot/VpRESTserver.lpr
+++ b/components/tvplanit/examples/mormot/VpRESTserver.lpr
@@ -5,11 +5,18 @@ program VpRESTserver;
{$APPTYPE CONSOLE}
{$endif}
+{$ifdef Linux}
+ {$ifdef FPC_CROSSCOMPILING}
+ {$linklib libc_nonshared.a}
+ {$endif}
+{$endif}
+
+
{$I Synopse.inc} // define HASINLINE WITHLOG USETHREADPOOL ONLYUSEHTTPSOCKET
// first line after uses clause should be {$I SynDprUses.inc} for FastMM4
uses
- {$I SynDprUses.inc}
+ {$I SynDprUses.inc} // <--- has cthreads if needed
Classes,
SysUtils,
SynCommons,
@@ -33,7 +40,7 @@ begin
try
sleep(300); // let the HTTP server start (for the console log refresh)
writeln(#13#10'Background server is running at http://localhost:'+HTTP_PORT+#13#10+
- // #13#10'Wrappers at http://localhost:'+HTTP_PORT+'/root/wrapper'+#13#10+
+ #13#10'Wrappers at http://localhost:'+HTTP_PORT+'/root/wrapper'+#13#10+
#13#10'Press [Enter] to close the server.');
readln;
finally
diff --git a/components/tvplanit/examples/mormot/VpRESTserverDaemon.lpi b/components/tvplanit/examples/mormot/VpRESTserverDaemon.lpi
new file mode 100644
index 000000000..2c3ba273e
--- /dev/null
+++ b/components/tvplanit/examples/mormot/VpRESTserverDaemon.lpi
@@ -0,0 +1,100 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/tvplanit/examples/mormot/VpRESTserverDaemon.lpr b/components/tvplanit/examples/mormot/VpRESTserverDaemon.lpr
new file mode 100644
index 000000000..9201c475e
--- /dev/null
+++ b/components/tvplanit/examples/mormot/VpRESTserverDaemon.lpr
@@ -0,0 +1,139 @@
+program VpRESTserverDaemon;
+
+{$ifdef Linux}
+ {$ifdef FPC_CROSSCOMPILING}
+ {$linklib libc_nonshared.a}
+ {$endif}
+{$endif}
+
+{$I Synopse.inc} // define HASINLINE WITHLOG USETHREADPOOL ONLYUSEHTTPSOCKET
+uses
+ {$I SynDprUses.inc} // <--- has cthreads if needed
+ Classes,
+ SysUtils,
+ SynLog,
+ mORMotHTTPServer,
+ daemonapp;
+
+Type
+ TTestDaemon = Class(TCustomDaemon)
+ Private
+ fVpServer: TVpServer;
+ fHTTPServer: TSQLHttpServer;
+ public
+ Function Start : Boolean; override;
+ Function Stop : Boolean; override;
+ Function Pause : Boolean; override;
+ Function Continue : Boolean; override;
+ Function Execute : Boolean; override;
+ Function ShutDown : Boolean; override;
+ Function Install : Boolean; override;
+ Function UnInstall: boolean; override;
+ end;
+
+{ TTestThread }
+
+Procedure AWriteln(MSg : String; B : Boolean);
+begin
+ Application.Log(etcustom,Msg+BoolToStr(B));
+end;
+
+{ TTestDaemon }
+
+function TTestDaemon.Start: Boolean;
+begin
+ Result:=inherited Start;
+ AWriteln('Daemon Start',Result);
+ AWriteln('Dir: '+GetAppConfigDir(False)+'data',True);
+ if not DirectoryExists(GetAppConfigDir(False))
+ then CreateDir(GetAppConfigDir(False));
+ fVpServer := TVpServer.Create(GetAppConfigDir(False)+'data','root');
+ fHTTPServer := TSQLHttpServer.Create(HTTP_PORT,fVpServer{$ifndef ONLYUSEHTTPSOCKET},'+',useHttpApiRegisteringURI{$endif});
+ fHTTPServer.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
+end;
+
+function TTestDaemon.Stop: Boolean;
+begin
+ Result:=inherited Stop;
+ AWriteln('Daemon Stop: ',Result);
+ FreeAndNil(fHTTPServer);
+ FreeAndNil(fVpServer);
+end;
+
+function TTestDaemon.Pause: Boolean;
+begin
+ Result:=inherited Pause;
+ AWriteln('Daemon pause: ',Result);
+end;
+
+function TTestDaemon.Continue: Boolean;
+begin
+ Result:=inherited Continue;
+ AWriteln('Daemon continue: ',Result);
+end;
+
+function TTestDaemon.Execute: Boolean;
+begin
+ Result:=inherited Execute;
+ AWriteln('Daemon execute: ',Result);
+end;
+
+function TTestDaemon.ShutDown: Boolean;
+begin
+ Result:=inherited ShutDown;
+ AWriteln('Daemon Shutdown: ',Result);
+ try
+ try
+ FreeAndNil(fHTTPServer);
+ except
+ end;
+ finally
+ FreeAndNil(fVpServer);
+ end;
+end;
+
+function TTestDaemon.Install: Boolean;
+begin
+ Result:=inherited Install;
+ AWriteln('Daemon Install: ',Result);
+end;
+
+function TTestDaemon.UnInstall: boolean;
+begin
+ Result:=inherited UnInstall;
+ AWriteln('Daemon UnInstall: ',Result);
+end;
+
+Type
+
+ { TTestDaemonMapper }
+
+ TTestDaemonMapper = Class(TCustomDaemonMapper)
+ Constructor Create(AOwner : TComponent); override;
+ end;
+
+{ TTestDaemonMapper }
+
+constructor TTestDaemonMapper.Create(AOwner: TComponent);
+
+Var
+ D : TDaemonDef;
+
+begin
+ inherited Create(AOwner);
+ D:=DaemonDefs.Add as TDaemonDef;
+ D.DisplayName:='Test daemon';
+ D.Name:='TestDaemon';
+ D.DaemonClassName:='TTestDaemon';
+ //D.WinBindings.ServiceType:=stWin32;
+end;
+
+{$R *.res}
+
+begin
+ RegisterDaemonClass(TTestDaemon);
+ RegisterDaemonMapper(TTestDaemonMapper);
+ Application.Run;
+end.
+
+
diff --git a/components/tvplanit/examples/mormot/VpRESTserverRegister.lpi b/components/tvplanit/examples/mormot/VpRESTserverRegister.lpi
new file mode 100644
index 000000000..91c32d43b
--- /dev/null
+++ b/components/tvplanit/examples/mormot/VpRESTserverRegister.lpi
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/tvplanit/examples/mormot/VpRESTserverRegister.lpr b/components/tvplanit/examples/mormot/VpRESTserverRegister.lpr
new file mode 100644
index 000000000..5dcc74225
--- /dev/null
+++ b/components/tvplanit/examples/mormot/VpRESTserverRegister.lpr
@@ -0,0 +1,37 @@
+{ in order to be able to use http.sys server for VpRESTserver.exe
+ under Vista or Seven, call first this program with Administrator rights
+ - you can unregister it later with command line parameter /delete }
+program VpRESTserverRegister;
+
+{$APPTYPE CONSOLE}
+
+uses
+ {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+ SynCrtSock,
+ SysUtils;
+
+const
+ REGSTR: array[boolean] of string = (
+ 'Registration', 'Deletion');
+
+{$R mORMotSourceHere\VistaAdm.res} // force elevation to Administrator under Vista/Seven
+
+var delete: boolean;
+
+procedure Call(const Root: SockString);
+begin
+ writeln(REGSTR[delete],' of http://+:888/',root,'/ for http.sys');
+ writeln(THttpApiServer.AddUrlAuthorize(root,'888',false,'+',delete));
+end;
+
+begin
+ // test if we have to un-register the url
+ delete := (ParamCount=1) and SameText(ParamStr(1),'/DELETE');
+ // perform url (un)registration for http.sys
+ // (e.g. to be run as administrator under Windows Vista/Seven)
+ Call('root'); // for the TSQLModel as defined in RESTData.pas
+ // we're done
+ WriteLn('Done - Press ENTER to Exit');
+ ReadLn;
+end.
+
diff --git a/components/tvplanit/examples/mormot/vpmormotds.pas b/components/tvplanit/examples/mormot/vpmormotds.pas
index 2184f5cdc..bbe9abe0f 100644
--- a/components/tvplanit/examples/mormot/vpmormotds.pas
+++ b/components/tvplanit/examples/mormot/vpmormotds.pas
@@ -28,6 +28,8 @@
{$I Vp.INC}
+{$I Synopse.inc}
+
unit VpmORMotDS;
interface
@@ -60,6 +62,7 @@ type
FDatabase : TSQLRest;
FModel : TSQLModel;
FHostIP : string;
+ FHostPort : string;
FDirectory : string;
aSQLResourceTable : TSQLTable;
@@ -67,6 +70,8 @@ type
aSQLContactTable : TSQLTable;
aSQLTaskTable : TSQLTable;
+ FEnableLogging : boolean;
+
procedure RefreshTable(aTable:TDataset);
{ property getters }
@@ -79,6 +84,7 @@ type
{ property setters }
procedure SetConnected(const Value: boolean); override;
procedure SetHostIP(const Value: string);
+ procedure SetHostPort(const Value: string);
procedure SetDirectory(const Value: string);
public
constructor Create(AOwner: TComponent); override;
@@ -102,7 +108,9 @@ type
procedure PurgeTasks(Res: TVpResource); override;
property HostIP: string read FHostIP write SetHostIP;
+ property HostPort: string read FHostPort write SetHostPort;
property Directory: string read FDirectory write SetDirectory;
+ property EnableLogging: boolean read FEnableLogging write FEnableLogging;
property CheckUpdate:boolean read CheckServer;
end;
@@ -116,6 +124,9 @@ uses
TypInfo,
{$endif}
Variants,
+ {$ifdef WITHLOG}
+ SynLog,
+ {$endif}
SynSQLite3,
RESTdata;
@@ -197,7 +208,9 @@ constructor TVpmORMotDataStore.Create(AOwner: TComponent);
begin
inherited;
FHostIP := '';
+ FHostPort := HTTP_PORT;
FModel := DataModel;
+ FEnableLogging := False;
end;
{=====}
@@ -758,6 +771,7 @@ var
aFieldType : TSQLFieldType;
i,j : integer;
aDBFile : string;
+ ErrMsg : string;
begin
{ Don't do anything with live data until run time. }
@@ -778,17 +792,71 @@ begin
if Assigned(FDatabase) then FDatabase.Free;
if length(HostIP)>0
- then FDatabase:=TSQLHttpClient.Create(FHostIP,HTTP_PORT,FModel)
+ then FDatabase:=TSQLHttpClient.Create(HostIP,HostPort,FModel)
else FDatabase:=TSQLRestServerDB.Create(FModel,aDBFile,True);
- if FDatabase.InheritsFrom(TSQLRestClient) then
+ if FDatabase.InheritsFrom(TSQLRestClientURI) then with (FDatabase AS TSQLRestClientURI) do
begin
- if NOT TSQLHttpClient(FDatabase).SetUser('User','synopse') then
+
+ {$ifdef WITHLOG}
+ if FEnableLogging then
+ begin
+ with TSQLLog.Family do
+ begin
+ Level := LOG_VERBOSE; // LOG_STACKTRACE;
+ PerThreadLog := ptIdentifiedInOnFile;
+ end;
+ TSQLLog.Add.Log(sllInfo,'Going to contact server at IP:'+HostIP+' on port #'+HostPort);
+ end;
+ {$endif}
+
+
+ ErrMsg:=LastErrorMessage;
+ if Length(ErrMsg)>0 then
+ begin
+ FConnected:=False;
+ {$ifdef WITHLOG}
+ if FEnableLogging then TSQLLog.Add.Log(sllError,'Could not contact server due to: '+ErrMsg);
+ {$endif}
+ end;
+
+ if ServerTimeStamp=0 then
+ begin
+ FConnected:=False;
+ {$ifdef WITHLOG}
+ if FEnableLogging then TSQLLog.Add.Log(sllError,'Could not connect with server');
+ {$endif}
+ end;
+
+ if NOT ServerTimeStampSynchronize then
+ begin
+ FConnected:=False;
+ {$ifdef WITHLOG}
+ if FEnableLogging then TSQLLog.Add.Log(sllError,'Could not synchronize time with server');
+ {$endif}
+ end;
+
+ MaximumAuthentificationRetry:=5;
+ RetryOnceOnTimeout:=True;
+
+ if NOT SetUser('User','synopse') then
+ begin
+ FConnected:=False;
+ {$ifdef WITHLOG}
+ if FEnableLogging then TSQLLog.Add.Log(sllError,'Authentication failure');
+ {$endif}
+ end;
+
+ if NOT Connected then
begin
inherited SetConnected(False);
- FConnected:=False;
exit;
end;
+
+ {$ifdef WITHLOG}
+ if FEnableLogging then TSQLLog.Add.Log(sllInfo,'Connected successfully with server at IP:'+HostIP+' on port #'+HostPort+' !!');
+ {$endif}
+
end;
if FDatabase.InheritsFrom(TSQLRestServer) then
@@ -810,9 +878,16 @@ begin
if aTable=nil then continue;
// fill readonly table
- if j=0
- then aSQLTable:=FDatabase.MultiFieldValues(aTable,'*','order by ID')
- else aSQLTable:=FDatabase.MultiFieldValues(aTable,'*','%=?',['ResourceID'],[ResourceID]);
+ case j of
+ 0:aSQLTable:=FDatabase.MultiFieldValues(aTable,'*','order by ID');
+ 1:aSQLTable:=FDatabase.MultiFieldValues(
+ aTable,'*',
+ '(%=?) AND (%>=? AND %<=?) OR (RepeatCode>0 AND ?<=%)',
+ ['ResourceID','StartTime','EndTime','RepeatRangeEnd'],
+ [ResourceID,DateTimeToSQL(FTimeRange.StartTime),DateTimeToSQL(FTimeRange.EndTime),DateTimeToSQL(FTimeRange.StartTime)]);
+ else
+ aSQLTable:=FDatabase.MultiFieldValues(aTable,'*','%=?',['ResourceID'],[ResourceID]);
+ end;
// tricky ... force set field size
for i := 0 to aSQLTable.FieldCount-1 do
@@ -843,6 +918,10 @@ begin
Load;
+ {$ifdef WITHLOG}
+ if FEnableLogging then TSQLLog.Add.Log(sllInfo,'All data successfully loaded from database');
+ {$endif}
+
end else if Assigned(FDatabase) then FDatabase.Free;
end;
@@ -855,6 +934,15 @@ begin
end;
end;
+procedure TVpmORMotDataStore.SetHostPort(const Value: string);
+begin
+ if FHostPort<>Value then
+ begin
+ FHostPort:=Value;
+ end;
+end;
+
+
procedure TVpmORMotDataStore.SetDirectory(const Value: string);
begin
if Value = FDirectory then
@@ -929,9 +1017,16 @@ begin
aSQLRecordClass:=aSQLTable.QueryRecordType;
aSQLTable.Free;
+
if aTable=ResourceTable
then aSQLTable:=FDatabase.MultiFieldValues(aSQLRecordClass,'*','order by ID')
- else aSQLTable:=FDatabase.MultiFieldValues(aSQLRecordClass,'*','%=?',['ResourceID'],[ResourceID]);
+ else if aTable=EventsTable
+ then aSQLTable:=FDatabase.MultiFieldValues(
+ aSQLRecordClass,'*',
+ '(%=?) AND (%>=? AND %<=?) OR (RepeatCode>0 AND ?<=%)',
+ ['ResourceID','StartTime','EndTime','RepeatRangeEnd'],
+ [ResourceID,DateTimeToSQL(FTimeRange.StartTime),DateTimeToSQL(FTimeRange.EndTime),DateTimeToSQL(FTimeRange.StartTime)])
+ else aSQLTable:=FDatabase.MultiFieldValues(aSQLRecordClass,'*','%=?',['ResourceID'],[ResourceID]);
TSynSQLTableDatasetWithLocate(aTable).Table:=aSQLTable;
diff --git a/components/tvplanit/readme.txt b/components/tvplanit/readme.txt
index 143e8fd27..794d205d6 100644
--- a/components/tvplanit/readme.txt
+++ b/components/tvplanit/readme.txt
@@ -9,6 +9,7 @@ Table of contents
4. Version history
4.1 Release 1.03
4.2 Release 1.04
+4.3 Release 1.05
==============================================
@@ -107,6 +108,12 @@ steps:
misc - Translate user interface in po files
misc - DPI-aware and translation-tolerant form layout
misc - Add new sample projects
+
+
+4.3 Release 1.05
+
+ misc - Add mORMot datastore
+ 5103 - Add drag and drop of events within DayView