1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-24 16:28:53 -05:00
Simba/Extensions/CRov.sex
2010-12-25 04:19:39 -05:00

445 lines
11 KiB
Plaintext

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, False);
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.