From 76086a6618d0a84246a6fd38984452371becced6 Mon Sep 17 00:00:00 2001 From: Olly Date: Sat, 22 Jul 2023 02:31:07 +0100 Subject: [PATCH] Backups refactor --- Source/Simba.lpi | 9 +- Source/Simba.lpr | 30 +--- Source/forms/simba.backupsform.lfm | 41 +++++ Source/forms/simba.backupsform.pas | 168 +++++++++++++++++++ Source/forms/simba.main.lfm | 8 +- Source/forms/simba.main.pas | 13 +- Source/package/simba.package_autoupdater.pas | 27 +-- Source/simba.files.pas | 132 ++++++++++++--- Source/simba.mufasatypes.pas | 2 + Source/simba.scriptbackup.pas | 102 ++++------- Source/simba.settings.pas | 2 +- Source/simba.zip.pas | 89 ---------- 12 files changed, 386 insertions(+), 237 deletions(-) create mode 100644 Source/forms/simba.backupsform.lfm create mode 100644 Source/forms/simba.backupsform.pas diff --git a/Source/Simba.lpi b/Source/Simba.lpi index dcb8b9469..cb764dfe5 100644 --- a/Source/Simba.lpi +++ b/Source/Simba.lpi @@ -326,7 +326,7 @@ - + @@ -934,6 +934,13 @@ + + + + + + + diff --git a/Source/Simba.lpr b/Source/Simba.lpr index 7b19cf1ff..48a8847d5 100644 --- a/Source/Simba.lpr +++ b/Source/Simba.lpr @@ -10,24 +10,15 @@ uses simba.init, - classes, sysutils, interfaces, forms, lazlogger, - simba.settings, simba.main, simba.aboutform, simba.debugimageform, - simba.bitmaptostringform, simba.functionlistform, simba.scripttabsform, - simba.outputform, simba.colorpickerhistoryform, simba.filebrowserform, - simba.notesform, simba.settingsform, simba.associate, simba.openexampleform, - simba.scriptthread, simba.package_form, simba.mufasatypes, simba.shapeboxform, + Classes, SysUtils, Interfaces, Forms, LazLogger, + simba.mufasatypes, simba.main, + simba.aboutform, simba.debugimageform, simba.bitmaptostringform, + simba.functionlistform, simba.scripttabsform, simba.outputform, + simba.colorpickerhistoryform, simba.filebrowserform, simba.notesform, + simba.settingsform, simba.associate, simba.openexampleform, + simba.package_form, simba.shapeboxform, simba.backupsform, simba.compiler_dump, simba.plugin_dump, - simba.ide_analytics, simba.ide_codetools_setup, simba.ide_codetools_insight; - -type - TApplicationHelper = class helper for TApplication - procedure DebugLnSilent(Sender: TObject; S: string; var Handled: Boolean); - end; - -procedure TApplicationHelper.DebugLnSilent(Sender: TObject; S: string; var Handled: Boolean); -begin - Handled := True; -end; + simba.scriptthread; begin {$IF DECLARED(SetHeapTraceOutput)} @@ -83,10 +74,6 @@ procedure TApplicationHelper.DebugLnSilent(Sender: TObject; S: string; var Handl Halt(); end; - //DebugLogger.CloseLogFileBetweenWrites := True; - //if Application.HasOption('silent') then - // DebugLogger.OnDebugLn := @Application.DebugLnSilent; - if (not Application.HasOption('open')) and (Application.HasOption('run') or Application.HasOption('compile')) then begin if not FileExists(Application.Params[Application.ParamCount]) then @@ -126,6 +113,7 @@ procedure TApplicationHelper.DebugLnSilent(Sender: TObject; S: string; var Handl Application.CreateForm(TSimbaColorPickerHistoryForm, SimbaColorPickerHistoryForm); Application.CreateForm(TSimbaPackageForm, SimbaPackageForm); Application.CreateForm(TSimbaShapeBoxForm, SimbaShapeBoxForm); + Application.CreateForm(TSimbaBackupsForm, SimbaBackupsForm); Application.QueueAsyncCall(@SimbaForm.Setup, 0); end; diff --git a/Source/forms/simba.backupsform.lfm b/Source/forms/simba.backupsform.lfm new file mode 100644 index 000000000..10464ae9f --- /dev/null +++ b/Source/forms/simba.backupsform.lfm @@ -0,0 +1,41 @@ +object SimbaBackupsForm: TSimbaBackupsForm + Left = 1333 + Height = 450 + Top = 543 + Width = 739 + Caption = 'SimbaBackupsForm' + ClientHeight = 450 + ClientWidth = 739 + DesignTimePPI = 120 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + ShowInTaskBar = stAlways + LCLVersion = '2.2.4.0' + object LeftPanel: TPanel + Left = 0 + Height = 450 + Top = 0 + Width = 213 + Align = alLeft + BevelOuter = bvNone + TabOrder = 0 + end + object Splitter: TSplitter + Left = 213 + Height = 450 + Top = 0 + Width = 6 + OnPaint = SplitterPaint + end + object RightPanel: TPanel + Left = 219 + Height = 450 + Top = 0 + Width = 520 + Align = alClient + BevelOuter = bvNone + Caption = '(no file selected)' + TabOrder = 2 + end +end diff --git a/Source/forms/simba.backupsform.pas b/Source/forms/simba.backupsform.pas new file mode 100644 index 000000000..d674f8bdf --- /dev/null +++ b/Source/forms/simba.backupsform.pas @@ -0,0 +1,168 @@ +{ + Author: Raymond van Venetië and Merlijn Wajer + Project: Simba (https://github.com/MerlijnWajer/Simba) + License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0) +} +unit simba.backupsform; + +{$i simba.inc} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, Zipper, + simba.editor, simba.component_treeview, simba.component_buttonpanel; + +type + TSimbaBackupsForm = class(TForm) + LeftPanel: TPanel; + RightPanel: TPanel; + Splitter: TSplitter; + ButtonPanel: TSimbaButtonPanel; + + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure SplitterPaint(Sender: TObject); + procedure DoSplitterEnterExit(Sender: TObject); + procedure DoTreeViewSelectionChanged(Sender: TObject); + procedure DoButtonOkClick(Sender: TObject); + procedure DoCreateStream(Sender : TObject; var AStream: TStream; AItem: TFullZipFileEntry); + procedure DoDoneStream(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); + procedure AddBackups; + private + TreeView: TSimbaTreeView; + Editor: TSimbaEditor; + CurrentNode: TTreeNode; + end; + +var + SimbaBackupsForm: TSimbaBackupsForm; + +implementation + +{$R *.lfm} + +uses + AnchorDocking, + simba.env, simba.files, simba.theme, simba.main, simba.scripttabsform; + +type + TBackupNode = class(TTreeNode) + public + Contents: String; + end; + +procedure TSimbaBackupsForm.FormShow(Sender: TObject); +begin + Splitter.Width := DockMaster.SplitterWidth; + TreeView.Clear(); + AddBackups(); +end; + +procedure TSimbaBackupsForm.SplitterPaint(Sender: TObject); +begin + with TSplitter(Sender) do + begin + Canvas.Brush.Color := SimbaTheme.ColorFrame; + Canvas.FillRect(ClientRect); + + if MouseInClient then + begin + Canvas.Brush.Color := SimbaTheme.ColorActive; + Canvas.FillRect(3, 3, Width-3, Height-3); + end; + end; +end; + +procedure TSimbaBackupsForm.DoSplitterEnterExit(Sender: TObject); +begin + TSplitter(Sender).Invalidate(); +end; + +procedure TSimbaBackupsForm.DoTreeViewSelectionChanged(Sender: TObject); +var + Node: TBackupNode; +begin + Node := TBackupNode(TreeView.Selected); + if (Node is TBackupNode) then + begin + Editor.Text := Node.Contents; + Editor.Visible := True; + end else + Editor.Visible := False; +end; + +procedure TSimbaBackupsForm.DoButtonOkClick(Sender: TObject); +begin + if Editor.Visible then + begin + SimbaScriptTabsForm.AddTab().Editor.Text := Editor.Text; + if (Sender is TTreeView) then + Close(); + end; +end; + +procedure TSimbaBackupsForm.DoCreateStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); +begin + AStream := TStringStream.Create(); +end; + +procedure TSimbaBackupsForm.DoDoneStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); +begin + with TreeView.AddNode(CurrentNode, FormatDateTime('c', AItem.DateTime), IMAGE_FILE) as TBackupNode do + Contents := TStringStream(AStream).DataString; + + AStream.Free(); +end; + +procedure TSimbaBackupsForm.AddBackups; +var + FileName: String; + UnZipper: TUnZipper; +begin + for FileName in TSimbaDir.DirSearch(SimbaEnv.BackupsPath, '*.zip') do + begin + CurrentNode := TreeView.AddNode(TSimbaPath.PathExtractNameWithoutExt(FileName), IMAGE_DIRECTORY); + + UnZipper := TUnZipper.Create(); + try + UnZipper.FileName := FileName; + UnZipper.Examine(); + UnZipper.OnCreateStream := @DoCreateStream; + UnZipper.OnDoneStream := @DoDoneStream; + UnZipper.UnZipAllFiles(); + except + end; + UnZipper.Free(); + end; +end; + +procedure TSimbaBackupsForm.FormCreate(Sender: TObject); +begin + Width := Scale96ToScreen(800); + Height := Scale96ToScreen(600); + + Editor := TSimbaEditor.Create(Self); + Editor.Parent := RightPanel; + Editor.Align := alClient; + Editor.Visible := False; + + TreeView := TSimbaTreeView.Create(Self, TBackupNode); + TreeView.Parent := LeftPanel; + TreeView.Align := alClient; + TreeView.OnSelectionChange := @DoTreeViewSelectionChanged; + TreeView.OnDoubleClick := @DoButtonOkClick; + + RightPanel.Color := SimbaTheme.ColorBackground; + RightPanel.Font.Color := SimbaTheme.ColorFont; + + ButtonPanel := TSimbaButtonPanel.Create(Self); + ButtonPanel.Parent := Self; + ButtonPanel.ButtonOk.OnClick := @DoButtonOkClick; + + Splitter.OnEnter := @DoSplitterEnterExit; + Splitter.OnExit := @DoSplitterEnterExit; +end; + +end. + diff --git a/Source/forms/simba.main.lfm b/Source/forms/simba.main.lfm index c517e240f..caa4fcb1a 100644 --- a/Source/forms/simba.main.lfm +++ b/Source/forms/simba.main.lfm @@ -1,7 +1,7 @@ object SimbaForm: TSimbaForm - Left = 4202 + Left = 1238 Height = 578 - Top = 175 + Top = 594 Width = 910 Caption = 'Simba' ClientHeight = 578 @@ -2689,6 +2689,10 @@ object SimbaForm: TSimbaForm Caption = 'Open Example ...' OnClick = MenuNewTemplateClick end + object MenuItemBackups: TMenuItem + Caption = 'Open Backup ...' + OnClick = MenuItemBackupsClick + end object MenuItem8: TMenuItem Caption = '-' end diff --git a/Source/forms/simba.main.pas b/Source/forms/simba.main.pas index 1ecb41e55..b595d6d20 100644 --- a/Source/forms/simba.main.pas +++ b/Source/forms/simba.main.pas @@ -64,6 +64,7 @@ TSimbaForm = class(TForm) MainMenuTools: TPopupMenu; MainMenuView: TPopupMenu; MainMenuHelp: TPopupMenu; + MenuItemBackups: TMenuItem; MenuItemShapeBox: TMenuItem; MenuItemDocumentation: TMenuItem; MenuItemGithub: TMenuItem; @@ -177,6 +178,7 @@ TSimbaForm = class(TForm) procedure MenuFileClick(Sender: TObject); procedure MenuFindClick(Sender: TObject); procedure MenuGotoClick(Sender: TObject); + procedure MenuItemBackupsClick(Sender: TObject); procedure MenuItemShapeBoxClick(Sender: TObject); procedure MenuItemAboutClick(Sender: TObject); procedure MenuItemACAClick(Sender: TObject); @@ -284,7 +286,8 @@ implementation simba.openssl, simba.env, simba.process, simba.dockinghelpers, simba.nativeinterface, - simba.scriptformatter, simba.windowhandle, simba.scripttab, simba.theme; + simba.scriptformatter, simba.windowhandle, simba.scripttab, simba.theme, + simba.backupsform; procedure TSimbaForm.HandleException(Sender: TObject; E: Exception); @@ -605,7 +608,6 @@ procedure TSimbaForm.Setup(Data: PtrInt); SimbaScriptTabsForm.AddTab(); SetupDocking(); - SetupCompleted(); FMouseLogger := TSimbaMouseLogger.Create(); FMouseLogger.Hotkey := VK_F1; @@ -640,6 +642,8 @@ procedure TSimbaForm.Setup(Data: PtrInt); if Assigned(SimbaScriptTabsForm.CurrentEditor) then if SimbaScriptTabsForm.CurrentEditor.CanSetFocus() then SimbaScriptTabsForm.CurrentEditor.SetFocus(); + + SetupCompleted(); end; procedure TSimbaForm.FormCreate(Sender: TObject); @@ -839,6 +843,11 @@ procedure TSimbaForm.MenuGotoClick(Sender: TObject); end; end; +procedure TSimbaForm.MenuItemBackupsClick(Sender: TObject); +begin + SimbaBackupsForm.ShowModal(); +end; + procedure TSimbaForm.MenuItemShapeBoxClick(Sender: TObject); begin SimbaShapeBoxForm.Show(); diff --git a/Source/package/simba.package_autoupdater.pas b/Source/package/simba.package_autoupdater.pas index f6bcecfce..2de82a36c 100644 --- a/Source/package/simba.package_autoupdater.pas +++ b/Source/package/simba.package_autoupdater.pas @@ -17,31 +17,8 @@ procedure UpdatePackages; implementation uses - Menus, - simba.mufasatypes, simba.package, simba.scripttabsform, simba.main, - simba.outputform, simba.package_installer, simba.package_menubuilder; - -type - TPackageMenuItem = class(TMenuItem) - public - Hash: UInt32; - end; - - TPackageMenuItem_File = class(TMenuItem) - public - FileName: String; - - procedure Click; override; - end; - -procedure TPackageMenuItem_File.Click; -begin - if (FileName = '') then - Exit; - - if SimbaScriptTabsForm.Open(FileName, True) and (Caption = 'Run') then - SimbaForm.MenuItemRun.Click(); -end; + simba.mufasatypes, simba.package, simba.package_installer, + simba.main, simba.outputform, simba.package_menubuilder; type TPackageUpdater = class(TThread) diff --git a/Source/simba.files.pas b/Source/simba.files.pas index 805d80d39..44eeb1db5 100644 --- a/Source/simba.files.pas +++ b/Source/simba.files.pas @@ -71,8 +71,8 @@ TSimbaPath = class TSimbaDir = class public - class function DirList(Path: String; Recursive: Boolean): TStringArray; - class function DirSearch(Path: String; Mask: String; Recursive: Boolean): TStringArray; + class function DirList(Path: String; Recursive: Boolean = False): TStringArray; + class function DirSearch(Path: String; Mask: String; Recursive: Boolean = False): TStringArray; class function DirDelete(Path: String; OnlyChildren: Boolean): Boolean; class function DirCreate(Path: String): Boolean; class function DirExists(Path: String): Boolean; @@ -87,10 +87,8 @@ TSimbaDir = class function ZipExtractOne(ZipFileName, FileName, OutputDir: String): Boolean; function ZipFiles(ZipFileName: String; Files: TStringArray): Boolean; function ZipEntries(ZipFileName: String): TStringArray; - - function ReadINI(const Section, KeyName: string; FileName: string): string; - procedure DeleteINI(const Section, KeyName : string; FileName : string); - procedure WriteINI(const Section, KeyName, NewString : string; FileName : string); + function ZipHasEntryCrc(ZipFileName: String; Crc32: UInt32): Boolean; + function ZipAppend(ZipFileName: String; FileName, FileContents: String): Boolean; function INIFileWrite(FileName: String; Section, Key, Value: String): Boolean; function INIFileRead(FileName: String; Section, Key, Value: String): String; @@ -108,7 +106,7 @@ implementation BaseUnix, {$ENDIF} FileUtil, LazFileUtils, Zipper, IniFiles, md5, sha1, - simba.encoding; + simba.encoding, DateUtils; class function TSimbaDir.DirList(Path: String; Recursive: Boolean): TStringArray; var @@ -602,36 +600,116 @@ function ZipEntries(ZipFileName: String): TStringArray; end; end; -function ReadINI(const Section, KeyName: string; FileName: string): string; +function ZipHasEntryCrc(ZipFileName: String; Crc32: UInt32): Boolean; +var + UnZipper: TUnZipper; + I: Integer; begin - with TINIFile.Create(ExpandFileName(FileName)) do - try - Result := ReadString(Section, KeyName, ''); - finally - Free(); + Result := False; + + if FileExists(ZipFileName) then + begin + UnZipper := TUnZipper.Create(); + try + UnZipper.FileName := ZipFileName; + UnZipper.Examine(); + + for I := 0 to UnZipper.Entries.Count - 1 do + if (UnZipper.Entries[I].CRC32 = Crc32) then + begin + Result := True; + Break; + end; + except + end; + UnZipper.Free(); end; end; -procedure DeleteINI(const Section, KeyName : string; FileName : string); +type + TZipAppender = class(TObject) + protected + FUnZip: TUnZipper; + FZip: TZipper; + + procedure DoCreateStream(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); + procedure DoDoneStream(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); + public + constructor Create(AFileName: String); + destructor Destroy; override; + + procedure Add(FileName, FileContents: String); + end; + +procedure TZipAppender.DoCreateStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); begin - with TIniFile.Create(ExpandFileName(FileName)) do - try - if (KeyName = '') then - EraseSection(Section) - else - DeleteKey(Section, KeyName); - finally - Free(); + AStream := TMemoryStream.Create(); +end; + +procedure TZipAppender.DoDoneStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); +begin + with FZip.Entries.Add() as TZipFileEntry do + begin + Assign(AItem); + + Stream := AStream; + Stream.Position := 0; + end; +end; + +constructor TZipAppender.Create(AFileName: String); +begin + inherited Create(); + + if FileExists(AFileName) then + begin + FUnZip := TUnZipper.Create(); + FUnZip.FileName := AFileName; + FUnZip.OnCreateStream := @DoCreateStream; + FUnZip.OnDoneStream := @DoDoneStream; end; + + FZip := TZipper.Create(); + FZip.FileName := AFileName; +end; + +destructor TZipAppender.Destroy; +begin + if Assigned(FUnZip) then + FreeAndNil(FUnZip); + if Assigned(FZip) then + FreeAndNil(FZip); + + inherited Destroy(); +end; + +procedure TZipAppender.Add(FileName, FileContents: String); +var + I: Integer; +begin + if Assigned(FUnZip) then + FUnZip.UnZipAllFiles(); + + FZip.Entries.AddFileEntry(TStringStream.Create(FileContents), IfThen(FileName = '', FZip.Entries.Count.ToString(), FileName)); + FZip.ZipAllFiles(); + + for I := 0 to FZip.Entries.Count - 1 do + if (FZip.Entries[I].Stream <> nil) then + begin + FZip.Entries[I].Stream.Free(); + FZip.Entries[I].Stream := nil; + end; end; -procedure WriteINI(const Section, KeyName, NewString : string; FileName : string); +function ZipAppend(ZipFileName: String; FileName, FileContents: String): Boolean; begin - with TINIFile.Create(ExpandFileName(FileName)) do + Result := True; + + with TZipAppender.Create(ZipFileName) do try - WriteString(Section, KeyName, NewString); + Add(FileName, FileContents); finally - Free(); + Free(); end; end; @@ -733,5 +811,7 @@ function INIFileSections(FileName: String): TStringArray; List.Free(); end; + + end. diff --git a/Source/simba.mufasatypes.pas b/Source/simba.mufasatypes.pas index a7f4c370d..bf7e53449 100644 --- a/Source/simba.mufasatypes.pas +++ b/Source/simba.mufasatypes.pas @@ -458,11 +458,13 @@ implementation procedure DebugLn(const Msg: String); begin DebugLogger.DebugLn(Msg); + Flush(Output); end; procedure DebugLn(const Msg: String; Args: array of const); begin DebugLogger.DebugLn(Msg, Args); + Flush(Output); end; procedure SimbaException(Message: String; Args: array of const); diff --git a/Source/simba.scriptbackup.pas b/Source/simba.scriptbackup.pas index 946b75a46..a22a96cec 100644 --- a/Source/simba.scriptbackup.pas +++ b/Source/simba.scriptbackup.pas @@ -13,9 +13,8 @@ interface uses - Classes, SysUtils, Forms, ExtCtrls, - simba.scripttabsform, simba.mufasatypes, simba.files, - simba.zip, simba.ide_initialization, simba.settings, simba.threading, simba.env; + Classes, SysUtils, ExtCtrls, + simba.mufasatypes, simba.settings; type TSimbaScriptBackup = class(TComponent) @@ -26,20 +25,20 @@ TSimbaScriptBackup = class(TComponent) Contents: String; end; + procedure DoSettingChanged_BackupEnabled(Setting: TSimbaSetting); + procedure DoSettingChanged_BackupInterval(Setting: TSimbaSetting); + procedure DoFileCollecting(Sender: TObject); procedure DoFileBackuping; - - procedure DoSimbaSettingChanged(Setting: TSimbaSetting); public constructor Create(AOwner: TComponent); override; - destructor Destroy; override; end; implementation uses - LazFileUtils, Zipper, - crc; + crc, + simba.files, simba.env, simba.ide_initialization, simba.scripttabsform; function Crc32String(const Str: String): UInt32; begin @@ -52,12 +51,15 @@ procedure TSimbaScriptBackup.DoFileCollecting(Sender: TObject); var I: Integer; begin - Assert(GetCurrentThreadID = MainThreadID); + AssertMainThread('TSimbaScriptBackup'); SetLength(FFiles, SimbaScriptTabsForm.TabCount); for I := 0 to SimbaScriptTabsForm.TabCount - 1 do begin FFiles[I].FileName := SimbaScriptTabsForm.Tabs[I].ScriptFileName; + if (FFiles[I].FileName = '') then + FFiles[I].FileName := 'Untitled'; + FFiles[I].Contents := SimbaScriptTabsForm.Tabs[I].Script; end; @@ -66,92 +68,52 @@ procedure TSimbaScriptBackup.DoFileCollecting(Sender: TObject); procedure TSimbaScriptBackup.DoFileBackuping; var - I, J: Integer; + I: Integer; ZipPath: String; - Duplicate: Boolean; begin for I := 0 to High(FFiles) do begin - if (FFiles[I].FileName = '') then + ZipPath := TSimbaPath.PathJoin([SimbaEnv.BackupsPath, TSimbaPath.PathExtractNameWithoutExt(FFiles[I].FileName) + '.zip']); + if ZipHasEntryCrc(ZipPath, Crc32String(FFiles[I].Contents)) then Continue; - Duplicate := False; - ZipPath := SimbaEnv.BackupsPath + ExtractFileNameOnly(FFiles[I].FileName) + '.zip'; - try - if FileExists(ZipPath) then - with TUnZipper.Create() do - try - FileName := ZipPath; - Examine(); - for J := 0 to Entries.Count - 1 do - if (Entries[J].CRC32 = Crc32String(FFiles[I].Contents)) then - begin - Duplicate := True; - Break; - end; - finally - Free(); - end; - - if Duplicate then - Continue; - - DebugLn('[TSimbaScriptBackup]: Making a backup of "%s"', [ExtractFileName(FFiles[I].FileName)]); - - with TSimbaZipUpdater.Create() do - try - AddFileContents(ZipPath, FFiles[I].Contents, FFiles[I].FileName); - finally - Free(); - end; - except - on E: Exception do - DebugLn('[TSimbaScriptBackup]: Backup "%s" failed: %s ', [ExtractFileName(FFiles[I].FileName), E.Message]); - end; + if ZipAppend(ZipPath, '', FFiles[I].Contents) then + DebugLn('[SimbaScriptBackup]: Backed up %s', [FFiles[I].FileName]) + else + DebugLn('[SimbaScriptBackup]: Failed to backup %s', [FFiles[I].FileName]); end; end; -procedure TSimbaScriptBackup.DoSimbaSettingChanged(Setting: TSimbaSetting); +procedure TSimbaScriptBackup.DoSettingChanged_BackupEnabled(Setting: TSimbaSetting); begin - if (Setting = SimbaSettings.ScriptBackup.Enabled) then - FTimer.Enabled := SimbaSettings.ScriptBackup.Enabled.Value - else - if (Setting = SimbaSettings.ScriptBackup.Interval) then - FTimer.Interval := SimbaSettings.ScriptBackup.Interval.Value * 60000; + FTimer.Enabled := SimbaSettings.ScriptBackup.Enabled.Value; end; -constructor TSimbaScriptBackup.Create(AOwner: TComponent); +procedure TSimbaScriptBackup.DoSettingChanged_BackupInterval(Setting: TSimbaSetting); begin - inherited Create(AOwner); - - FTimer := TTimer.Create(Self); - FTimer.OnTimer := @DoFileCollecting; FTimer.Interval := SimbaSettings.ScriptBackup.Interval.Value * 60000; - FTimer.Enabled := SimbaSettings.ScriptBackup.Enabled.Value; - - SimbaSettings.RegisterChangeHandler(@DoSimbaSettingChanged); end; -destructor TSimbaScriptBackup.Destroy; +constructor TSimbaScriptBackup.Create(AOwner: TComponent); begin - SimbaSettings.UnRegisterChangeHandler(@DoSimbaSettingChanged); + inherited Create(AOwner); + + FTimer := TTimer.Create(Self); + FTimer.OnTimer := @DoFileCollecting; - inherited Destroy(); + SimbaSettings.RegisterChangeHandler(Self, SimbaSettings.ScriptBackup.Enabled, @DoSettingChanged_BackupEnabled, True); + SimbaSettings.RegisterChangeHandler(Self, SimbaSettings.ScriptBackup.Interval, @DoSettingChanged_BackupInterval, True); end; procedure SetupScriptBackup; - - procedure Execute; - begin - TSimbaScriptBackup.Create(SimbaScriptTabsForm); - end; - begin - ExecuteOnMainThread(@Execute); // TTimer needs to be called on main thread + AssertMainThread('SetupScriptBackup'); + + TSimbaScriptBackup.Create(SimbaScriptTabsForm); end; initialization - SimbaIDEInitialization.RegisterMethodOnAfterCreate(@SetupScriptBackup, 'ScriptBackup'); + SimbaIDEInitialization.RegisterMethodOnCreated(@SetupScriptBackup, 'ScriptBackup'); end. diff --git a/Source/simba.settings.pas b/Source/simba.settings.pas index a3dc968ba..ae6d799a0 100644 --- a/Source/simba.settings.pas +++ b/Source/simba.settings.pas @@ -516,7 +516,7 @@ constructor TSimbaSettings.Create; OutputBox.ClearOnCompile := TSimbaSetting_Boolean.Create(Self, 'OutputBox', 'OutputClearOnCompile', False); ScriptBackup.Enabled := TSimbaSetting_Boolean.Create(Self, 'ScriptBackup', 'Enabled', True); - ScriptBackup.Interval := TSimbaSetting_Integer.Create(Self, 'ScriptBackup', 'Interval', 5); + ScriptBackup.Interval := TSimbaSetting_Integer.Create(Self, 'ScriptBackup', 'Interval', 3); end; destructor TSimbaSettings.Destroy; diff --git a/Source/simba.zip.pas b/Source/simba.zip.pas index 62c6fb2ab..4c7316bc9 100644 --- a/Source/simba.zip.pas +++ b/Source/simba.zip.pas @@ -45,24 +45,6 @@ TSimbaZipExtractor = class destructor Destroy; override; end; - TSimbaZipUpdater = class - protected - FUnZipper: TUnZipper; - FZipper: TZipper; - - procedure BeginUpdate(ZipFile: String); - procedure EndUpdate; - - procedure CreateStream(Sender: TObject; var AStream : TStream; AItem: TFullZipFileEntry); - procedure DoneStream(Sender: TObject; var AStream : TStream; AItem: TFullZipFileEntry); - public - constructor Create; - destructor Destroy; override; - - procedure AddFileContents(ZipFile, Contents, FileName: String); - procedure AddFile(ZipFile, FileName: String); - end; - implementation uses @@ -164,76 +146,5 @@ procedure TSimbaZipExtractor.DoCreateStream(Sender: TObject; var AStream: TStrea AStream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite); end; -constructor TSimbaZipUpdater.Create; -begin - inherited Create(); - - FUnZipper := TUnZipper.Create(); - FUnZipper.OnCreateStream := @CreateStream; - FUnZipper.OnDoneStream := @DoneStream; - - FZipper := TZipper.Create(); -end; - -destructor TSimbaZipUpdater.Destroy; -begin - if (FUnZipper <> nil) then - FreeAndNil(FUnZipper); - if (FZipper <> nil) then - FreeAndNil(FZipper); - - inherited Destroy(); -end; - -procedure TSimbaZipUpdater.AddFileContents(ZipFile, Contents, FileName: String); -begin - BeginUpdate(ZipFile); - FZipper.Entries.AddFileEntry(TStringStream.Create(Contents), ExtractFileName(FileName)); - EndUpdate(); -end; - -procedure TSimbaZipUpdater.AddFile(ZipFile, FileName: String); -begin - BeginUpdate(ZipFile); - FZipper.Entries.AddFileEntry(FileName, ExtractFileName(FileName)); - EndUpdate(); -end; - -procedure TSimbaZipUpdater.BeginUpdate(ZipFile: String); -begin - if FileExists(ZipFile) then - FUnZipper.UnZipAllFiles(ZipFile); - FZipper.FileName := ZipFile; -end; - -procedure TSimbaZipUpdater.EndUpdate; -var - I: Integer; - Stream: TStream; -begin - FZipper.ZipAllFiles(); - - for I := 0 to FZipper.Entries.Count - 1 do - begin - Stream := FZipper.Entries[I].Stream; - if (Stream <> nil) then - FreeAndNil(Stream); - - FZipper.Entries[I].Stream := nil; - end; -end; - -procedure TSimbaZipUpdater.CreateStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); -begin - AStream := TMemoryStream.Create(); -end; - -procedure TSimbaZipUpdater.DoneStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); -begin - AStream.Position := 0; - - FZipper.Entries.AddFileEntry(AStream, AItem.ArchiveFileName); -end; - end.