You've already forked lazarus-ccr
tvplanit: Add mORMot datastore and example (kindly provided by forum user DonAlfredo, thank you).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5118 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -1,6 +1,9 @@
|
||||
The folder "datastores" collects some demo projects to show usage of the
|
||||
various datastores that come along with TvPlanIt:
|
||||
|
||||
Datastores working with the default Lazarus installation
|
||||
--------------------------------------------------------
|
||||
|
||||
- TVpBufDsDatastore in folder "bufdataset" (for TBufDataset)
|
||||
|
||||
- TVpFirebirdDatastore in folder "fb" (for Firebird databases using SQLDB)
|
||||
@ -12,5 +15,13 @@ various datastores that come along with TvPlanIt:
|
||||
|
||||
- TVpSqlite3Datastore in folder "sqlite3" (for SQLite3 database using SQLDB)
|
||||
|
||||
|
||||
Add-on datastores requiring third-party components/code:
|
||||
--------------------------------------------------------
|
||||
|
||||
- TVpZeosDatastore in folder "zeos"
|
||||
requires installation of package "laz_visualplanit_zeos"
|
||||
requires installation of package "laz_visualplanit_zeos"
|
||||
|
||||
- TVpmORMotDatastore in folder "examples/mormot":
|
||||
Since this datastore depends on third-party source code it is not added in
|
||||
its own package. Just look at the sample code in folder "examples/mormot".
|
||||
|
||||
273
components/tvplanit/examples/mormot/RESTData.pas
Normal file
273
components/tvplanit/examples/mormot/RESTData.pas
Normal file
@ -0,0 +1,273 @@
|
||||
unit RESTData;
|
||||
|
||||
interface
|
||||
|
||||
{$I Synopse.inc}
|
||||
|
||||
uses
|
||||
Types,
|
||||
SynCommons,
|
||||
mORMot;
|
||||
|
||||
type
|
||||
TVpEventRec = packed record
|
||||
Rec: TRect;
|
||||
IconRect: TRect;
|
||||
Event: Pointer;
|
||||
end;
|
||||
|
||||
TVpEventArray = array of TVpEventRec;
|
||||
|
||||
TVpAlarmAdvanceType = (atMinutes, atHours, atDays);
|
||||
|
||||
TVpRepeatType = (rtNone, rtDaily, rtWeekly, rtMonthlyByDay, rtMonthlyByDate,
|
||||
rtYearlyByDay, rtYearlyByDate, rtCustom);
|
||||
|
||||
TVpContactSort = (csLastFirst, csFirstLast);
|
||||
|
||||
TSQLRecordWithUserFields = class(TSQLRecord)
|
||||
//TSQLRecordWithUserFields = class(TSQLRecordTimed)
|
||||
protected
|
||||
FUserField0: string;
|
||||
FUserField1: string;
|
||||
FUserField2: string;
|
||||
FUserField3: string;
|
||||
FUserField4: string;
|
||||
FUserField5: string;
|
||||
FUserField6: string;
|
||||
FUserField7: string;
|
||||
FUserField8: string;
|
||||
FUserField9: string;
|
||||
published
|
||||
property UserField0: string read FUserField0 write FUserField0;
|
||||
property UserField1: string read FUserField1 write FUserField1;
|
||||
property UserField2: string read FUserField2 write FUserField2;
|
||||
property UserField3: string read FUserField3 write FUserField3;
|
||||
property UserField4: string read FUserField4 write FUserField4;
|
||||
property UserField5: string read FUserField5 write FUserField5;
|
||||
property UserField6: string read FUserField6 write FUserField6;
|
||||
property UserField7: string read FUserField7 write FUserField7;
|
||||
property UserField8: string read FUserField8 write FUserField8;
|
||||
property UserField9: string read FUserField9 write FUserField9;
|
||||
end;
|
||||
|
||||
|
||||
TSQLVpResource = class(TSQLRecordWithUserFields)
|
||||
protected
|
||||
fResourceID: TID;
|
||||
fDescription: string;
|
||||
fNotes: string;
|
||||
fImageIndex: integer;
|
||||
fResourceActive: boolean;
|
||||
public
|
||||
class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
|
||||
Options: TSQLInitializeTableOptions); override;
|
||||
published
|
||||
property ResourceID: TID read fResourceID write fResourceID;
|
||||
property Description: string read fDescription write fDescription;
|
||||
property Notes: string read fNotes write fNotes;
|
||||
property ImageIndex: integer read fImageIndex write fImageIndex;
|
||||
property ResourceActive: boolean read fResourceActive write fResourceActive;
|
||||
end;
|
||||
|
||||
TSQLRecordWithUserFieldsAndID = class(TSQLRecordWithUserFields)
|
||||
protected
|
||||
fResourceID:integer;
|
||||
published
|
||||
property RecordID: TID read fID;
|
||||
property ResourceID: integer read fResourceID write fResourceID;
|
||||
end;
|
||||
|
||||
|
||||
TSQLVpEvent = class(TSQLRecordWithUserFieldsAndID)
|
||||
protected
|
||||
FStartTime: TDateTime;
|
||||
FEndTime: TDateTime;
|
||||
FPrivateEvent: boolean;
|
||||
FAlarmSet: boolean;
|
||||
FDingPath: string;
|
||||
FAllDayEvent: boolean;
|
||||
FCategory: integer;
|
||||
FAlarmAdvance: integer;
|
||||
FAlertDisplayed: boolean;
|
||||
FAlarmAdvanceType: TVpAlarmAdvanceType;
|
||||
FLocation: string;
|
||||
FNotes: string;
|
||||
FDescription: string;
|
||||
FSnoozeTime: TDateTime;
|
||||
FRepeatCode: TVpRepeatType;
|
||||
FRepeatRangeEnd: TDateTime;
|
||||
FCustomInterval: integer;
|
||||
published
|
||||
property StartTime: TDateTime read FStartTime write FStartTime;
|
||||
property EndTime: TDateTime read FEndTime write FEndTime;
|
||||
property Description: string read FDescription write FDescription;
|
||||
property Location: string read FLocation write FLocation;
|
||||
property Notes: string read FNotes write FNotes;
|
||||
property Category: integer read FCategory write FCategory;
|
||||
property DingPath: string read FDingPath write FDingPath;
|
||||
property AllDayEvent: boolean read FAllDayEvent write FAllDayEvent;
|
||||
property AlarmSet: boolean read FAlarmSet write FAlarmSet;
|
||||
property AlarmAdvance: integer read FAlarmAdvance write FAlarmAdvance;
|
||||
property AlarmAdvanceType: TVpAlarmAdvanceType read FAlarmAdvanceType write FAlarmAdvanceType;
|
||||
property SnoozeTime: TDateTime read FSnoozeTime write FSnoozeTime;
|
||||
property RepeatCode: TVpRepeatType read FRepeatCode write FRepeatCode;
|
||||
property RepeatRangeEnd: TDateTime read FRepeatRangeEnd write FRepeatRangeEnd;
|
||||
property CustomInterval: integer read FCustomInterval write FCustomInterval;
|
||||
end;
|
||||
|
||||
TVpPhoneType = (ptAssistant, ptCallback, ptCar, ptCompany, ptHome, ptHomeFax,
|
||||
ptISDN, ptMobile, ptOther, ptOtherFax, ptPager, ptPrimary,
|
||||
ptRadio, ptTelex, ptTTYTDD, ptWork, ptWorkFax);
|
||||
|
||||
TVpCategoryType = (ctBusiness, ctClients, ctFamily, ctOther, ctPersonal);
|
||||
|
||||
TSQLVpContact = class(TSQLRecordWithUserFieldsAndID)
|
||||
protected
|
||||
fFirstName:string;
|
||||
fLastName:string;
|
||||
fBirthdate:TDateTime;
|
||||
fAnniversary:TDateTime;
|
||||
fTitle:string;
|
||||
fCompany:string;
|
||||
fJob_Position:string;
|
||||
fEMail:string;
|
||||
fAddress:string;
|
||||
fCity:string;
|
||||
fState:string;
|
||||
fZip:string;
|
||||
fCountry:string;
|
||||
fNotes:string;
|
||||
fPhone1:string;
|
||||
fPhone2:string;
|
||||
fPhone3:string;
|
||||
fPhone4:string;
|
||||
fPhone5:string;
|
||||
fPhoneType1:TVpPhoneType;
|
||||
fPhoneType2:TVpPhoneType;
|
||||
fPhoneType3:TVpPhoneType;
|
||||
fPhoneType4:TVpPhoneType;
|
||||
fPhoneType5:TVpPhoneType;
|
||||
fCategory:TVpCategoryType;
|
||||
fCustom1:string;
|
||||
fCustom2:string;
|
||||
fCustom3:string;
|
||||
fCustom4:string;
|
||||
published
|
||||
property FirstName:string read fFirstName write fFirstName;
|
||||
property LastName:string read fLastName write fLastName;
|
||||
property Birthdate:TDateTime read fBirthdate write fBirthdate;
|
||||
property Anniversary:TDateTime read fAnniversary write fAnniversary;
|
||||
property Title:string read fTitle write fTitle;
|
||||
property Company:string read fCompany write fCompany;
|
||||
property Job_Position:string read fJob_Position write fJob_Position;
|
||||
property EMail:string read fEMail write fEMail;
|
||||
property Address:string read fAddress write fAddress;
|
||||
property City:string read fCity write fCity;
|
||||
property State:string read fState write fState;
|
||||
property Zip:string read fZip write fZip;
|
||||
property Country:string read fCountry write fCountry;
|
||||
property Notes:string read fNotes write fNotes;
|
||||
property Phone1:string read fPhone1 write fPhone1;
|
||||
property Phone2:string read fPhone2 write fPhone2;
|
||||
property Phone3:string read fPhone3 write fPhone3;
|
||||
property Phone4:string read fPhone4 write fPhone4;
|
||||
property Phone5:string read fPhone5 write fPhone5;
|
||||
property PhoneType1:TVpPhoneType read fPhoneType1 write fPhoneType1;
|
||||
property PhoneType2:TVpPhoneType read fPhoneType2 write fPhoneType2;
|
||||
property PhoneType3:TVpPhoneType read fPhoneType3 write fPhoneType3;
|
||||
property PhoneType4:TVpPhoneType read fPhoneType4 write fPhoneType4;
|
||||
property PhoneType5:TVpPhoneType read fPhoneType5 write fPhoneType5;
|
||||
property Category:TVpCategoryType read fCategory write fCategory;
|
||||
property Custom1:string read fCustom1 write fCustom1;
|
||||
property Custom2:string read fCustom2 write fCustom2;
|
||||
property Custom3:string read fCustom3 write fCustom3;
|
||||
property Custom4:string read fCustom4 write fCustom4;
|
||||
end;
|
||||
|
||||
TSQLVpTask = class(TSQLRecordWithUserFieldsAndID)
|
||||
protected
|
||||
fDescription:String;
|
||||
fDetails:String;
|
||||
fComplete:Boolean;
|
||||
fDueDate:TDateTime;
|
||||
fCreatedOn:TDateTime;
|
||||
fCompletedOn:TDateTime;
|
||||
fPriority:Integer;
|
||||
fCategory:Integer;
|
||||
published
|
||||
property Description:String read fDescription write fDescription;
|
||||
property Details:String read fDetails write fDetails;
|
||||
property Complete:Boolean read fComplete write fComplete;
|
||||
property DueDate:TDateTime read fDueDate write fDueDate;
|
||||
property CreatedOn:TDateTime read fCreatedOn write fCreatedOn;
|
||||
property CompletedOn:TDateTime read fCompletedOn write fCompletedOn;
|
||||
property Priority:Integer read fPriority write fPriority;
|
||||
property Category:Integer read fCategory write fCategory;
|
||||
end;
|
||||
|
||||
function DataModel: TSQLModel;
|
||||
|
||||
const
|
||||
{$ifdef Windows}
|
||||
HTTP_PORT = '888';
|
||||
{$else}
|
||||
HTTP_PORT = '8888';
|
||||
{$endif}
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
function DataModel: TSQLModel;
|
||||
begin
|
||||
result := TSQLModel.Create([
|
||||
//{$ifdef USEAUTHENTICATION}
|
||||
TSQLAuthGroup,
|
||||
TSQLAuthUser,
|
||||
//{$endif}
|
||||
TSQLVpResource,
|
||||
TSQLVpEvent,
|
||||
TSQLVpContact,
|
||||
TSQLVpTask
|
||||
]);
|
||||
end;
|
||||
|
||||
class procedure TSQLVpResource.InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
|
||||
Options: TSQLInitializeTableOptions);
|
||||
var
|
||||
LocalResource:TSQLVpResource;
|
||||
aNewID:TID;
|
||||
begin
|
||||
inherited InitializeTable(Server,FieldName,Options);
|
||||
if FieldName='' then
|
||||
begin
|
||||
LocalResource:=TSQLVpResource.Create;
|
||||
try
|
||||
LocalResource.Description := 'MyFirstResource';
|
||||
LocalResource.Notes := 'This is an automatically created resource only when the database was non existent';
|
||||
LocalResource.ResourceActive := True;
|
||||
aNewID:=Server.Add(LocalResource,true);
|
||||
// do we have a new resource ?
|
||||
if aNewID>0 then
|
||||
begin
|
||||
LocalResource.ResourceID:=aNewID;
|
||||
Server.Update(LocalResource,'ResourceID',true);
|
||||
end;
|
||||
finally
|
||||
LocalResource.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
{$ifndef ISDELPHI2010}
|
||||
{$ifndef HASINTERFACERTTI} // circumvent a old FPC bug
|
||||
TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TVpAlarmAdvanceType));
|
||||
TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TVpRepeatType));
|
||||
TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TVpContactSort));
|
||||
TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TVpPhoneType));
|
||||
TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TVpCategoryType));
|
||||
{$endif}
|
||||
{$endif}
|
||||
end.
|
||||
143
components/tvplanit/examples/mormot/RESTServerClass.pas
Normal file
143
components/tvplanit/examples/mormot/RESTServerClass.pas
Normal file
@ -0,0 +1,143 @@
|
||||
unit RESTServerClass;
|
||||
|
||||
interface
|
||||
|
||||
{$I Synopse.inc}
|
||||
|
||||
{.$define USEWRAPPERS}
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
SynLog,
|
||||
mORMot,
|
||||
mORMotSQLite3,
|
||||
SynSQLite3Static,
|
||||
RESTData;
|
||||
|
||||
type
|
||||
EVpServer = class(EORMException);
|
||||
|
||||
//TVpServer = class(TSQLRestServerFullMemory)
|
||||
TVpServer = class(TSQLRestServerDB)
|
||||
protected
|
||||
fRootFolder: TFileName;
|
||||
public
|
||||
constructor Create(const aRootFolder: TFileName; const aRootURI: RawUTF8); reintroduce;
|
||||
destructor Destroy; override;
|
||||
property RootFolder: TFileName read fRootFolder;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$ifdef USEWRAPPERS}
|
||||
mORMotWrappers, // <= allow cross-platform client wrappers
|
||||
SynMustache,
|
||||
{$ifdef Windows}
|
||||
Windows, // needed for RT_RCDATA
|
||||
{$endif}
|
||||
{$endif}
|
||||
SynSQLite3;
|
||||
|
||||
{ TVpServer }
|
||||
|
||||
constructor TVpServer.Create(const aRootFolder: TFileName;
|
||||
const aRootURI: RawUTF8);
|
||||
{$ifdef USEWRAPPERS}
|
||||
procedure SaveWrappersFromResource(filename,resourcename:string);
|
||||
var
|
||||
fs:Tfilestream;
|
||||
begin
|
||||
if (NOT FileExists(filename)) then
|
||||
with TResourceStream.Create(hInstance, resourcename, RT_RCDATA) do
|
||||
try
|
||||
try
|
||||
fs:=Tfilestream.Create(Filename,fmCreate);
|
||||
Savetostream(fs);
|
||||
finally
|
||||
fs.Free;
|
||||
end;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
var
|
||||
aDirName:string;
|
||||
{$endif}
|
||||
begin
|
||||
fRootFolder := EnsureDirectoryExists(ExpandFileName(aRootFolder),true);
|
||||
|
||||
// define the log level
|
||||
with TSQLLog.Family do begin
|
||||
Level := LOG_VERBOSE; // LOG_STACKTRACE;
|
||||
DestinationPath := fRootFolder+'..\log\';
|
||||
if not FileExists(DestinationPath) then
|
||||
CreateDir(DestinationPath);
|
||||
PerThreadLog := ptIdentifiedInOnFile;
|
||||
end;
|
||||
|
||||
|
||||
// prepare the simple server for in-memory storage
|
||||
// for TSQLRestServerFullMemory
|
||||
//inherited Create(DataModel(aRootURI),fRootFolder+'data.json',false,false);
|
||||
//UpdateToFile;
|
||||
|
||||
|
||||
|
||||
// prepare the SQLite3 server with authentication
|
||||
// for TSQLRestServerDB
|
||||
inherited Create(DataModel,fRootFolder+'data.db3',True);
|
||||
|
||||
// make it fast !!
|
||||
DB.Synchronous := smOff;
|
||||
DB.LockingMode := lmExclusive;
|
||||
|
||||
// create the tables
|
||||
CreateMissingTables;
|
||||
|
||||
// create indexes
|
||||
CreateSQLIndex(TSQLVpResource, ['ResourceID'], False);
|
||||
CreateSQLIndex(TSQLVpEvent, ['RecordID'], False);
|
||||
CreateSQLIndex(TSQLVpContact, ['RecordID'], False);
|
||||
CreateSQLIndex(TSQLVpTask, ['RecordID'], False);
|
||||
|
||||
TSQLVpResource.AddFilterNotVoidText(['Description']);
|
||||
TSQLVpEvent.AddFilterNotVoidText(['Description','ResourceID']);
|
||||
TSQLVpContact.AddFilterNotVoidText(['FirstName','LastName','ResourceID']);
|
||||
TSQLVpTask.AddFilterNotVoidText(['Description','ResourceID']);
|
||||
|
||||
{
|
||||
Cache.SetCache(TSQLVpResource);
|
||||
Cache.SetCache(TSQLVpEvent);
|
||||
Cache.SetTimeOut(TSQLVpResource,60000);
|
||||
Cache.SetTimeOut(TSQLVpEvent,60000);
|
||||
}
|
||||
|
||||
{$ifdef USEWRAPPERS}
|
||||
|
||||
if Self.InheritsFrom(TSQLRestServer) then
|
||||
begin
|
||||
aDirName := fRootFolder+DirectorySeparator+'templates';
|
||||
if not FileExists(aDirName) then CreateDir(aDirName);
|
||||
SaveWrappersFromResource(aDirName+DirectorySeparator+'API.adoc.mustache','API.ADOC');
|
||||
SaveWrappersFromResource(aDirName+DirectorySeparator+'CrossPlatform.pas.mustache','CROSSPLATFORM.PAS');
|
||||
SaveWrappersFromResource(aDirName+DirectorySeparator+'Delphi.pas.mustache','DELPHI.PAS');
|
||||
SaveWrappersFromResource(aDirName+DirectorySeparator+'FPC-mORMotInterfaces.pas.mustache','FPC-MORMOTINTERFACES.PAS');
|
||||
SaveWrappersFromResource(aDirName+DirectorySeparator+'FPCServer-mORMotServer.pas.mustache','FPCSERVER-MORMOTSERVER.PAS');
|
||||
SaveWrappersFromResource(aDirName+DirectorySeparator+'SmartMobileStudio.pas.mustache','SMARTMOBILESTUDIO.PAS');
|
||||
AddToServerWrapperMethod(Self,[aDirName]);
|
||||
TSQLLog.Add.Log(sllInfo,'Wrapper in: '+aDirName);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
end;
|
||||
|
||||
destructor TVpServer.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
fModel.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
89
components/tvplanit/examples/mormot/VpRESTserver.lpi
Normal file
89
components/tvplanit/examples/mormot/VpRESTserver.lpi
Normal file
@ -0,0 +1,89 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="VpRESTserver"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
<Resources Count="6">
|
||||
<Resource_0 FileName="mORMotSourceHere\CrossPlatform\templates\API.adoc.mustache" Type="RCDATA" ResourceName="API.ADOC"/>
|
||||
<Resource_1 FileName="mORMotSourceHere\CrossPlatform\templates\CrossPlatform.pas.mustache" Type="RCDATA" ResourceName="CROSSPLATFORM.PAS"/>
|
||||
<Resource_2 FileName="mORMotSourceHere\CrossPlatform\templates\Delphi.pas.mustache" Type="RCDATA" ResourceName="DELPHI.PAS"/>
|
||||
<Resource_3 FileName="mORMotSourceHere\CrossPlatform\templates\FPC-mORMotInterfaces.pas.mustache" Type="RCDATA" ResourceName="FPC-MORMOTINTERFACES.PAS"/>
|
||||
<Resource_4 FileName="mORMotSourceHere\CrossPlatform\templates\FPCServer-mORMotServer.pas.mustache" Type="RCDATA" ResourceName="FPCSERVER-MORMOTSERVER.PAS"/>
|
||||
<Resource_5 FileName="mORMotSourceHere\CrossPlatform\templates\SmartMobileStudio.pas.mustache" Type="RCDATA" ResourceName="SMARTMOBILESTUDIO.PAS"/>
|
||||
</Resources>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="2">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
<Item2 Name="LinuxARM">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="VpRESTserver"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);mORMotSourceHere"/>
|
||||
<OtherUnitFiles Value="mORMotSourceHere;mORMotSourceHere\SQLite3"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<TargetCPU Value="arm"/>
|
||||
<TargetOS Value="linux"/>
|
||||
</CodeGeneration>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="VpRESTserver.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="VpRESTserver"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);mORMotSourceHere"/>
|
||||
<OtherUnitFiles Value="mORMotSourceHere;mORMotSourceHere\SQLite3"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
46
components/tvplanit/examples/mormot/VpRESTserver.lpr
Normal file
46
components/tvplanit/examples/mormot/VpRESTserver.lpr
Normal file
@ -0,0 +1,46 @@
|
||||
/// RESTful ORM server
|
||||
program VpRESTserver;
|
||||
|
||||
{$ifndef FPC}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$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}
|
||||
Classes,
|
||||
SysUtils,
|
||||
SynCommons,
|
||||
SynLog,
|
||||
mORMot,
|
||||
SynCrtSock,
|
||||
mORMotHTTPServer,
|
||||
RESTData,
|
||||
RESTServerClass;
|
||||
|
||||
var ORMServer: TVpServer;
|
||||
HTTPServer: TSQLHttpServer;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
ORMServer := TVpServer.Create(ExeVersion.ProgramFilePath+'data','root');
|
||||
try
|
||||
TSQLLog.Family.EchoToConsole := LOG_VERBOSE;
|
||||
HTTPServer := TSQLHttpServer.Create(HTTP_PORT,ORMServer{$ifndef ONLYUSEHTTPSOCKET},'+',useHttpApiRegisteringURI{$endif});
|
||||
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'Press [Enter] to close the server.');
|
||||
readln;
|
||||
finally
|
||||
HTTPServer.Free;
|
||||
end;
|
||||
finally
|
||||
ORMServer.Free;
|
||||
end;
|
||||
end.
|
||||
|
||||
101
components/tvplanit/examples/mormot/simpledemo/VpClient.lpi
Normal file
101
components/tvplanit/examples/mormot/simpledemo/VpClient.lpi
Normal file
@ -0,0 +1,101 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="VpClient"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
<SharedMatrixOptions Count="1">
|
||||
<Item1 ID="251604278977" Modes="Default" Value="-gw2"/>
|
||||
</SharedMatrixOptions>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="VpClient.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="VpClient"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);..\..\..\source;..\mORMotSourceHere"/>
|
||||
<OtherUnitFiles Value="..\..\..\source;..;..\mORMotSourceHere;..\mORMotSourceHere\SQLite3"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<IOChecks Value="True"/>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
<Optimizations>
|
||||
<OptimizationLevel Value="0"/>
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
20
components/tvplanit/examples/mormot/simpledemo/VpClient.lpr
Normal file
20
components/tvplanit/examples/mormot/simpledemo/VpClient.lpr
Normal file
@ -0,0 +1,20 @@
|
||||
program VpClient;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
62
components/tvplanit/examples/mormot/simpledemo/unit1.lfm
Normal file
62
components/tvplanit/examples/mormot/simpledemo/unit1.lfm
Normal file
@ -0,0 +1,62 @@
|
||||
object Form1: TForm1
|
||||
Left = 262
|
||||
Height = 441
|
||||
Top = 155
|
||||
Width = 934
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 441
|
||||
ClientWidth = 934
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '1.7'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 42
|
||||
Top = 0
|
||||
Width = 934
|
||||
Align = alTop
|
||||
TabOrder = 0
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Left = 784
|
||||
Height = 399
|
||||
Top = 42
|
||||
Width = 150
|
||||
Align = alRight
|
||||
Caption = 'Panel2'
|
||||
ClientHeight = 399
|
||||
ClientWidth = 150
|
||||
TabOrder = 1
|
||||
object Memo1: TMemo
|
||||
Left = 8
|
||||
Height = 353
|
||||
Top = 32
|
||||
Width = 133
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 8
|
||||
Width = 51
|
||||
Caption = 'LOGGING'
|
||||
ParentColor = False
|
||||
end
|
||||
object Button1: TButton
|
||||
Left = 80
|
||||
Height = 21
|
||||
Top = 6
|
||||
Width = 57
|
||||
Caption = 'Button1'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object Timer1: TTimer
|
||||
Enabled = False
|
||||
Interval = 250
|
||||
OnTimer = Timer1Timer
|
||||
left = 90
|
||||
top = 5
|
||||
end
|
||||
end
|
||||
133
components/tvplanit/examples/mormot/simpledemo/unit1.pas
Normal file
133
components/tvplanit/examples/mormot/simpledemo/unit1.pas
Normal file
@ -0,0 +1,133 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls, VpBaseDS,
|
||||
//VpBufDS,
|
||||
VpmORMotDS,
|
||||
VpDayView, VpWeekView, VpMonthView;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
Label1: TLabel;
|
||||
Memo1: TMemo;
|
||||
Panel1: TPanel;
|
||||
Panel2: TPanel;
|
||||
Timer1: TTimer;
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure Timer1Timer(Sender: TObject);
|
||||
private
|
||||
TerminateTimer:boolean;
|
||||
Datastore: TVpmORMotDatastore;
|
||||
//Datastore: TVpBufDSDatastore;
|
||||
ControlLink: TVpControlLink;
|
||||
WeekView: TVpWeekView;
|
||||
DayView: TVpDayView;
|
||||
MonthView: TVpMonthView;
|
||||
combo: TVpResourceCombo;
|
||||
public
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
TerminateTimer:=false;
|
||||
|
||||
ControlLink := TVpControlLink.Create(self);
|
||||
|
||||
Datastore := TVpmORMotDatastore.Create(self);
|
||||
// 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
|
||||
//DataStore.HostIP:='localhost';
|
||||
|
||||
Datastore.Directory:='data';
|
||||
Datastore.Connected := true;
|
||||
|
||||
if (Length(Datastore.HostIP)>0) AND (NOT Datastore.Connected) then
|
||||
begin
|
||||
MessageDlg('Cannot connect with server', mtError, [mbOk], 0);
|
||||
Close;
|
||||
end;
|
||||
|
||||
|
||||
//Datastore := TVpBufDSDatastore.Create(self);
|
||||
//Datastore.Directory := '.';
|
||||
//Datastore.AutoCreate := true;
|
||||
//Datastore.Connected := true;
|
||||
|
||||
DayView := TVpDayview.Create(self);
|
||||
DayView.Parent := self;
|
||||
DayView.Align := alLeft;
|
||||
DayView.ControlLink := ControlLink;
|
||||
DayView.Datastore := Datastore;
|
||||
DayView.AllowDragAndDrop:=True;
|
||||
|
||||
WeekView := TVpWeekView.Create(self);
|
||||
WeekView.Parent := self;
|
||||
Weekview.Align := alClient;
|
||||
WeekView.ControlLink := ControlLink;
|
||||
WeekView.Datastore := Datastore;
|
||||
|
||||
MonthView := TVpMonthView.Create(self);
|
||||
MonthView.Parent := self;
|
||||
MonthView.Align := alRight;
|
||||
MonthView.ControlLink := ControlLink;
|
||||
MonthView.Datastore := Datastore;
|
||||
|
||||
Combo := TVpResourceCombo.Create(Self);
|
||||
Combo.Parent := Panel1;
|
||||
Combo.Left := 8;
|
||||
Combo.Top := 8;
|
||||
Combo.Width := 200;
|
||||
Combo.Datastore := Datastore;
|
||||
|
||||
if Datastore.Resources.Count > 0 then
|
||||
Datastore.ResourceID := Datastore.Resources.Items[0].ResourceID;
|
||||
|
||||
Timer1.Enabled:=True;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
begin
|
||||
{
|
||||
with DataStore.GetEventsTable do
|
||||
begin
|
||||
Memo1.Lines.Append(InttoStr(RecordCount));
|
||||
if BOF then Memo1.Lines.Append('BOF');
|
||||
if EOF then Memo1.Lines.Append('EOF');
|
||||
Refresh;
|
||||
if BOF then Memo1.Lines.Append('BOF');
|
||||
if EOF then Memo1.Lines.Append('EOF');
|
||||
Resync([]);
|
||||
if BOF then Memo1.Lines.Append('BOF');
|
||||
if EOF then Memo1.Lines.Append('EOF');
|
||||
end;
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TForm1.Timer1Timer(Sender: TObject);
|
||||
begin
|
||||
Timer1.Enabled:=False;
|
||||
Datastore.CheckUpdate;
|
||||
Timer1.Enabled:=True;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
994
components/tvplanit/examples/mormot/vpmormotds.pas
Normal file
994
components/tvplanit/examples/mormot/vpmormotds.pas
Normal file
@ -0,0 +1,994 @@
|
||||
{*********************************************************}
|
||||
{* VPMORMOTDS.PAS 1.00 *}
|
||||
{*********************************************************}
|
||||
|
||||
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||
{* Version: MPL 1.1 *}
|
||||
{* *}
|
||||
{* The contents of this file are subject to the Mozilla Public License *}
|
||||
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||
{* compliance with the License. You may obtain a copy of the License at *}
|
||||
{* http://www.mozilla.org/MPL/ *}
|
||||
{* *}
|
||||
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||
{* for the specific language governing rights and limitations under the *}
|
||||
{* License. *}
|
||||
{* *}
|
||||
{* The Original Code is TurboPower Visual PlanIt *}
|
||||
{* *}
|
||||
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||
{* *}
|
||||
{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *}
|
||||
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||
{* *}
|
||||
{* Contributor(s): *}
|
||||
{* *}
|
||||
{* ***** END LICENSE BLOCK ***** *}
|
||||
|
||||
{$I Vp.INC}
|
||||
|
||||
unit VpmORMotDS;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Dialogs, SysUtils, Db,
|
||||
VpData, VpBaseDS, VpDBDS,
|
||||
mORMotVCL,
|
||||
SynCommons,
|
||||
mORMot,mORMotSQLite3,
|
||||
SynSQLite3Static,mORMotHttpClient
|
||||
;
|
||||
|
||||
type
|
||||
TSynSQLTableDataSetWithLocate = class(TSynSQLTableDataSet)
|
||||
public
|
||||
procedure Delete; override;
|
||||
end;
|
||||
|
||||
|
||||
type
|
||||
TVpmORMotDataStore = class(TVpCustomDBDataStore)
|
||||
protected
|
||||
|
||||
FResourceTable : TSynSQLTableDataSetWithLocate;
|
||||
FEventsTable : TSynSQLTableDataSetWithLocate;
|
||||
FContactsTable : TSynSQLTableDataSetWithLocate;
|
||||
FTasksTable : TSynSQLTableDataSetWithLocate;
|
||||
|
||||
FDatabase : TSQLRest;
|
||||
FModel : TSQLModel;
|
||||
FHostIP : string;
|
||||
FDirectory : string;
|
||||
|
||||
aSQLResourceTable : TSQLTable;
|
||||
aSQLEventTable : TSQLTable;
|
||||
aSQLContactTable : TSQLTable;
|
||||
aSQLTaskTable : TSQLTable;
|
||||
|
||||
procedure RefreshTable(aTable:TDataset);
|
||||
|
||||
{ property getters }
|
||||
function GetContactsTable: TDataset; override;
|
||||
function GetEventsTable: TDataset; override;
|
||||
function GetResourceTable: TDataset; override;
|
||||
function GetTasksTable: TDataset; override;
|
||||
function CheckServer: boolean;
|
||||
|
||||
{ property setters }
|
||||
procedure SetConnected(const Value: boolean); override;
|
||||
procedure SetHostIP(const Value: string);
|
||||
procedure SetDirectory(const Value: string);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
function GetNextID(TableName: string): Integer; override;
|
||||
|
||||
procedure PostResources; override;
|
||||
procedure PostEvents; override;
|
||||
procedure PostContacts; override;
|
||||
procedure PostTasks; override;
|
||||
|
||||
procedure RefreshEvents; override;
|
||||
procedure RefreshContacts; override;
|
||||
procedure RefreshTasks; override;
|
||||
procedure RefreshResource; override;
|
||||
|
||||
procedure PurgeResource(Res: TVpResource); override;
|
||||
procedure PurgeEvents(Res: TVpResource); override;
|
||||
procedure PurgeContacts(Res: TVpResource); override;
|
||||
procedure PurgeTasks(Res: TVpResource); override;
|
||||
|
||||
property HostIP: string read FHostIP write SetHostIP;
|
||||
property Directory: string read FDirectory write SetDirectory;
|
||||
|
||||
property CheckUpdate:boolean read CheckServer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
VpMisc,
|
||||
VpException,
|
||||
{$ifdef WITHRTTI}
|
||||
TypInfo,
|
||||
{$endif}
|
||||
Variants,
|
||||
SynSQLite3,
|
||||
RESTdata;
|
||||
|
||||
{$ifdef WITHRTTI}
|
||||
procedure GetFieldValuesByRTTI(aVpTable:TObject;aRecord:TSQLRecord);
|
||||
const
|
||||
TypeKinds: TTypeKinds =
|
||||
[
|
||||
tkInteger,tkEnumeration,tkFloat,
|
||||
tkSet,tkSString,tkLString,tkAString,
|
||||
tkWString,tkBool,tkInt64,tkQWord,tkUString
|
||||
];
|
||||
var
|
||||
K,L: Integer;
|
||||
PropList: PPropList;
|
||||
PropInfo: PPropInfo;
|
||||
aFloat:Double;
|
||||
PropName:string;
|
||||
begin
|
||||
K := GetPropList(aVpTable.ClassInfo, TypeKinds, nil);
|
||||
GetMem(PropList, K * SizeOf(PPropInfo));
|
||||
try
|
||||
GetPropList(aVpTable.ClassInfo, TypeKinds, PropList);
|
||||
for L := 0 to K - 1 do
|
||||
begin
|
||||
PropInfo := PropList^[L];
|
||||
PropName:=PropInfo^.Name;
|
||||
if PropName='ResourceID' then continue;
|
||||
if Assigned(PropInfo^.GetProc) then
|
||||
begin
|
||||
case PropInfo^.PropType^.Kind of
|
||||
tkString, tkLString, tkUString, tkWString{$ifdef FPC},tkAString{$endif}:
|
||||
aRecord.SetFieldVariant(PropInfo^.Name, TypInfo.GetStrProp(aVpTable, PropName));
|
||||
tkInt64{$ifdef FPC}, tkQWord{$endif}:
|
||||
aRecord.SetFieldVariant(PropInfo^.Name, TypInfo.GetInt64Prop(aVpTable, PropName));
|
||||
tkEnumeration, tkSet, tkInteger{$ifdef FPC},tkBool{$endif} :
|
||||
aRecord.SetFieldVariant(PropInfo^.Name, TypInfo.GetOrdProp(aVpTable, PropName));
|
||||
tkFloat:begin
|
||||
if PropInfo^.PropType = TypeInfo(TDateTime) then
|
||||
begin
|
||||
aFloat:=TypInfo.GetFloatProp(aVpTable, PropName);
|
||||
aRecord.SetFieldVariant(PropInfo^.Name, TDateTime(aFloat));
|
||||
end else aRecord.SetFieldVariant(PropInfo^.Name, TypInfo.GetFloatProp(aVpTable, PropName));
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
FreeMem(PropList);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure TSynSQLTableDataSetWithLocate.Delete;
|
||||
begin
|
||||
CheckActive;
|
||||
if IsEmpty then exit;
|
||||
if State in [dsInsert] then
|
||||
begin
|
||||
Cancel;
|
||||
end else begin
|
||||
DataEvent(deCheckBrowseMode,0);
|
||||
DoBeforeDelete;
|
||||
DoBeforeScroll;
|
||||
Table.DeleteRow(RecNo);
|
||||
SetState(dsBrowse);
|
||||
Resync([]);
|
||||
DoAfterDelete;
|
||||
DoAfterScroll;
|
||||
end;
|
||||
end;
|
||||
|
||||
(*****************************************************************************)
|
||||
{ TVpmORMotDataStore }
|
||||
|
||||
constructor TVpmORMotDataStore.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FHostIP := '';
|
||||
FModel := DataModel;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
function TVpmORMotDataStore.GetNextID(TableName: string): Integer;
|
||||
begin
|
||||
Unused(TableName);
|
||||
Result := -1
|
||||
end;
|
||||
{=====}
|
||||
|
||||
destructor TVpmORMotDataStore.Destroy;
|
||||
begin
|
||||
{ free tables }
|
||||
FreeAndNil(FResourceTable);
|
||||
FreeAndNil(FEventsTable);
|
||||
FreeAndNil(FContactsTable);
|
||||
FreeAndNil(FTasksTable);
|
||||
{ free database }
|
||||
FreeAndNil(FDatabase);
|
||||
FreeAndNil(FModel);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.PostResources;
|
||||
var
|
||||
I: Integer;
|
||||
Res: TVpResource;
|
||||
aResourceTable: TSQLRecordClass;
|
||||
aRecord: TSQLRecord;
|
||||
aNewID:TID;
|
||||
begin
|
||||
|
||||
Loading := true;
|
||||
|
||||
try
|
||||
|
||||
if (Resources.Count > 0) then
|
||||
begin
|
||||
|
||||
aResourceTable := aSQLResourceTable.QueryRecordType;
|
||||
|
||||
if not ResourceTable.Active then
|
||||
ResourceTable.Open;
|
||||
ResourceTable.First;
|
||||
|
||||
for I := pred(Resources.Count) downto 0 do
|
||||
begin
|
||||
Res := Resources.Items[I];
|
||||
|
||||
if Res = nil then Continue;
|
||||
|
||||
|
||||
if Res.Deleted then
|
||||
begin
|
||||
PurgeEvents(Res);
|
||||
PurgeContacts(Res);
|
||||
PurgeTasks(Res);
|
||||
if (aResourceTable<>nil) then
|
||||
begin
|
||||
// delete record from database
|
||||
if FDatabase.Delete(aResourceTable,Res.ResourceID) then
|
||||
begin
|
||||
// delete record from dataset
|
||||
if ResourceTable.Locate('ResourceID', Res.ResourceID, [])
|
||||
then ResourceTable.Delete;
|
||||
end;
|
||||
end;
|
||||
if Resource = Res then
|
||||
ResourceID := -1;
|
||||
Res.Free;
|
||||
Continue;
|
||||
end
|
||||
|
||||
else if Res.Changed then
|
||||
begin
|
||||
|
||||
aRecord := aResourceTable.Create(FDatabase,Res.ResourceID,true);
|
||||
try
|
||||
|
||||
{$ifdef WITHRTTI}
|
||||
|
||||
GetFieldValuesByRTTI(Res,aRecord);
|
||||
|
||||
{$else}
|
||||
|
||||
aRecord.SetFieldVariant('Description', Res.Description);
|
||||
aRecord.SetFieldVariant('Notes', Res.Notes);
|
||||
aRecord.SetFieldVariant('ResourceActive', Res.ResourceActive);
|
||||
aRecord.SetFieldVariant('UserField0', Res.UserField0);
|
||||
aRecord.SetFieldVariant('UserField1', Res.UserField1);
|
||||
aRecord.SetFieldVariant('UserField2', Res.UserField2);
|
||||
aRecord.SetFieldVariant('UserField3', Res.UserField3);
|
||||
aRecord.SetFieldVariant('UserField4', Res.UserField4);
|
||||
aRecord.SetFieldVariant('UserField5', Res.UserField5);
|
||||
aRecord.SetFieldVariant('UserField6', Res.UserField6);
|
||||
aRecord.SetFieldVariant('UserField7', Res.UserField7);
|
||||
aRecord.SetFieldVariant('UserField8', Res.UserField8);
|
||||
aRecord.SetFieldVariant('UserField9', Res.UserField9);
|
||||
|
||||
{$endif}
|
||||
|
||||
aNewID:=FDatabase.AddOrUpdate(aRecord);
|
||||
|
||||
// do we have a new resource ?
|
||||
if Res.ResourceID<>aNewID then
|
||||
begin
|
||||
Res.ResourceID:=aNewID;
|
||||
aRecord.SetFieldVariant('ResourceID', aNewID);
|
||||
FDatabase.Update(aRecord,'ResourceID',true);
|
||||
end;
|
||||
|
||||
FDatabase.UnLock(aRecord);
|
||||
|
||||
if Res.ResourceID=0 then
|
||||
begin
|
||||
// we have a mORMot error !!
|
||||
raise EDBPostError.Create;
|
||||
end;
|
||||
|
||||
finally
|
||||
aRecord.Free;
|
||||
end;
|
||||
|
||||
RefreshTable(FResourceTable);
|
||||
if (Res.ResourceID = ResourceID) then
|
||||
begin
|
||||
PostEvents;
|
||||
PostContacts;
|
||||
PostTasks;
|
||||
end;
|
||||
|
||||
Res.Changed := false;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
if not Loading then
|
||||
NotifyDependents;
|
||||
|
||||
if Assigned(AfterPostEvents) then
|
||||
FAfterPostEvents(self);
|
||||
|
||||
end;
|
||||
|
||||
finally
|
||||
Loading := false;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
|
||||
procedure TVpmORMotDataStore.PostEvents;
|
||||
var
|
||||
J: Integer;
|
||||
Event: TVpEvent;
|
||||
aEventTable: TSQLRecordClass;
|
||||
aRecord: TSQLRecord;
|
||||
aNewID:TID;
|
||||
begin
|
||||
if (Resource <> nil) and Resource.EventsDirty then
|
||||
begin
|
||||
if ResourceTable.Locate('ResourceID', Resource.ResourceID, []) then
|
||||
begin
|
||||
|
||||
aEventTable := aSQLEventTable.QueryRecordType;
|
||||
|
||||
for J := pred(Resource.Schedule.EventCount) downto 0 do
|
||||
begin
|
||||
|
||||
Event := Resource.Schedule.GetEvent(J);
|
||||
|
||||
{ if the delete flag is set then delete it from the database }
|
||||
{ and free the event instance }
|
||||
if Event.Deleted then
|
||||
begin
|
||||
if (aEventTable<>nil) then
|
||||
begin
|
||||
// delete record from database
|
||||
if FDatabase.Delete(aEventTable,Event.RecordID) then
|
||||
begin
|
||||
// delete record from dataset
|
||||
if EventsTable.Locate('RecordID', Event.RecordID, [])
|
||||
then EventsTable.Delete;
|
||||
end;
|
||||
end;
|
||||
Event.Free;
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if Event.Changed then
|
||||
begin
|
||||
|
||||
aRecord:=aEventTable.Create(FDatabase, Event.RecordID, true);
|
||||
try
|
||||
|
||||
{$ifdef WITHRTTI}
|
||||
|
||||
GetFieldValuesByRTTI(Event,aRecord);
|
||||
|
||||
{$else}
|
||||
|
||||
aRecord.SetFieldVariant('StartTime', Event.StartTime);
|
||||
aRecord.SetFieldVariant('EndTime', Event.EndTime);
|
||||
aRecord.SetFieldVariant('Description', Event.Description);
|
||||
aRecord.SetFieldVariant('Location', Event.Location);
|
||||
aRecord.SetFieldVariant('Notes', Event.Notes);
|
||||
aRecord.SetFieldVariant('Category', Event.Category);
|
||||
aRecord.SetFieldVariant('DingPath', Event.DingPath);
|
||||
aRecord.SetFieldVariant('AllDayEvent', Event.AllDayEvent);
|
||||
aRecord.SetFieldVariant('AlarmSet', Event.AlarmSet);
|
||||
aRecord.SetFieldVariant('AlarmAdvance', Event.AlarmAdvance);
|
||||
aRecord.SetFieldVariant('AlarmAdvanceType', Ord(Event.AlarmAdvanceType));
|
||||
aRecord.SetFieldVariant('SnoozeTime', Event.SnoozeTime);
|
||||
aRecord.SetFieldVariant('RepeatCode', Ord(Event.RepeatCode));
|
||||
aRecord.SetFieldVariant('RepeatRangeEnd', Event.RepeatRangeEnd);
|
||||
aRecord.SetFieldVariant('CustomInterval', Event.CustomInterval);
|
||||
aRecord.SetFieldVariant('UserField0', Event.UserField0);
|
||||
aRecord.SetFieldVariant('UserField1', Event.UserField1);
|
||||
aRecord.SetFieldVariant('UserField2', Event.UserField2);
|
||||
aRecord.SetFieldVariant('UserField3', Event.UserField3);
|
||||
aRecord.SetFieldVariant('UserField4', Event.UserField4);
|
||||
aRecord.SetFieldVariant('UserField5', Event.UserField5);
|
||||
aRecord.SetFieldVariant('UserField6', Event.UserField6);
|
||||
aRecord.SetFieldVariant('UserField7', Event.UserField7);
|
||||
aRecord.SetFieldVariant('UserField8', Event.UserField8);
|
||||
aRecord.SetFieldVariant('UserField9', Event.UserField9);
|
||||
|
||||
{$endif}
|
||||
|
||||
aRecord.SetFieldVariant('ResourceID', Resource.ResourceID);
|
||||
|
||||
aNewID:=FDatabase.AddOrUpdate(aRecord);
|
||||
|
||||
// do we have a new event ?
|
||||
if Event.RecordID<>aNewID then
|
||||
begin
|
||||
Event.RecordID:=aNewID;
|
||||
aRecord.SetFieldVariant('RecordID', aNewID);
|
||||
FDatabase.Update(aRecord,'RecordID',true);
|
||||
end;
|
||||
|
||||
FDatabase.UnLock(aRecord);
|
||||
|
||||
if Event.RecordID=0 then
|
||||
begin
|
||||
// we have a mORMot error !!
|
||||
raise EDBPostError.Create;
|
||||
end;
|
||||
|
||||
finally
|
||||
aRecord.Free;
|
||||
end;
|
||||
|
||||
RefreshTable(FEventsTable);
|
||||
|
||||
Event.Changed := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
Resource.EventsDirty := false;
|
||||
Resource.Schedule.Sort;
|
||||
|
||||
if not Loading then
|
||||
NotifyDependents;
|
||||
|
||||
if Assigned(AfterPostEvents) then
|
||||
FAfterPostEvents(self);
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.PostContacts;
|
||||
var
|
||||
J: Integer;
|
||||
Contact: TVpContact;
|
||||
aContactTable: TSQLRecordClass;
|
||||
aRecord: TSQLRecord;
|
||||
aNewID:TID;
|
||||
begin
|
||||
if (Resource <> nil) and Resource.ContactsDirty then
|
||||
begin
|
||||
if ResourceTable.Locate('ResourceID', Resource.ResourceID, []) then
|
||||
begin
|
||||
|
||||
aContactTable := aSQLContactTable.QueryRecordType;
|
||||
|
||||
for J := pred(Resource.Contacts.Count) downto 0 do
|
||||
begin
|
||||
Contact := Resource.Contacts.GetContact(J);
|
||||
|
||||
{ if the delete flag is set then delete it from the database }
|
||||
{ and free the Contact instance }
|
||||
if Contact.Deleted then
|
||||
begin
|
||||
if (aContactTable<>nil) then
|
||||
begin
|
||||
// delete record from database
|
||||
if FDatabase.Delete(aContactTable,Contact.RecordID) then
|
||||
begin
|
||||
// delete record from dataset
|
||||
if ContactsTable.Locate('RecordID', Contact.RecordID, [])
|
||||
then ContactsTable.Delete;
|
||||
end;
|
||||
end;
|
||||
Contact.Free;
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if Contact.Changed then
|
||||
begin
|
||||
|
||||
aRecord:=aContactTable.Create(FDatabase, Contact.RecordID, true);
|
||||
try
|
||||
|
||||
{$ifdef WITHRTTI}
|
||||
|
||||
GetFieldValuesByRTTI(Contact,aRecord);
|
||||
|
||||
{$else}
|
||||
|
||||
aRecord.SetFieldVariant('Job_Position',Contact.Job_Position);
|
||||
aRecord.SetFieldVariant('FirstName',Contact.FirstName);
|
||||
aRecord.SetFieldVariant('LastName',Contact.LastName);
|
||||
aRecord.SetFieldVariant('BirthDate',Contact.BirthDate);
|
||||
aRecord.SetFieldVariant('Anniversary',Contact.Anniversary);
|
||||
aRecord.SetFieldVariant('Title',Contact.Title);
|
||||
aRecord.SetFieldVariant('Company',Contact.Company);
|
||||
aRecord.SetFieldVariant('EMail',Contact.EMail);
|
||||
aRecord.SetFieldVariant('Phone1',Contact.Phone1);
|
||||
aRecord.SetFieldVariant('Phone2',Contact.Phone2);
|
||||
aRecord.SetFieldVariant('Phone3',Contact.Phone3);
|
||||
aRecord.SetFieldVariant('Phone4',Contact.Phone4);
|
||||
aRecord.SetFieldVariant('Phone5',Contact.Phone5);
|
||||
aRecord.SetFieldVariant('PhoneType1',Contact.PhoneType1);
|
||||
aRecord.SetFieldVariant('PhoneType2',Contact.PhoneType2);
|
||||
aRecord.SetFieldVariant('PhoneType3',Contact.PhoneType3);
|
||||
aRecord.SetFieldVariant('PhoneType4',Contact.PhoneType4);
|
||||
aRecord.SetFieldVariant('PhoneType5',Contact.PhoneType5);
|
||||
aRecord.SetFieldVariant('Address',Contact.Address);
|
||||
aRecord.SetFieldVariant('City',Contact.City);
|
||||
aRecord.SetFieldVariant('State',Contact.State);
|
||||
aRecord.SetFieldVariant('Zip',Contact.Zip);
|
||||
aRecord.SetFieldVariant('Country',Contact.Country);
|
||||
aRecord.SetFieldVariant('Notes',Contact.Notes);
|
||||
aRecord.SetFieldVariant('Category',Contact.Category);
|
||||
aRecord.SetFieldVariant('Custom1',Contact.Custom1);
|
||||
aRecord.SetFieldVariant('Custom2',Contact.Custom2);
|
||||
aRecord.SetFieldVariant('Custom3',Contact.Custom3);
|
||||
aRecord.SetFieldVariant('Custom4',Contact.Custom4);
|
||||
aRecord.SetFieldVariant('UserField0', Contact.UserField0);
|
||||
aRecord.SetFieldVariant('UserField1', Contact.UserField1);
|
||||
aRecord.SetFieldVariant('UserField2', Contact.UserField2);
|
||||
aRecord.SetFieldVariant('UserField3', Contact.UserField3);
|
||||
aRecord.SetFieldVariant('UserField4', Contact.UserField4);
|
||||
aRecord.SetFieldVariant('UserField5', Contact.UserField5);
|
||||
aRecord.SetFieldVariant('UserField6', Contact.UserField6);
|
||||
aRecord.SetFieldVariant('UserField7', Contact.UserField7);
|
||||
aRecord.SetFieldVariant('UserField8', Contact.UserField8);
|
||||
aRecord.SetFieldVariant('UserField9', Contact.UserField9);
|
||||
|
||||
{$endif}
|
||||
|
||||
aRecord.SetFieldVariant('ResourceID', Resource.ResourceID);
|
||||
|
||||
aNewID:=FDatabase.AddOrUpdate(aRecord);
|
||||
|
||||
// do we have a new contact ?
|
||||
if Contact.RecordID<>aNewID then
|
||||
begin
|
||||
Contact.RecordID:=aNewID;
|
||||
aRecord.SetFieldVariant('RecordID', aNewID);
|
||||
FDatabase.Update(aRecord,'RecordID',true);
|
||||
end;
|
||||
|
||||
FDatabase.UnLock(aRecord);
|
||||
|
||||
if Contact.RecordID=0 then
|
||||
begin
|
||||
// we have a mORMot error !!
|
||||
raise EDBPostError.Create;
|
||||
end;
|
||||
|
||||
finally
|
||||
aRecord.Free;
|
||||
end;
|
||||
|
||||
RefreshTable(FContactsTable);
|
||||
|
||||
Contact.Changed := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
Resource.ContactsDirty := false;
|
||||
|
||||
if not Loading then
|
||||
NotifyDependents;
|
||||
|
||||
if Assigned(AfterPostContacts) then
|
||||
FAfterPostContacts(self);
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.PostTasks;
|
||||
var
|
||||
J: Integer;
|
||||
Task: TVpTask;
|
||||
aTaskTable: TSQLRecordClass;
|
||||
aRecord: TSQLRecord;
|
||||
aNewID:TID;
|
||||
begin
|
||||
if (Resource <> nil) and Resource.TasksDirty then
|
||||
begin
|
||||
if ResourceTable.Locate('ResourceID', Resource.ResourceID, []) then
|
||||
begin
|
||||
|
||||
aTaskTable := aSQLTaskTable.QueryRecordType;
|
||||
|
||||
for J := pred(Resource.Tasks.Count) downto 0 do
|
||||
begin
|
||||
Task := Resource.Tasks.GetTask(J);
|
||||
|
||||
{ if the delete flag is set then delete it from the database }
|
||||
{ and free the Task instance }
|
||||
if Task.Deleted then
|
||||
begin
|
||||
if (aTaskTable<>nil) then
|
||||
begin
|
||||
// delete record from database
|
||||
if FDatabase.Delete(aTaskTable,Task.RecordID) then
|
||||
begin
|
||||
// delete record from dataset
|
||||
if TasksTable.Locate('RecordID', Task.RecordID, [])
|
||||
then TasksTable.Delete;
|
||||
end;
|
||||
end;
|
||||
Task.Free;
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if Task.Changed then
|
||||
begin
|
||||
|
||||
aRecord:=aTaskTable.Create(FDatabase, Task.RecordID, true);
|
||||
try
|
||||
|
||||
{$ifdef WITHRTTI}
|
||||
|
||||
GetFieldValuesByRTTI(Task,aRecord);
|
||||
|
||||
{$else}
|
||||
|
||||
aRecord.SetFieldVariant('Description', Task.Description);
|
||||
aRecord.SetFieldVariant('Details', Task.Details);
|
||||
aRecord.SetFieldVariant('Complete', Task.Complete);
|
||||
aRecord.SetFieldVariant('DueDate', Task.DueDate);
|
||||
aRecord.SetFieldVariant('CreatedOn', Task.CreatedOn);
|
||||
aRecord.SetFieldVariant('CompletedOn', Task.CompletedOn);
|
||||
aRecord.SetFieldVariant('Priority', Task.Priority);
|
||||
aRecord.SetFieldVariant('Category', Task.Category);
|
||||
|
||||
aRecord.SetFieldVariant('UserField0', Task.UserField0);
|
||||
aRecord.SetFieldVariant('UserField1', Task.UserField1);
|
||||
aRecord.SetFieldVariant('UserField2', Task.UserField2);
|
||||
aRecord.SetFieldVariant('UserField3', Task.UserField3);
|
||||
aRecord.SetFieldVariant('UserField4', Task.UserField4);
|
||||
aRecord.SetFieldVariant('UserField5', Task.UserField5);
|
||||
aRecord.SetFieldVariant('UserField6', Task.UserField6);
|
||||
aRecord.SetFieldVariant('UserField7', Task.UserField7);
|
||||
aRecord.SetFieldVariant('UserField8', Task.UserField8);
|
||||
aRecord.SetFieldVariant('UserField9', Task.UserField9);
|
||||
|
||||
{$endif}
|
||||
|
||||
aRecord.SetFieldVariant('ResourceID', Resource.ResourceID);
|
||||
|
||||
aNewID:=FDatabase.AddOrUpdate(aRecord);
|
||||
|
||||
// do we have a new task ?
|
||||
if Task.RecordID<>aNewID then
|
||||
begin
|
||||
Task.RecordID:=aNewID;
|
||||
aRecord.SetFieldVariant('RecordID', aNewID);
|
||||
FDatabase.Update(aRecord,'RecordID',true);
|
||||
end;
|
||||
|
||||
FDatabase.UnLock(aRecord);
|
||||
|
||||
if Task.RecordID=0 then
|
||||
begin
|
||||
// we have a mORMot error !!
|
||||
raise EDBPostError.Create;
|
||||
end;
|
||||
|
||||
finally
|
||||
aRecord.Free;
|
||||
end;
|
||||
|
||||
RefreshTable(FTasksTable);
|
||||
|
||||
Task.Changed := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
Resource.TasksDirty := false;
|
||||
|
||||
if not Loading then
|
||||
NotifyDependents;
|
||||
|
||||
if Assigned(AfterPostTasks) then
|
||||
FAfterPostTasks(self);
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.PurgeResource(Res: TVpResource);
|
||||
begin
|
||||
RefreshTable(FResourceTable);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.PurgeEvents(Res: TVpResource);
|
||||
begin
|
||||
RefreshTable(FEventsTable);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.PurgeContacts(Res: TVpResource);
|
||||
begin
|
||||
RefreshTable(FContactsTable);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.PurgeTasks(Res: TVpResource);
|
||||
begin
|
||||
RefreshTable(FTasksTable);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.SetConnected(const Value: boolean);
|
||||
var
|
||||
aTable : TSQLRecordClass;
|
||||
aVpTable : TSynSQLTableDataSetWithLocate;
|
||||
aSQLTable : TSQLTable;
|
||||
aFieldType : TSQLFieldType;
|
||||
i,j : integer;
|
||||
aDBFile : string;
|
||||
begin
|
||||
|
||||
{ Don't do anything with live data until run time. }
|
||||
if (csDesigning in ComponentState) or (csLoading in ComponentState) then
|
||||
Exit;
|
||||
|
||||
inherited SetConnected(Value);
|
||||
|
||||
if (Value) then
|
||||
begin
|
||||
|
||||
aDBFile:=ChangeFileExt(paramstr(0),'.db3');
|
||||
|
||||
if (length(HostIP)=0) AND (Length(FDirectory)>0) then
|
||||
begin
|
||||
aDBFile := EnsureDirectoryExists(ExpandFileName(FDirectory),true)+ExtractFileName(aDBFile);
|
||||
end;
|
||||
|
||||
if Assigned(FDatabase) then FDatabase.Free;
|
||||
if length(HostIP)>0
|
||||
then FDatabase:=TSQLHttpClient.Create(FHostIP,HTTP_PORT,FModel)
|
||||
else FDatabase:=TSQLRestServerDB.Create(FModel,aDBFile,True);
|
||||
|
||||
if FDatabase.InheritsFrom(TSQLRestClient) then
|
||||
begin
|
||||
if NOT TSQLHttpClient(FDatabase).SetUser('User','synopse') then
|
||||
begin
|
||||
inherited SetConnected(False);
|
||||
FConnected:=False;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if FDatabase.InheritsFrom(TSQLRestServer) then
|
||||
begin
|
||||
TSQLRestServerDB(FDataBase).CreateMissingTables;
|
||||
end;
|
||||
|
||||
for j:=0 to 3 do
|
||||
begin
|
||||
|
||||
aTable:=nil;
|
||||
case j of
|
||||
0:aTable:=FModel.Table['VpResource'];
|
||||
1:aTable:=FModel.Table['VpEvent'];
|
||||
2:aTable:=FModel.Table['VpContact'];
|
||||
3:aTable:=FModel.Table['VpTask'];
|
||||
end;
|
||||
|
||||
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]);
|
||||
|
||||
// tricky ... force set field size
|
||||
for i := 0 to aSQLTable.FieldCount-1 do
|
||||
begin
|
||||
aFieldType:=aSQLTable.FieldType(i,nil);
|
||||
if aFieldType in [sftAnsiText,sftUTF8Text,sftUTF8Custom] then aSQLTable.SetFieldType(i,aFieldType,nil,100);
|
||||
if aSQLTable.FieldNames[i]='Notes' then aSQLTable.SetFieldType(i,aFieldType,nil,500);
|
||||
end;
|
||||
|
||||
case j of
|
||||
0:aSQLResourceTable:=aSQLTable;
|
||||
1:aSQLEventTable:=aSQLTable;
|
||||
2:aSQLContactTable:=aSQLTable;
|
||||
3:aSQLTaskTable:=aSQLTable;
|
||||
end;
|
||||
|
||||
// create simple readonly dataset
|
||||
aVpTable:=TSynSQLTableDataSetWithLocate.CreateOwnedTable(nil,aSQLTable);
|
||||
|
||||
case j of
|
||||
0:FResourceTable:=aVpTable;
|
||||
1:FEventsTable:=aVpTable;
|
||||
2:FContactsTable:=aVpTable;
|
||||
3:FTasksTable:=aVpTable;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
Load;
|
||||
|
||||
end else if Assigned(FDatabase) then FDatabase.Free;
|
||||
|
||||
end;
|
||||
|
||||
procedure TVpmORMotDataStore.SetHostIP(const Value: string);
|
||||
begin
|
||||
if FHostIP<>Value then
|
||||
begin
|
||||
FHostIP:=Value;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpmORMotDataStore.SetDirectory(const Value: string);
|
||||
begin
|
||||
if Value = FDirectory then
|
||||
exit;
|
||||
if Connected then
|
||||
raise Exception.Create('Set directory before connecting.');
|
||||
FDirectory := Value;
|
||||
end;
|
||||
|
||||
function TVpmORMotDataStore.CheckServer: boolean;
|
||||
var
|
||||
ref: boolean;
|
||||
begin
|
||||
|
||||
result:=false;
|
||||
|
||||
if FDatabase.InheritsFrom(TSQLRestClient) then
|
||||
begin
|
||||
|
||||
if Assigned(aSQLResourceTable) then
|
||||
begin
|
||||
if (TSQLRestClientURI(FDatabase).UpdateFromServer([aSQLResourceTable],ref) AND ref) then
|
||||
begin
|
||||
RefreshResource;
|
||||
result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Assigned(aSQLEventTable) then
|
||||
begin
|
||||
if (TSQLRestClientURI(FDatabase).UpdateFromServer([aSQLEventTable],ref) AND ref) then
|
||||
begin
|
||||
RefreshEvents;
|
||||
result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Assigned(aSQLContactTable) then
|
||||
begin
|
||||
if (TSQLRestClientURI(FDatabase).UpdateFromServer([aSQLContactTable],ref) AND ref) then
|
||||
begin
|
||||
RefreshContacts;
|
||||
result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Assigned(aSQLTaskTable) then
|
||||
begin
|
||||
if (TSQLRestClientURI(FDatabase).UpdateFromServer([aSQLTaskTable],ref) AND ref) then
|
||||
begin
|
||||
RefreshTasks;
|
||||
result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpmORMotDataStore.RefreshTable(aTable:TDataset);
|
||||
var
|
||||
aSQLTable:TSQLTable;
|
||||
aSQLRecordClass:TSQLRecordClass;
|
||||
begin
|
||||
|
||||
aSQLTable:=nil;
|
||||
|
||||
if aTable=ResourceTable then aSQLTable:=aSQLResourceTable;
|
||||
if aTable=EventsTable then aSQLTable:=aSQLEventTable;
|
||||
if aTable=ContactsTable then aSQLTable:=aSQLContactTable;
|
||||
if aTable=TasksTable then aSQLTable:=aSQLTaskTable;
|
||||
|
||||
aSQLRecordClass:=aSQLTable.QueryRecordType;
|
||||
|
||||
aSQLTable.Free;
|
||||
if aTable=ResourceTable
|
||||
then aSQLTable:=FDatabase.MultiFieldValues(aSQLRecordClass,'*','order by ID')
|
||||
else aSQLTable:=FDatabase.MultiFieldValues(aSQLRecordClass,'*','%=?',['ResourceID'],[ResourceID]);
|
||||
|
||||
TSynSQLTableDatasetWithLocate(aTable).Table:=aSQLTable;
|
||||
|
||||
aTable.Refresh;
|
||||
|
||||
end;
|
||||
{=====}
|
||||
|
||||
|
||||
procedure TVpmORMotDataStore.RefreshResource;
|
||||
begin
|
||||
RefreshTable(FResourceTable);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.RefreshEvents;
|
||||
begin
|
||||
RefreshTable(FEventsTable);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.RefreshContacts;
|
||||
begin
|
||||
RefreshTable(FContactsTable);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpmORMotDataStore.RefreshTasks;
|
||||
begin
|
||||
RefreshTable(FTasksTable);
|
||||
inherited;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
|
||||
function TVpmORMotDataStore.GetResourceTable : TDataset;
|
||||
begin
|
||||
Result := FResourceTable AS TDataset;
|
||||
end;
|
||||
|
||||
function TVpmORMotDataStore.GetEventsTable : TDataset;
|
||||
begin
|
||||
Result := FEventsTable AS TDataset;
|
||||
end;
|
||||
|
||||
function TVpmORMotDataStore.GetContactsTable : TDataset;
|
||||
begin
|
||||
Result := FContactsTable AS TDataset;
|
||||
end;
|
||||
|
||||
function TVpmORMotDataStore.GetTasksTable : TDataset;
|
||||
begin
|
||||
Result := FTasksTable AS TDataset;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user