program CRov; //Crash recovery extension for Simba by Nielsie95 //http://villavu.com/forum/showthread.php?p=740535 const Version = '0.6'; SettingsMenuDef = 'False'; //True if you want to be able to set the saving interval through the menu (otherwise it's accessible through plugin settings) ForceSaveDef = 'True'; //Force user to save the script, instead of opening it SaveOnRunDef = 'True'; //Make backup when user compiles/runs the script DirDef = 'CRov\'; //Appended to AppPath ExtensionDef = 'crov'; DefInterval = '300000'; //every 5 minutes type TCharArray = array of Char; function _DeleteFile(lpFileName: TCharArray{PChar}): Boolean; external 'DeleteFileA@kernel32.dll stdcall'; var Simba_Menu: TMenuItem; Timer: TTimer; PageControl: TPageControl; Tab: Integer; FileNames: TStringList; SettingsMenu, ForceSave, SaveOnRun: Boolean; Dir, Extension: string; function StringToCharArray(s: string): TCharArray; var i, l: Integer; begin l := Length(s); SetLength(Result, l + 1); for i := l downto 1 do Result[i - 1] := s[i]; Result[l] := #0; end; function DeleteFile(FileName: string): Boolean; begin Result := _DeleteFile(StringToCharArray(FileName)); end; function FindPageControlWithName(c: TWinControl; Name: string): TPageControl; var i: Integer; begin Result := nil; if (c = nil) then Exit; Name := LowerCase(Name); for i := 0 to c.ControlCount - 1 do if (c.Controls[i] is TPageControl) and (LowerCase(c.Controls[i].Name) = Name) then begin Result := TPageControl(c.Controls[i]); Exit; end else if (c.Controls[i] is TWinControl) then begin Result := FindPageControlWithName(TWinControl(c.Controls[i]), Name); if (Result <> nil) then Exit; end; end; function LastChar(s: string): Char; begin if (Length(s) < 1) then Result := #0 else Result := s[Length(s)]; end; function MyTime: string; var Hour, Mins, Sec, MSec: Word; Year, Month, Day: Word; begin DecodeTime(Now, Hour, Mins, Sec, MSec); DecodeDate(Date, Year, Month, Day); Result := PadZ(IntToStr(Day), 2)+PadZ(IntToStr(Month), 2)+PadZ(IntToStr(Year mod 100), 2)+ '_'+ Padz(IntToStr(Hour), 2)+PadZ(IntToStr(Mins), 2); end; function GetFileInfo(Tab: Integer; out LastFileName, LastScript: string): Boolean; var i: Integer; v: string; begin Result := False; i := FileNames.IndexOfName(IntToStr(Tab)); if (i < 0) then Exit; v := FileNames.Values[IntToStr(Tab)]; LastFileName := Trim(Copy(v, 1, 255)); LastScript := Copy(v, 256, Length(v) - 255); Result := True; end; procedure SetFileInfo(Tab: Integer; FileName, Script: string); begin FileNames.Values[IntToStr(Tab)] := PadL(FileName, 255)+Script; end; procedure SplitRecoverInfo(Input: string; out FileName, Date, Time: string); var i: Integer; s: TStringArray; begin FileName := ''; Date := ''; Time := ''; s := Explode('_', Input); if (Length(s) < 2) then Exit else begin Time := s[High(s)]; Insert(':', Time, 3); Date := s[High(s) - 1]; //Insert('''', Date, 5); Insert('/', Date, 5); Insert('/', Date, 3); for i := 0 to High(s) - 2 do begin if (i > 0) then FileName := FileName + '_'; FileName := FileName + s[i]; end; end; end; procedure SetInterval(Sender: TObject); var i, intv: Integer; begin intv := Max(TMenuItem(Sender).Tag * 1000, 10000); Settings.SetKeyValue('Interval', IntToStr(intv)); Timer.Interval := intv; for i := 0 to Simba_Menu.Count - 1 do Simba_Menu.Items[i].Checked := False; TMenuItem(Sender).Checked := True; end; procedure ClearFiles(Sender: TObject); var i, t: Integer; begin if (MessageDlg('CRov Extension (by Nielsie95)', 'This will erase all recovered files. Are you sure you want to continue?', mtConfirmation, [mbYes, mbNo], 0 ) <> mrYes) then Exit; for i := Simba_Menu.Count - 1 downto 0 do begin t := Simba_Menu.Items[0].Tag; if (t = 1) and FileExists(Simba_Menu.Items[0].Hint) then DeleteFile(Simba_Menu.Items[0].Hint); Simba_Menu.Delete(0); if (t >= 3) then Break; end; Simba_Menu.Visible := Simba_Menu.Count > 0; end; procedure TabChanged(Sender: TObject); begin Tab := Pointer(TPageControl(Sender).ActivePage); Timer.Enabled := False; Timer.Enabled := True; //Reset timer end; procedure OnTimer(Sender: TObject); var s: TStringList; LastScript, LastFile, Script, Title: string; begin TTimer(Sender).Enabled := False; if (TTimer(Sender).Tag = 1) then begin TTimer(Sender).Tag := 0; PageControl := FindPageControlWithName(Simba, 'PageControl1'); if (PageControl <> nil) then PageControl.OnPageChanged := @TabChanged else WriteLn('CRov: PageControl not found!'); TTimer(Sender).Interval := StrToIntDef(Settings.GetKeyValueDef('Interval', DefInterval), 30000); end; try Title := MyTime; Script := ScriptText; if (PageControl <> nil) then if (LastChar(PageControl.ActivePage.Caption) = '*') then Title := Replace(PageControl.ActivePage.Caption, '*', '', [rfReplaceAll])+'_'+Title else begin //File saved/not modified, delete recovery file if GetFileInfo(Tab, LastFile, LastScript) and (LastFile <> '') and (FileExists(LastFile)) then DeleteFile(LastFile); Exit; end; if GetFileInfo(Tab, LastFile, LastScript) and (LastScript = Script) then Exit; if (LastFile <> '') and (FileExists(LastFile)) then DeleteFile(LastFile); Title := Title+'.'+Extension; s := TStringList.Create; try s.Text := Script; s.SaveToFile(Dir+Title); SetFileInfo(Tab, Dir+Title, Script); finally s.Free; end; finally TTimer(Sender).Enabled := True; end; end; procedure OnRecover(Sender: TObject); var a, b, c: string; s: TStringList; begin a := TMenuItem(Sender).Hint; Delete(a, Length(a) - Length('.'+Extension) + 1, Length('.'+Extension)); SplitRecoverInfo(a, a, b, c); if (not ForceSave) then begin s := TStringList.Create; try s.LoadFromFile(TMenuItem(Sender).Hint); OpenScript(a, s.Text); finally s.Free; end; end else with TSaveDialog.Create(Simba) do begin Title := 'Simba - Save Recovered File'; InitialDir := AppPath; Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.sex|Any files|*.*'; DefaultExt := 'simba'; FileName := a; Options := Options + [ofOverwritePrompt]; if Execute then begin s := TStringList.Create; try s.LoadFromFile(TMenuItem(Sender).Hint); s.SaveToFile(FileName); finally s.Free; end; end; end; end; procedure onScriptStart(var Script: string; var Cont: Boolean); begin if SaveOnRun then OnTimer(Timer); Cont := True; end; procedure onScriptCompile(var Cont: Boolean); begin if SaveOnRun then OnTimer(Timer); Cont := True; end; procedure Init; var i: Integer; f: TStringArray; a, b, c: string; Item: TMenuItem; begin SettingsMenu := LowerCase(Settings.GetKeyValueDef('SettingsInMenu', SettingsMenuDef)) = 'true'; ForceSave := LowerCase(Settings.GetKeyValueDef('ForceSave', ForceSaveDef)) = 'true'; SaveOnRun := LowerCase(Settings.GetKeyValueDef('SaveOnRun', SaveOnRunDef)) = 'true'; Dir := Settings.GetKeyValueDef('Directory', AppPath+DirDef); Extension := Settings.GetKeyValueDef('Extension', ExtensionDef); Simba_Menu := TMenuItem.Create(Simba_MainMenu); Simba_Menu.Caption := 'Recover'; Simba_MainMenu.Items.Items[0].Insert(4, Simba_Menu); Timer := TTimer.Create(Simba); Timer.Interval := 2000; Timer.OnTimer := @OnTimer; Timer.Enabled := True; Timer.Tag := 1; FileNames := TStringList.Create; if DirectoryExists(Dir) then begin f := GetFiles(Dir, Extension); for i := 0 to High(f) do begin Item := TMenuItem.Create(Simba_Menu); Item.Hint := Dir+f[i]; Item.Tag := 1; Item.OnClick := @OnRecover; Delete(f[i], Length(f[i]) - Length('.'+Extension) + 1, Length('.'+Extension)); SplitRecoverInfo(f[i], a, b, c); if (a = '') then a := '*UNTITLED*'; Item.Caption := a + ' (at '+c+' '+b+')'; Simba_Menu.Add(Item); end; end else if (not CreateDirectory(Dir)) then begin WriteLn('CRov: Unknown directory! Falling back to Simba folder..'); Dir := AppPath; end; if (Length(f) > 0) then begin Item := TMenuItem.Create(Simba_Menu); Item.Caption := 'Clear'; Item.Tag := 2; Item.OnClick := @ClearFiles; Simba_Menu.Add(Item); a := 'Simba did not close correctly. There '; if (Length(f) = 1) then a := a + 'is 1 file' else a := a + 'are ' + IntToStr(Length(f)) + ' files'; a := a + ' found for recovery. You can find the files through the ' + '"File>Recover" menu. If you do not wish to recover or if you are done ' + 'recovering, please clear the list through the menu.'; MessageDlg('CRov Extension (by Nielsie95)', a, mtInformation, [mbOK], 0); end; if SettingsMenu then begin if (Length(f) > 0) then begin Item := TMenuItem.Create(Simba_Menu); Item.Caption := '-'; Item.Tag := 3; Simba_Menu.Add(Item); end; Item := TMenuItem.Create(Simba_Menu); Item.Caption := 'Backup every 30s'; Item.Tag := 30; Item.Checked := Settings.GetKeyValueDef('Interval', DefInterval) = '30000'; Item.OnClick := @SetInterval; Simba_Menu.Add(Item); Item := TMenuItem.Create(Simba_Menu); Item.Caption := 'Backup every 5m'; Item.Tag := 5 * 60; Item.Checked := Settings.GetKeyValueDef('Interval', DefInterval) = '300000'; Item.OnClick := @SetInterval; Simba_Menu.Add(Item); Item := TMenuItem.Create(Simba_Menu); Item.Caption := 'Backup every 20m'; Item.Tag := 20 * 60; Item.Checked := Settings.GetKeyValueDef('Interval', DefInterval) = '1200000'; Item.OnClick := @SetInterval; Simba_Menu.Add(Item); end; Simba_Menu.Visible := Simba_Menu.Count > 0; end; procedure Free; var i: Integer; a, b: string; begin Timer.Enabled := False; try for i := 0 to FileNames.Count - 1 do begin if (not GetFileInfo(StrToIntDef(FileNames.Names[i], -1), a, b)) then Continue; if (a <> '') and FileExists(a) then DeleteFile(a); end; finally FileNames.Free; end; end; procedure Attach; begin Simba_Menu.Visible := Simba_Menu.Count > 0; Timer.Enabled := True; end; Procedure Detach; begin Timer.Enabled := False; Simba_Menu.Visible := False; end; function GetName: string; begin Result := 'Crash Recovery (by Nielsie95)'; end; function GetVersion: string; begin Result := Version; end; begin end.