source upload

contrib/mORMot/SQLite3/Samples/16 - Execute SQL via services/Project16ServerHttp.dpr

@@ -0,0 +1,124 @@
+/// 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.