/// 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.