source upload

contrib/mORMot/SQLite3/Samples/MainDemo/FileClient.pas

@@ -0,0 +1,180 @@
+/// SynFile client handling
+unit FileClient;
+
+interface
+
+{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
+
+uses
+  Windows,
+  SysUtils,
+  Classes,
+  Graphics,
+  SynCommons,
+  SynGdiPlus,
+  mORMot,
+  mORMotHttpClient,
+  mORMoti18n,
+  mORMotToolBar,
+  mORMotReport,
+  FileTables;
+
+type
+  /// a HTTP/1.1 client to access SynFile
+  TFileClient = class(TSQLHttpClient)
+  public
+    /// initialize the Client for a specified network Server name
+    constructor Create(const aServer: AnsiString); reintroduce;
+  	/// used internaly to retrieve a given action
+    function OnSetAction(TableIndex, ToolbarIndex: integer; TestEnabled: boolean;
+      var Action): string;
+  	/// client-side access to the remote RESTful service
+    procedure AddAuditTrail(aEvent: TFileEvent; aAssociatedRecord: TSQLRecord);
+  end;
+
+  /// class used to create the User interface
+  TFileRibbon = class(TSQLRibbon)
+  public
+    /// overridden method used customize the report content
+    procedure CreateReport(aTable: TSQLRecordClass; aID: TID; aReport: TGDIPages;
+      AlreadyBegan: boolean=false); override;
+  end;
+
+
+implementation
+
+uses Forms;
+
+
+{ TFileClient }
+
+procedure TFileClient.AddAuditTrail(aEvent: TFileEvent;
+  aAssociatedRecord: TSQLRecord);
+begin
+  if aAssociatedRecord=nil then
+    CallBackGetResult('Event',['event',ord(aEvent)]) else
+    with aAssociatedRecord do
+      CallBackGetResult('Event',['event',ord(aEvent)],RecordClass,ID);
+end;
+
+constructor TFileClient.Create(const aServer: AnsiString);
+begin
+  inherited Create(aServer,SERVER_HTTP_PORT,CreateFileModel(self));
+  ForceBlobTransfert := true;
+end;
+
+function TFileClient.OnSetAction(TableIndex, ToolbarIndex: integer;
+  TestEnabled: boolean; var Action): string;
+var A: TFileActions;
+begin
+  Result := '';
+  if ToolBarIndex<0 then
+    ToolbarIndex := FileActionsToolbar_MARKINDEX;
+  A := FileTabs[TableIndex].Actions*FileActionsToolBar[ToolBarIndex];
+  move(A,Action,sizeof(A));
+end;
+
+
+{ TFileRibbon }
+
+resourcestring
+  sCreated = 'Created';
+  sModified = 'Modified';
+  sKeyWords = 'KeyWords';
+  sContent = 'Content';
+  sNone = 'None';
+  sPageN = 'Page %d / %d';
+  sSizeN = 'Size: %s';
+  sContentTypeN = 'Content Type: %s';
+  sSafeMemoContent = 'This memo is password protected.'#13+
+    'Please click on the "Edit" button to show its content.';
+  sDataContent = 'Please click on the "Extract" button to get its content.';
+  sSignedN = 'Signed,By %s on %s';
+  sPictureN = '%s Picture';
+
+procedure TFileRibbon.CreateReport(aTable: TSQLRecordClass; aID: TID; aReport: TGDIPages;
+  AlreadyBegan: boolean=false);
+var Rec: TSQLFile;
+    Pic: TBitmap;
+    s: string;
+    PC: PWideChar;
+    P: TSQLRibbonTab;
+begin
+  with aReport do begin
+    // initialize report
+    Clear;
+    BeginDoc;
+    Font.Size := 10;
+    if not aTable.InheritsFrom(TSQLFile) then
+      P := nil else
+      P := GetActivePage;
+    if (P=nil) or (P.CurrentRecord.ID<>aID) or (P.Table<>aTable) then begin
+      inherited; // default handler
+      exit;
+    end;
+    Rec := TSQLFile(P.CurrentRecord);
+    Caption := U2S(Rec.fName);
+    // prepare page footer
+    SaveLayout;
+    Font.Size := 9;
+    AddPagesToFooterAt(sPageN,LeftMargin);
+    TextAlign := taRight;
+    AddTextToFooterAt('SynFile  https://synopse.info - '+Caption,RightMarginPos);
+    RestoreSavedLayout;
+    // write global header at the beginning of the report
+    DrawTitle(P.Table.CaptionName+' : '+Caption,true);
+    NewHalfLine;
+    AddColumns([6,40]);
+    SetColumnBold(0);
+    if Rec.SignatureTime<>0 then begin
+      PC := Pointer(StringToSynUnicode(Format(sSignedN,[Rec.SignedBy,Iso2S(Rec.SignatureTime)])));
+      DrawTextAcrossColsFromCSV(PC,$C0C0FF);
+    end;
+    if Rec.fCreated<>0 then
+      DrawTextAcrossCols([sCreated,Iso2S(Rec.fCreated)]);
+    if Rec.fModified<>0 then
+      DrawTextAcrossCols([sModified,Iso2S(Rec.fModified)]);
+    if Rec.fKeyWords='' then
+      s := sNone else begin
+      s := U2S(Rec.fKeyWords);
+      ExportPDFKeywords := s;
+    end;
+    DrawTextAcrossCols([sKeyWords,s]);
+    NewLine;
+    Pic := LoadFromRawByteString(Rec.fPicture);
+    if Pic<>nil then
+    try
+      DrawBMP(Pic,0,Pic.Width div 3);
+    finally
+      Pic.Free;
+    end;
+    // write report content
+    DrawTitle(sContent,true);
+    SaveLayout;
+    Font.Name := 'Courier New';
+    if Rec.InheritsFrom(TSQLSafeMemo) then
+      DrawText(sSafeMemoContent) else
+    if Rec.InheritsFrom(TSQLMemo) then
+      DrawTextU(TSQLMemo(Rec).Content) else
+    if Rec.InheritsFrom(TSQLData) then
+    with TSQLData(Rec) do begin
+      DrawTextU(Rec.fName);
+      s := PictureName(TSynPicture.IsPicture(TFileName(Rec.fName)));
+      if s<>'' then
+        s := format(sPictureN,[s]) else
+        if not Rec.InheritsFrom(TSQLSafeData) then
+          s := U2S(GetMimeContentType(Pointer(Data),Length(Data),TFileName(Rec.fName)));
+      if s<>'' then
+        DrawTextFmt(sContentTypeN,[s]);
+      DrawTextFmt(sSizeN,[U2S(KB(Data))]);
+      NewHalfLine;
+      DrawText(sDataContent);
+    end;
+    RestoreSavedLayout;
+    // set custom report parameters
+    ExportPDFApplication := 'SynFile  https://synopse.info';
+    ExportPDFForceJPEGCompression := 80;
+  end;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/MainDemo/FileEdit.dfm

@@ -0,0 +1,52 @@
+object EditForm: TEditForm
+  Left = 356
+  Top = 250
+  Width = 630
+  Height = 535
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnShow = FormShow
+  DesignSize = (
+    614
+    497)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Name: TLabeledEdit
+    Left = 96
+    Top = 24
+    Width = 257
+    Height = 21
+    EditLabel.Width = 27
+    EditLabel.Height = 13
+    EditLabel.Caption = 'Name'
+    LabelPosition = lpLeft
+    TabOrder = 0
+  end
+  object KeyWords: TLabeledEdit
+    Left = 96
+    Top = 56
+    Width = 456
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    EditLabel.Width = 49
+    EditLabel.Height = 13
+    EditLabel.Caption = 'KeyWords'
+    LabelPosition = lpLeft
+    TabOrder = 1
+  end
+  object Memo: TMemo
+    Left = 16
+    Top = 88
+    Width = 576
+    Height = 332
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    ScrollBars = ssVertical
+    TabOrder = 2
+  end
+end

contrib/mORMot/SQLite3/Samples/MainDemo/FileEdit.pas

@@ -0,0 +1,203 @@
+/// SynFile Edit window
+unit FileEdit;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, ExtDlgs,
+{$ifdef USETMSPACK}
+  TaskDialog,
+{$endif}
+  SynCommons, SynCrypto, SynGdiPlus, SynTaskDialog,
+  mORMot, mORMotUILogin, mORMotUI, mORMoti18n,
+  FileTables;
+
+type
+  /// SynFile Edit window
+  // - we don't use the standard Window generation (from mORMotUIEdit),
+  // but a custom window, created as RAD
+  TEditForm = class(TVistaForm)
+    Name: TLabeledEdit;
+    KeyWords: TLabeledEdit;
+    Memo: TMemo;
+    procedure FormShow(Sender: TObject);
+    procedure BtnOkClick(Sender: TObject);
+    procedure BtnPictureClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    fRec: TSQLFile;
+    fReadOnly: boolean;
+    BtnOk: TSynButton;
+    BtnCancel: TSynButton;
+    BtnPicture: TSynButton;
+  public
+    /// set the associated record to be edited
+    function SetRec(const Value: TSQLFile): boolean;
+	/// used to load a picture file into a BLOB content 
+	// after 80% JPEG compression
+    function LoadPicture(const FileName: TFileName; var Picture: RawByteString): boolean;
+	/// read-only access to the edited record
+    property Rec: TSQLFile read fRec;
+	/// should be set to TRUE to disable any content editing
+    property ReadOnly: boolean read fReadOnly write fReadOnly;
+  end;
+
+var
+  /// SynFile Edit window instance
+  EditForm: TEditForm;
+
+/// will display a modal form asking for a password, then encrypt
+// or uncrypt some BLOB content
+// - returns TRUE if the password was correct and the data processed
+// - returns FALSE on error (canceled or wrong password)
+function Cypher(const Title: string; var Content: TSQLRawBlob; Encrypt: boolean): boolean;
+
+
+implementation
+
+{$R *.dfm}
+
+{ TEditForm }
+
+function TEditForm.SetRec(const Value: TSQLFile): boolean;
+begin
+  result := false;
+  fRec := Value;
+  Name.Text := U2S(Value.fName);
+  KeyWords.Text := U2S(Value.fKeyWords);
+  if Value.InheritsFrom(TSQLData) and not Value.InheritsFrom(TSQLSafeMemo) then begin
+    Memo.Hide;
+    ClientHeight := 165;
+  end else begin
+    Memo.Show;
+    ClientHeight := 500;
+    if Value.InheritsFrom(TSQLMemo) then
+      Memo.Text := U2S(TSQLMemo(Value).Content) else
+    if Value.InheritsFrom(TSQLSafeMemo) then
+      with TSQLSafeMemo(Value) do
+        if not Cypher(Rec.CaptionName,fData,false) then
+          exit else
+          Memo.Text := U2S(Data) else
+      Memo.Hide;
+  end;
+  Name.ReadOnly := ReadOnly;
+  KeyWords.ReadOnly := ReadOnly;
+  if Memo.Visible then
+    Memo.ReadOnly := ReadOnly;
+  BtnCancel.Visible := not ReadOnly;
+  result := true;
+end;
+
+
+procedure TEditForm.FormCreate(Sender: TObject);
+resourcestring
+  BtnPictureHint = 'Change the Picture associated with this record';
+begin
+  BtnOK := TSynButton.CreateKind(self,cbOK,337,437,100,41);
+  BtnOK.ModalResult := mrNone;
+  BtnOK.OnClick := BtnOKClick;
+  BtnOK.Anchors := [akRight, akBottom];
+  BtnCancel := TSynButton.CreateKind(self,cbCancel,457,437,100,41);
+  BtnCancel.Anchors := [akRight, akBottom];
+  BtnPicture := TSynButton.Create(self);
+  BtnPicture.Parent := self;
+  BtnPicture.SetBounds(392,21,105,25);
+  BtnPicture.Hint := BtnPictureHint;
+  BtnPicture.OnClick := BtnPictureClick;
+end;
+
+procedure TEditForm.FormShow(Sender: TObject);
+begin
+  Name.EditLabel.Caption := _('Name');
+  KeyWords.EditLabel.Caption := _('KeyWords');
+  BtnPicture.Caption := _('Picture');
+  SetStyle(self);
+end;
+
+procedure TEditForm.BtnOkClick(Sender: TObject);
+begin
+  if ReadOnly then
+    ModalResult := mrCancel else begin
+    Rec.fModified := TimeLogNow;
+    Rec.fName := trim(S2U(Name.Text));
+    if Rec.fName='' then begin
+      Name.SetFocus;
+      ShowMessage(_('Name'),true);
+      exit;
+    end;
+    Rec.fKeyWords := trim(S2U(KeyWords.Text));
+    if Rec.InheritsFrom(TSQLMemo) then
+      TSQLMemo(Rec).Content := S2U(Memo.Text) else
+    if Rec.ClassType=TSQLSafeMemo then
+    with TSQLSafeMemo(Rec) do begin
+      Data := S2U(Memo.Text);
+      if not Cypher(Rec.CaptionName,fData,true) then
+        exit;
+    end;
+    ModalResult := mrOk;
+  end;
+end;
+
+function Cypher(const Title: string; var Content: TSQLRawBlob; Encrypt: boolean): boolean;
+resourcestring
+  sEnterPassword = 'Enter password for this record:';
+var AES: TAESFull;
+    SHA: TSHA256Digest;
+    PassWord: string;
+    Len: integer;
+begin
+  result := Content='';
+  if result then
+    exit;
+  if not TLoginForm.PassWord(Title,sEnterPassword,PassWord) then
+    exit;
+  SHA256Weak(S2U(PassWord), SHA);
+  try
+    Len := AES.EncodeDecode(SHA,256,length(Content),Encrypt,nil,nil,Pointer(Content),nil);
+    if Len<0 then
+      exit;
+    SetString(Content,PAnsiChar(AES.outStreamCreated.Memory),Len);
+    result := true;
+  finally
+    AES.OutStreamCreated.Free;
+  end;
+end;
+
+procedure TEditForm.BtnPictureClick(Sender: TObject);
+begin
+  Rec.fPicture := '';
+  with TOpenPictureDialog.Create(self) do
+  try
+    Title := BtnPicture.Hint;
+    Filter := GraphicFilter(TGraphic);
+    Options := [ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofEnableSizing];
+    if Execute then
+      LoadPicture(FileName,RawByteString(Rec.fPicture));
+  finally
+    Free;
+  end;
+end;
+
+function TEditForm.LoadPicture(const FileName: TFileName; var Picture: RawByteString): boolean;
+var Pic: TSynPicture;
+begin
+  result := false;
+  if not FileExists(FileName) then
+    exit;
+  Pic := TSynPicture.Create;
+  try
+    Pic.LoadFromFile(FileName);
+    if Pic.Empty then
+      exit;
+    SaveAsRawByteString(Pic,Picture,gptJPG,80,300);
+    result := true;
+  finally
+    Pic.Free;
+  end;
+end;
+
+
+initialization
+  Gdip.RegisterPictures;
+end.

contrib/mORMot/SQLite3/Samples/MainDemo/FileMain.dfm

@@ -0,0 +1,31 @@
+object MainForm: TMainForm
+  Left = 180
+  Top = 235
+  Width = 1015
+  Height = 735
+  Caption = ' Synopse mORMot Framework demo - SynFile'
+  Color = clBtnFace
+  Constraints.MinHeight = 240
+  Constraints.MinWidth = 132
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = True
+  Position = poScreenCenter
+  OnCreate = FormCreate
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 13
+  object ImageList32: TImageList
+    Height = 32
+    Width = 32
+    Left = 224
+    Top = 72
+  end
+  object ImageList16: TImageList
+    Left = 264
+    Top = 72
+  end
+end

contrib/mORMot/SQLite3/Samples/MainDemo/FileMain.pas

@@ -0,0 +1,343 @@
+/// SynFile main Window
+unit FileMain;
+
+interface
+
+{$define DEBUGINTERNALSERVER}
+
+{.$define EXTRACTALLRESOURCES}
+// must be set globally for the whole application
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+{$ifdef USETMSPACK}
+  AdvToolBar, AdvPreviewMenu, AdvShapeButton, AdvOfficePager,
+{$endif}
+  ImgList, ShellApi,
+  SynCommons, SynTable, SynGdiPlus, mORMot, mORMotHttpClient,
+  mORMotToolBar, mORMotUI, mORMotUILogin, mORMoti18n,
+{$ifdef DEBUGINTERNALSERVER}
+  FileServer,
+{$endif}
+  FileTables, FileClient, FileEdit;
+
+type
+  /// SynFile main Window
+  TMainForm = class(TSynForm)
+    ImageList32: TImageList;
+    ImageList16: TImageList;
+    procedure FormCreate(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+{$ifdef DEBUGINTERNALSERVER}
+    Server: TFileServer;
+{$endif}
+  protected
+    /// event called when the User click on a ribbon button
+    procedure ActionClick(Sender: TObject; RecordClass: TSQLRecordClass;
+      ActionValue: integer);
+	  /// display some help
+    procedure HelpClick(Sender: TObject);
+  	/// a double click on the list will edit the item
+    procedure ListDblClick(Sender: TObject);
+	  /// will be used to refresh the UI using a Stateless approach
+    procedure WMRefreshTimer(var Msg: TWMTimer); message WM_TIMER;
+  	/// used to edit a record
+    function Edit(aRec: TSQLFile; const aTitle: string; aReadOnly: boolean): boolean;
+  public
+    /// the associated database client
+    Client: TFileClient;
+  	/// the associated Ribbon which will handle all User Interface
+    Ribbon: TFileRibbon;
+	  /// release all used memory
+    destructor Destroy; override;
+  end;
+
+var
+  MainForm: TMainForm;
+
+
+implementation
+
+{$R *.dfm}
+
+{$R FileMain.res}
+
+procedure TMainForm.ActionClick(Sender: TObject;
+  RecordClass: TSQLRecordClass; ActionValue: integer);
+var Action: TFileAction absolute ActionValue;
+    Tab: TSQLRibbonTab;
+    ActionCaption, ActionHint: string;
+    Rec: TSQLFile;
+    FN: TFileName;
+    isMemo: boolean;
+    i, n: integer;
+function Open: Boolean;
+begin
+  result := false;
+  with TOpenDialog.Create(self) do
+  try
+    Title := ActionHint;
+    if isMemo then begin
+      DefaultExt := 'txt';
+      Filter := '*.txt';
+    end;
+    Options := [ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofEnableSizing];
+    if not Execute or not FileExists(FileName) then
+      exit;
+    FN := FileName;
+    result := true;
+  finally
+    Free;
+  end;
+end;
+function Save(const aFileName: TFileName): Boolean;
+begin
+  result := false;
+  with TSaveDialog.Create(self) do
+  try
+    Title := ActionHint;
+    Options := [ofOverwritePrompt,ofHideReadOnly,ofEnableSizing];
+    if isMemo then
+      DefaultExt := 'txt' else
+      DefaultExt:= Copy(ExtractFileExt(aFileName),2,10);
+    if DefaultExt<>'' then
+      Filter := '*.'+DefaultExt;
+    FileName := aFileName;
+    if not Execute then
+      exit;
+    FN := FileName;
+    result := true;
+  finally
+    Free;
+  end;
+end;
+begin
+  if not Visible or (Client=nil) or
+    Ribbon.RefreshClickHandled(Sender,RecordClass,ActionValue,Tab) then
+    exit;
+  ActionCaption := Client.Model.ActionName(Action);
+  ActionHint := Tab.Lister.ActionHint(Action);
+  isMemo := (RecordClass=TSQLMemo) or (RecordClass=TSQLSafeMemo);
+  Rec := nil;
+  case Action of
+    faRefresh: exit;
+  end;
+  case Action of
+    faCreate, faCopy, faImport:
+    if RecordClass.InheritsFrom(TSQLFile) then
+    try
+      Rec := TSQLFile(RecordClass.Create);
+      case Action of
+      faCopy:
+        if Tab.Retrieve(Client,Tab.List.Row,false) then
+          CopyObject(Tab.CurrentRecord,Rec) else
+          exit;
+      faImport:
+        if isMemo and Open then
+        with TSQLSafeMemo(Rec) do begin
+          fName := S2U(ExtractFileName(FN));
+          fData := S2U(AnyTextFileToString(FN));
+          if (RecordClass=TSQLSafeMemo) and not Cypher(CaptionName,fData,true) then
+            exit;
+        end else
+          exit;
+      faCreate:
+        if ((RecordClass=TSQLData) or (RecordClass=TSQLSafeData)) then
+        if Open then begin
+          Rec.fName := S2U(ExtractFileName(FN));
+          if RecordClass=TSQLData then
+          with TSQLData(Rec) do begin
+            Data := StringFromFile(FN);
+            if TSynPicture.IsPicture(FN)<>nil then
+              EditForm.LoadPicture(FN,RawByteString(fPicture));
+          end else
+          with TSQLSafeData(Rec) do begin
+            fData := StringFromFile(FN);
+            if not Cypher(CaptionName,fData,true) then
+              exit;
+          end;
+        end else
+          exit;
+      end;
+      if Edit(Rec,ActionHint,false) then
+      try
+        Rec.fCreated := Rec.fModified;
+        Ribbon.GotoRecord(RecordClass,Client.Add(Rec,true));
+      finally
+        Client.UnLock(Tab.CurrentRecord);
+      end;
+    finally
+      Rec.Free;
+    end;
+    faEdit:
+    if RecordClass.InheritsFrom(TSQLFile) and Tab.Retrieve(Client,Tab.List.Row,true) then
+      try
+        if Edit(TSQLFile(Tab.CurrentRecord),ActionHint,false) then
+          if Client.Update(Tab.CurrentRecord) then
+            Ribbon.GotoRecord(Tab.CurrentRecord);
+      finally
+        Client.UnLock(Tab.CurrentRecord);
+      end;
+    faExtract, faExport:
+    if RecordClass.InheritsFrom(TSQLFile) then
+     if Tab.Retrieve(Client,Tab.List.Row) then
+      with TSQLData(Tab.CurrentRecord) do
+        if (RecordClass=TSQLMemo) or (RecordClass=TSQLData) or
+           Cypher(CaptionName,fData,false) then
+          if Save(U2S(TSQLFile(Tab.CurrentRecord).fName)) then
+            if FileFromString(fData,FN) then begin
+              Client.AddAuditTrail(feRecordExported,Tab.CurrentRecord);
+              ShellExecute(Handle,nil,pointer(FN),nil,nil,SW_SHOWNORMAL);
+            end;
+     faDelete:
+     with Tab.TableToGrid do begin
+       n := MarkedTotalCount;
+       if n=0 then
+         if (Tab.List.Row<1) or (YesNo(ActionHint,
+           U2S(Client.OneFieldValue(RecordClass,'Name',Tab.CurrentID)),false)=ID_NO) or
+            not Client.Delete(RecordClass,Tab.CurrentID) then
+           Beep else begin
+           n := Table.IDColumnHiddenValue(Tab.List.Row+1);
+           Refresh;
+           Ribbon.GotoRecord(RecordClass,n);
+         end else
+       if YesNo(ActionHint,Format(sDeleteN,[n]),false)=ID_NO then
+         exit else
+       if Client.TransactionBegin(RecordClass) then
+       try
+         for i := Table.RowCount downto 1 do
+           if Marked[i] then
+             if not Client.Delete(RecordClass,Table.IDColumnHiddenValue(i)) then begin
+               Client.RollBack;
+               Beep;
+               break;
+             end;
+         SetMark(actUnmarkAll);
+         Tab.List.Row := 0;
+       finally
+         Client.Commit;
+         Refresh;
+       end;
+    end;
+    faSign:
+    if RecordClass.InheritsFrom(TSQLFile) and Tab.Retrieve(Client,Tab.List.Row,true) then
+      try
+        with TSQLData(Tab.CurrentRecord) do
+        if SetAndSignContent('User',Data) then
+          if Client.Update(Tab.CurrentRecord) then
+            Ribbon.GotoRecord(Tab.CurrentRecord);
+      finally
+        Client.UnLock(Tab.CurrentRecord);
+      end;
+    faPrintPreview:
+      Tab.Report.ShowPreviewForm;
+  end;
+end;
+
+destructor TMainForm.Destroy;
+begin
+  FreeAndNil(Ribbon);
+  FreeAndNil(Client);
+{$ifdef DEBUGINTERNALSERVER}
+  FreeAndNil(Server);
+{$endif}
+  inherited;
+end;
+
+procedure TMainForm.WMRefreshTimer(var Msg: TWMTimer);
+begin
+  Ribbon.WMRefreshTimer(Msg);
+end;
+
+resourcestring
+  sHelpN = '%s Version %s';
+  sWrongPassword = 'Wrong password';
+
+procedure TMainForm.HelpClick(Sender: TObject);
+begin
+  mORMotUILogin.ShowMessage(format(sHelpN,[Caption,ExeVersion.Version.Detailed])+
+    '\n\nSynopse mORMot '+SYNOPSE_FRAMEWORK_VERSION+
+    ' - https://synopse.info');
+end;
+
+function TMainForm.Edit(aRec: TSQLFile; const aTitle: string; aReadOnly: boolean): boolean;
+begin
+  EditForm.Caption := ' '+aTitle;
+  EditForm.ReadOnly := aReadOnly;
+  result := EditForm.SetRec(aRec);
+  if result then
+    result := EditForm.ShowModal=mrOk else
+    ShowMessage(sWrongPassword,true);
+end;
+
+procedure TMainForm.ListDblClick(Sender: TObject);
+var P: TSQLRibbonTab;
+    ref: RecordRef;
+begin
+  P := Ribbon.GetActivePage;
+  if P<>nil then
+    if P.Table=TSQLAuditTrail then begin
+      if P.Retrieve(Client,P.List.Row) then begin
+        ref.Value := TSQLAuditTrail(P.CurrentRecord).AssociatedRecord;
+        Ribbon.GotoRecord(ref.Table(Client.Model),ref.ID);
+      end;
+    end else
+    ActionClick(Sender,P.Table,ord(faEdit));
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+var P: integer;
+begin
+{$ifdef DEBUGINTERNALSERVER}
+  try
+    Server := TFileServer.Create;
+  except
+    on E: Exception do begin
+      ShowException(E);
+      exit;
+    end;
+  end;
+{$endif}
+  LoadImageListFromEmbeddedZip(ImageList32,'buttons.bmp');
+  ImageListStretch(ImageList32,ImageList16);
+  Client := TFileClient.Create('localhost');
+  Client.OnIdle := TLoginForm.OnIdleProcessForm; 
+  Ribbon := TFileRibbon.Create(self, nil, nil, ImageList32, ImageList16,
+    Client, ALL_ACCESS_RIGHTS, nil, Client.OnSetAction, sFileActionsToolbar,
+    sFileActionsHints, nil, ActionClick, integer(faRefresh), 1, false,
+    length(FileTabs), @FileTabs[0], sizeof(FileTabs[0]),
+    sFileTabsGroup, ',BannerData,BannerSafe',true);
+  Ribbon.ToolBar.Caption.Caption := Caption;
+  Ribbon.ToolBar.HelpButton.OnClick := HelpClick;
+  for P := 0 to high(Ribbon.Page) do
+    with Ribbon.Page[P] do
+      if Lister<>nil then
+        Lister.Grid.OnDblClick := ListDblClick;
+end;
+
+procedure TMainForm.FormShow(Sender: TObject);
+begin
+{$ifdef DEBUGINTERNALSERVER}
+  if Server=nil then begin
+    Close;
+    exit;
+  end;
+{$endif}
+{$ifdef EXTRACTALLRESOURCES}
+  ExtractAllResources(
+    // first, all enumerations to be translated
+    [TypeInfo(TFileEvent),TypeInfo(TFileAction),TypeInfo(TPreviewAction)],
+    // then some class instances (including the TSQLModel will handle all TSQLRecord)
+    [Client.Model],
+    // some custom classes or captions
+    [],[]);
+  Close;
+{$else}
+  //i18nLanguageToRegistry(lngFrench);
+{$endif}
+  Ribbon.ToolBar.ActivePageIndex := 1;
+end;
+
+
+end.

contrib/mORMot/SQLite3/Samples/MainDemo/FileMain.rc

@@ -0,0 +1,3 @@
+Zip ZIP "FileMain.zip"
+BannerData 10 "BannerData.png"
+BannerSafe 10 "BannerSafe.png"

contrib/mORMot/SQLite3/Samples/MainDemo/FileMainRes.bat

@@ -0,0 +1,2 @@
+brcc32 FileMain.rc
+rem pause

contrib/mORMot/SQLite3/Samples/MainDemo/FileServer.pas

@@ -0,0 +1,118 @@
+/// SynFile server handling
+unit FileServer;
+
+interface
+
+{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
+
+uses
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynTable,
+  mORMot,
+  mORMoti18n,
+  mORMotHttpServer,
+  mORMotSQLite3,
+  SynSQLite3Static,
+  FileTables;
+
+type
+  /// a server to access SynFile data content
+  TFileServer = class(TSQLRestserverDB)
+  private
+    fTempAuditTrail: TSQLAuditTrail;
+  public
+    /// the runing HTTP/1.1 server
+    Server: TSQLHttpServer;
+  	/// create the database and HTTP/1.1 server
+    constructor Create;
+	  /// release used memory and data
+    destructor Destroy; override;
+  	/// add a row to the TSQLAuditTrail table
+    procedure AddAuditTrail(aEvent: TFileEvent; const aMessage: RawUTF8='';
+      aAssociatedRecord: TRecordReference=0);
+	  /// database server-side trigger which will add an event to the
+  	// TSQLAuditTrail table
+    function OnDatabaseUpdateEvent(Sender: TSQLRestServer;
+      Event: TSQLEvent; aTable: TSQLRecordClass; const aID: TID;
+      const aSentData: RawUTF8): boolean;
+  published
+    /// a RESTful service used from the client side to add an event
+  	// to the TSQLAuditTrail table
+	  // - an optional database record can be specified in order to be
+  	// associated with the event
+    procedure Event(Ctxt: TSQLRestServerURIContext);
+  end;
+
+
+implementation
+
+
+{ TFileServer }
+
+procedure TFileServer.AddAuditTrail(aEvent: TFileEvent;
+  const aMessage: RawUTF8; aAssociatedRecord: TRecordReference);
+var T: TSQLRecordClass;
+    tmp: RawUTF8;
+begin
+  if fTempAuditTrail=nil then
+    fTempAuditTrail := TSQLAuditTrail.Create;
+  fTempAuditTrail.Time := TimeLogNow;
+  fTempAuditTrail.Status := aEvent;
+  fTempAuditTrail.StatusMessage := aMessage;
+  fTempAuditTrail.AssociatedRecord := aAssociatedRecord;
+  if (aMessage='') and (aAssociatedRecord<>0) then
+    with RecordRef(aAssociatedRecord) do begin
+      T := Table(Model);
+      if T.InheritsFrom(TSQLFile) then
+        tmp := '"'+OneFieldValue(T,'Name',ID)+'"' else
+        tmp := {$ifndef ENHANCEDRTL}Int32ToUtf8{$else}IntToStr{$endif}(ID);
+      fTempAuditTrail.StatusMessage := T.RecordProps.SQLTableName+'  '+tmp;
+    end;
+  Add(fTempAuditTrail,true);
+end;
+
+constructor TFileServer.Create;
+begin
+  inherited Create(CreateFileModel(self),ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
+  CreateMissingTables(ExeVersion.Version.Version32);
+  Server := TSQLHttpServer.Create(SERVER_HTTP_PORT,self,'+',useHttpApiRegisteringURI);
+  AddAuditTrail(feServerStarted);
+  OnUpdateEvent := OnDatabaseUpdateEvent;
+end;
+
+destructor TFileServer.Destroy;
+begin
+  try
+    AddAuditTrail(feServerShutdown);
+    FreeAndNil(fTempAuditTrail);
+    FreeAndNil(Server);
+  finally
+    inherited;
+  end;
+end;
+
+procedure TFileServer.Event(Ctxt: TSQLRestServerURIContext);
+var E: integer;
+begin
+  if UrlDecodeInteger(Ctxt.Parameters,'EVENT=',E) and
+     (E>ord(feUnknownState)) and (E<=ord(High(TFileEvent))) then begin
+    AddAuditTrail(TFileEvent(E),'',RecordReference(Model,Ctxt.Table,Ctxt.TableID));
+    Ctxt.Success;
+  end else
+    Ctxt.Error;
+end;
+
+function TFileServer.OnDatabaseUpdateEvent(Sender: TSQLRestServer;
+  Event: TSQLEvent; aTable: TSQLRecordClass; const aID: TID;
+  const aSentData: RawUTF8): boolean;
+const EVENT_FROM_SQLEVENT: array[low(TSQLEvent)..seDelete] of TFileEvent = (
+  feRecordCreated, feRecordModified, feRecordDeleted);
+begin
+  result := true;
+  if aTable.InheritsFrom(TSQLFile) and (Event<=high(EVENT_FROM_SQLEVENT)) then
+    AddAuditTrail(EVENT_FROM_SQLEVENT[Event], '', Model.RecordReference(aTable,aID));
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/MainDemo/FileTables.pas

@@ -0,0 +1,208 @@
+/// SynFile ORM definitions shared by both client and server
+unit FileTables;
+
+interface
+
+{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
+
+uses
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynCrypto,
+  SynZip,
+  mORMot,
+  mORMoti18n;
+
+type
+  /// the internal events/states, as used by the TSQLAuditTrail table
+  TFileEvent = (
+    feUnknownState,
+    feServerStarted,
+    feServerShutdown,
+    feRecordCreated,
+    feRecordModified,
+    feRecordDeleted,
+    feRecordDigitallySigned,
+    feRecordImported,
+    feRecordExported
+  );
+
+  /// the internal available actions, as used by the User Interface
+  TFileAction = (
+    faNoAction,
+    faMark,
+    faUnmarkAll,
+    faQuery,
+    faRefresh,
+    faCreate,
+    faEdit,
+    faCopy,
+    faExport,
+    faImport,
+    faDelete,
+    faSign,
+    faPrintPreview,
+    faExtract,
+    faSettings
+  );
+  /// set of available actions
+  TFileActions = set of TFileAction;
+
+  /// some actions to be used by the User Interface of a Preview window
+  TPreviewAction = (
+    paPrint, paAsPdf, paAsText,
+    paWithPicture, paDetails
+  );
+  TPreviewActions = set of TPreviewAction;
+
+  /// an abstract class, with common fields
+  TSQLFile = class(TSQLRecordSigned)
+  public
+    fName: RawUTF8;
+    fModified: TTimeLog;
+    fCreated: TTimeLog;
+    fPicture: TSQLRawBlob;
+    fKeyWords: RawUTF8;
+  published
+    property Name: RawUTF8 read fName write fName;
+    property Created: TTimeLog read fCreated write fCreated;
+    property Modified: TTimeLog read fModified write fModified;
+    property Picture: TSQLRawBlob read fPicture write fPicture;
+    property KeyWords: RawUTF8 read fKeyWords write fKeyWords;
+    property SignatureTime;
+    property Signature;
+  end;
+
+  /// an uncrypted Memo table
+  // - will contain some text
+  TSQLMemo = class(TSQLFile)
+  public
+    fContent: RawUTF8;
+  published
+    property Content: RawUTF8 read fContent write fContent;
+  end;
+
+  /// an uncrypted Data table
+  // - can contain any binary file content
+  // - is also used a parent for all cyphered tables (since the
+  // content is crypted, it should be binary, i.e. a BLOB field)
+  TSQLData = class(TSQLFile)
+  public
+    fData: TSQLRawBlob;
+  published
+    property Data: TSQLRawBlob read fData write fData;
+  end;
+
+  /// a crypted SafeMemo table
+  // - will contain some text after AES-256 cypher
+  // - just a direct sub class ot TSQLData to create the "SafeMemo" table
+  // with the exact same fields as the "Data" table
+  TSQLSafeMemo = class(TSQLData);
+
+  /// a crypted SafeData table
+  // - will contain some binary file content after AES-256 cypher
+  // - just a direct sub class ot TSQLData to create the "SafeData" table
+  // with the exact same fields as the "Data" table
+  TSQLSafeData = class(TSQLData);
+
+  /// an AuditTrail table, used to track events and status
+  TSQLAuditTrail = class(TSQLRecord)
+  protected
+    fStatusMessage: RawUTF8;
+    fStatus: TFileEvent;
+    fAssociatedRecord: TRecordReference;
+    fTime: TTimeLog;
+  published
+    property Time: TTimeLog read fTime write fTime;
+    property Status: TFileEvent read fStatus write fStatus;
+    property StatusMessage: RawUTF8 read fStatusMessage write fStatusMessage;
+    property AssociatedRecord: TRecordReference read fAssociatedRecord write fAssociatedRecord;
+  end;
+
+  /// the type of custom main User Interface description of SynFile
+  TFileRibbonTabParameters = object(TSQLRibbonTabParameters)
+    /// the SynFile actions
+    Actions: TFileActions;
+  end;
+
+const
+  /// will define the first User Interface ribbon group, i.e. main tables
+  GROUP_MAIN = 0;
+  /// will define the 2nd User Interface ribbon group, i.e. uncrypted tables
+  GROUP_CLEAR = 1;
+  /// will define the 3d User Interface ribbon group, i.e. crypted tables
+  GROUP_SAFE = 2;
+  /// some default actions, available for all tables
+  DEF_ACTIONS = [faMark..faPrintPreview,faSettings];
+  /// actions available for data tables (not for TSQLAuditTrail)
+  DEF_ACTIONS_DATA = DEF_ACTIONS+[faExtract]-[faImport,faExport];
+  /// default fields available for User Interface Grid
+  DEF_SELECT = 'Name,Created,Modified,KeyWords,SignatureTime';
+  /// the TCP/IP port used for the HTTP server
+  // - this is shared as constant by both client and server side
+  // - in a production application, should be made customizable
+  SERVER_HTTP_PORT = '888';
+
+const
+  /// this constant will define most of the User Interface property
+  // - the framework will create most User Interface content from the
+  // values stored within
+  FileTabs: array[0..4] of TFileRibbonTabParameters = (
+    (Table: TSQLAuditTrail;
+     Select: 'Time,Status,StatusMessage'; Group: GROUP_MAIN;
+     FieldWidth: 'gIZ'; ShowID: true; ReverseOrder: true; Layout: llClient;
+     Actions: [faDelete,faMark,faUnmarkAll,faQuery,faRefresh,faPrintPreview,faSettings]),
+    (Table: TSQLMemo;
+     Select: DEF_SELECT; Group: GROUP_CLEAR; FieldWidth: 'IddId'; Actions: DEF_ACTIONS),
+    (Table: TSQLData;
+     Select: DEF_SELECT; Group: GROUP_CLEAR; FieldWidth: 'IddId'; Actions: DEF_ACTIONS_DATA),
+    (Table: TSQLSafeMemo;
+     Select: DEF_SELECT; Group: GROUP_SAFE; FieldWidth: 'IddId';  Actions: DEF_ACTIONS),
+    (Table: TSQLSafeData;
+     Select: DEF_SELECT; Group: GROUP_SAFE; FieldWidth: 'IddId';  Actions: DEF_ACTIONS_DATA)
+  );
+  /// used to map which actions/buttons must be grouped in the toolbar
+  FileActionsToolbar: array[0..3] of TFileActions =
+    ( [faRefresh,faCreate,faEdit,faCopy,faExtract], [faExport..faPrintPreview],
+      [faMark..faQuery], [faSettings] );
+  /// FileActionsToolbar[FileActionsToolbar_MARKINDEX] will be the marked actions
+  // i.e. [faMark..faQuery]
+  FileActionsToolbar_MARKINDEX = 2;
+
+resourcestring
+  sFileTabsGroup = 'Main,Clear,Safe';
+  sFileActionsToolbar = '%%,Record Managment,Select,Settings';
+  sFileActionsHints =
+  'Mark rows'#13+   { faMark }
+  'UnMark all rows'#13+   { faUnmarkAll }
+  'Perform a custom query on the list and mark resulting rows'#13+   { faQuery }
+  'Refresh the current list from the database'#13+   { faRefresh }
+  'Create a new empty %s'#13+   { faCreate }
+  'Edit this %s'#13+   { faEdit }
+  'Create a new %s, with the same initial values as in the current selected record'#13+   { faCopy }
+  'Export one or more %s records report'#13+   { faExport }
+  'Import one or multiple files as %s records'#13+   { faImport }
+  'Delete the selected %s records'#13+   { faDelete }
+  'Digitally sign the selected %s'#13+   { faSign }
+  'Print one or more %s Reports'#13+   { faPrintPreview }
+  'Extract the embedded file into any folder'#13+  { faExtract }
+  'Change the Program''s settings';   { faSettings }
+
+/// create the database model to be used
+// - shared by both client and server sides
+function CreateFileModel(Owner: TSQLRest): TSQLModel;
+
+
+implementation
+
+function CreateFileModel(Owner: TSQLRest): TSQLModel;
+begin
+  result := TSQLModel.Create(Owner,
+    @FileTabs,length(FileTabs),sizeof(FileTabs[0]),[],
+    TypeInfo(TFileAction),TypeInfo(TFileEvent));
+end;
+
+initialization
+  SetExecutableVersion('3.1');
+end.

contrib/mORMot/SQLite3/Samples/MainDemo/SynFile.dpr

@@ -0,0 +1,22 @@
+program SynFile;
+
+{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
+
+//   first line of uses clause must be   {$I SynDprUses.inc}
+uses
+  {$I SynDprUses.inc}
+  Forms,
+  FileTables in 'FileTables.pas',
+  FileMain in 'FileMain.pas' {MainForm},
+  FileClient in 'FileClient.pas',
+  FileEdit in 'FileEdit.pas' {EditForm};
+
+{$R *.res}
+{$R Vista.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TMainForm, MainForm);
+  Application.CreateForm(TEditForm, EditForm);
+  Application.Run;
+end.