Simba/Extensions/CRov.sex

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.