125 lines
3.8 KiB
ObjectPascal
125 lines
3.8 KiB
ObjectPascal
/// this server will use TSQLRestServerFullMemory over HTTP
|
|
program Project16ServerHttp;
|
|
|
|
{.$APPTYPE CONSOLE} // is done below by calling AllocConsole API
|
|
|
|
// first line of uses clause must be {$I SynDprUses.inc}
|
|
uses
|
|
{$I SynDprUses.inc}
|
|
Windows,
|
|
SysUtils,
|
|
Classes,
|
|
SynCommons,
|
|
SynTable,
|
|
SynLog,
|
|
mORMot,
|
|
mORMotDB,
|
|
mORMotHttpServer,
|
|
SynDB,
|
|
SynDBOracle,
|
|
SynDBSQLite3, SynSQLite3Static,
|
|
SynOleDB,
|
|
SynDBODBC,
|
|
Project16Interface;
|
|
|
|
type
|
|
TServiceRemoteSQL = class(TInterfacedObject, IRemoteSQL)
|
|
protected
|
|
fProps: TSQLDBConnectionProperties;
|
|
public
|
|
destructor Destroy; override;
|
|
public // implements IRemoteSQL methods
|
|
procedure Connect(aEngine: TRemoteSQLEngine; const aServerName, aDatabaseName,
|
|
aUserID, aPassWord: RawUTF8);
|
|
function GetTableNames: TRawUTF8DynArray;
|
|
function Execute(const aSQL: RawUTF8; aExpectResults, aExpanded: Boolean): RawJSON;
|
|
end;
|
|
|
|
|
|
{ TServiceRemoteSQL }
|
|
|
|
procedure TServiceRemoteSQL.Connect(aEngine: TRemoteSQLEngine;
|
|
const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8);
|
|
const // rseOleDB, rseODBC, rseOracle, rseSQlite3, rseJet, rseMSSQL
|
|
TYPES: array[TRemoteSQLEngine] of TSQLDBConnectionPropertiesClass = (
|
|
TOleDBConnectionProperties, TODBCConnectionProperties,
|
|
TSQLDBOracleConnectionProperties, TSQLDBSQLite3ConnectionProperties,
|
|
{$ifdef WIN64}nil{$else}TOleDBJetConnectionProperties{$endif},
|
|
TOleDBMSSQL2008ConnectionProperties);
|
|
begin
|
|
if fProps<>nil then
|
|
raise Exception.Create('Connect called more than once');
|
|
if TYPES[aEngine]=nil then
|
|
raise Exception.CreateFmt('aEngine=%s is not supported',
|
|
[GetEnumName(TypeInfo(TRemoteSQLEngine),ord(aEngine))^]);
|
|
fProps := TYPES[aEngine].Create(aServerName,aDatabaseName,aUserID,aPassWord);
|
|
end;
|
|
|
|
function TServiceRemoteSQL.Execute(const aSQL: RawUTF8; aExpectResults, aExpanded: Boolean): RawJSON;
|
|
var res: ISQLDBRows;
|
|
begin
|
|
if fProps=nil then
|
|
raise Exception.Create('Connect call required before Execute');
|
|
res := fProps.ExecuteInlined(aSQL,aExpectResults);
|
|
if res=nil then
|
|
result := '' else
|
|
result := res.FetchAllAsJSON(aExpanded);
|
|
end;
|
|
|
|
function TServiceRemoteSQL.GetTableNames: TRawUTF8DynArray;
|
|
begin
|
|
if fProps=nil then
|
|
raise Exception.Create('Connect call required before GetTableNames');
|
|
fProps.GetTableNames(result);
|
|
end;
|
|
|
|
destructor TServiceRemoteSQL.Destroy;
|
|
begin
|
|
FreeAndNil(fProps);
|
|
inherited;
|
|
end;
|
|
|
|
|
|
var
|
|
aModel: TSQLModel;
|
|
aServer: TSQLRestServer;
|
|
aHTTPServer: TSQLHttpServer;
|
|
begin
|
|
// define the log level
|
|
with TSQLLog.Family do begin
|
|
Level := LOG_VERBOSE;
|
|
EchoToConsole := LOG_VERBOSE; // log all events to the console
|
|
PerThreadLog := ptIdentifiedInOnFile;
|
|
end;
|
|
// manual switch to console mode
|
|
AllocConsole;
|
|
TextColor(ccLightGray); // needed to notify previous AllocConsole
|
|
// create a Data Model
|
|
aModel := TSQLModel.Create([],ROOT_NAME);
|
|
try
|
|
// initialize a TObjectList-based database engine
|
|
aServer := TSQLRestServerFullMemory.Create(aModel,'users.json',false,true);
|
|
try
|
|
// register our IRemoteSQL service on the server side
|
|
aServer.ServiceRegister(TServiceRemoteSQL,[TypeInfo(IRemoteSQL)],sicClientDriven).
|
|
// fProps should better be executed/released in the one main thread
|
|
SetOptions([],[optExecInMainThread,optFreeInMainThread]);
|
|
// launch the HTTP server
|
|
aHTTPServer := TSQLHttpServer.Create(PORT_NAME,[aServer],'+',useHttpApiRegisteringURI);
|
|
try
|
|
aHTTPServer.AccessControlAllowOrigin := '*'; // for AJAX requests to work
|
|
Sleep(200); // allow all HTTP threads to be launched and logged
|
|
writeln(#10'Background server is running.'#10);
|
|
writeln('Press [Enter] to close the server.'#10);
|
|
ConsoleWaitForEnterKey;
|
|
finally
|
|
aHTTPServer.Free;
|
|
end;
|
|
finally
|
|
aServer.Free;
|
|
end;
|
|
finally
|
|
aModel.Free;
|
|
end;
|
|
end.
|