source upload

2022-01-17 22:16:47 +02:00
parent 12936d065b
commit 098e8c48de
1778 changed files with 1206749 additions and 0 deletions
--- a/contrib/mORMot/SQLite3/Samples/19
+++ b/contrib/mORMot/SQLite3/Samples/19
@@ -0,0 +1,128 @@
+unit Unit2;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ShellAPI,
+  SynCommons, SynTable, SynLog, SynZip, SynCrtSock,
+  mORMot, mORMotSQLite3, SynSQLite3Static, mORMotHttpServer;
+
+type
+  TSQLBiolife = class(TSQLRecord)
+  public
+    fSpecies_No: integer;
+    fCategory: RawUTF8;
+    fCommon_Name: RawUTF8;
+    fSpecies_Name: RawUTF8;
+    fLength_cm: double;
+    fLength_in: double;
+    fNotes: RawUTF8;
+    fGraphic: TSQLRawBlob;
+    fSom: TSQLRawBlob;
+  published
+    property Species_No: integer read fSpecies_No write fSpecies_No;
+    property Category: RawUTF8 read fCategory write fCategory;
+    property Common_Name: RawUTF8 read fCommon_Name write fCommon_Name;
+    property Species_Name: RawUTF8 read fSpecies_Name write fSpecies_Name;
+    property Length_cm: double read fLength_cm write fLength_cm;
+    property Length_in: double read fLength_in write fLength_in;
+    property Notes: RawUTF8 read fNotes write fNotes;
+    property Graphic: TSQLRawBlob read fGraphic write fGraphic;
+    property Som: TSQLRawBlob read fSom write fSom;
+  end;
+
+  TForm1 = class(TForm)
+    Label1: TLabel;
+    btnQuit: TButton;
+    Label2: TLabel;
+    btnShowLogs: TButton;
+    btnOpenBrowser: TButton;
+    procedure btnQuitClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure btnShowLogsClick(Sender: TObject);
+    procedure btnOpenBrowserClick(Sender: TObject);
+  private
+    fDatabaseFileName: TFileName;
+  public
+    Model: TSQLModel;
+    DB: TSQLRestServerDB;
+    Server: TSQLHttpServer;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+
+{ TForm1 }
+
+procedure TForm1.btnQuitClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+var download: RawByteString;
+begin
+  Model := TSQLModel.Create([TSQLBiolife]);
+  fDatabaseFileName := ChangeFileExt(paramstr(0),'.db3');
+  if not FileExists(fDatabaseFileName) then begin
+    download := TWinINet.Get('https://synopse.info/files/samples/Project19Server.zip');
+    if download<>'' then
+      with TZipRead.Create(pointer(download),length(download)) do
+      try
+        UnZip(ExtractFileName(fDatabaseFileName),ExtractFilePath(fDatabaseFileName));
+      finally
+        Free;
+      end;
+    if not FileExists(fDatabaseFileName) then begin
+      ShowMessage('Impossible to find '+fDatabaseFileName+
+        #13#13'Please download it from https://synopse.info/files/samples/Project19Server.zip');
+      exit;
+    end;
+  end;
+  DB := TSQLRestServerDB.Create(Model,fDatabaseFileName);
+  // initialize and launch the server
+  DB.CreateMissingTables;
+  Server := TSQLHttpServer.Create('8080',[DB],'+',useHttpApiRegisteringURI);
+  Server.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Server.Free;
+  DB.Free;
+  Model.Free;
+end;
+
+procedure TForm1.FormShow(Sender: TObject);
+begin
+  if DB=nil then
+    Close;
+  Label1.Caption := Caption;
+end;
+
+procedure TForm1.btnShowLogsClick(Sender: TObject);
+begin
+  AllocConsole;
+  TextColor(ccLightGray); // to force the console to be recognized
+  with TSQLLog.Family do begin
+    Level := LOG_VERBOSE;
+    EchoToConsole := LOG_VERBOSE; // log all events to the console
+  end;
+  btnShowLogs.Hide;
+end;
+
+procedure TForm1.btnOpenBrowserClick(Sender: TObject);
+begin
+  ShellExecute(0,'open',pointer(ExtractFilePath(ParamStr(0))+'html5\index.html'),
+    nil,nil,SW_SHOWNORMAL);
+end;
+
+end.