Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
unit sysrestore;
{
system restore access unit - provides access to the system restore
function of Windows in order to set/cancel a restore point.
Created using Delphi 3.0 by Glenn9999 at tektips.com
}
interface
uses windows;
const
{ restore point types }
APPLICATION_INSTALL = 0;
APPLICATION_UNINSTALL = 1;
DEVICE_DRIVER_INSTALL = 10;
MODIFY_SETTINGS = 12;
CANCELLED_OPERATION = 13;
{ event types }
BEGIN_SYSTEM_CHANGE = 100;
END_SYSTEM_CHANGE = 101;
{ other stuff }
MAX_DESC = 256;
type
int64 = comp; { comment this if you are on a Delphi that supports int64 }
restoreptinfo = record
dwEventType: DWord;
dwRestorePtType: DWord;
llSequenceNumber: int64;
szDescription: array[0..max_desc] of widechar;
end;
prestoreptinfo = ^restoreptinfo;
statemgrstatus = record
nStatus: DWord;
llSequenceNumber: int64;
end;
pstatemgrstatus = ^statemgrstatus;
set_func = function(restptinfo: prestoreptinfo;
status: pstatemgrstatus): boolean; stdcall;
remove_func = function(dwRPNum: DWord): DWord; stdcall;
var
DLLHandle: THandle;
set_restore: set_func;
remove_restore: remove_func;
function begin_restore(var seqnum: int64; instr: widestring): integer;
function end_restore(seqnum: int64): integer;
function cancel_restore(seqnum: int64): integer;
function error_report(inerr: integer): string;
implementation
uses sysutils, dialogs;
function begin_restore(var seqnum: int64; instr: widestring): integer;
{ starts a restore point }
var
r_point: restoreptinfo;
smgr: statemgrstatus;
fret: boolean;
retval: integer;
begin
retval := 0;
r_point.dwEventType := BEGIN_SYSTEM_CHANGE;
r_point.dwRestorePtType := APPLICATION_INSTALL;
move(instr[1], r_point.szDescription, max_desc);
r_point.llSequenceNumber := 0;
fret := set_restore(@r_point, @smgr);
if fret = false then
retval := smgr.nStatus;
seqnum := smgr.llSequenceNumber;
begin_restore := retval;
end;
function end_restore(seqnum: int64): integer;
{ ends restore point }
var
r_point: restoreptinfo;
smgr: statemgrstatus;
fret: boolean;
retval: integer;
begin
retval := 0;
r_point.dwEventType := END_SYSTEM_CHANGE;
r_point.llSequenceNumber := seqnum;
fret := set_restore(@r_point, @smgr);
if fret = false then
retval := smgr.nStatus;
end_restore := retval;
end;
function cancel_restore(seqnum: int64): integer;
{ cancels restore point in progress}
var
r_point: restoreptinfo;
smgr: statemgrstatus;
retval: integer;
fret: boolean;
begin
retval := 0;
r_point.dwEventType := END_SYSTEM_CHANGE;
r_point.dwRestorePtType := CANCELLED_OPERATION;
r_point.llSequenceNumber := seqnum;
fret := set_restore(@r_point, @smgr);
if fret = false then
retval := smgr.nStatus;
cancel_restore := retval;
end;
function error_report(inerr: integer): string;
{ error reporting, takes error, returns string }
const
SERROR_SUCCESS = 'Call Successful.';
SERROR_BAD_ENVIRONMENT = 'The function was called in safe mode.';
SERROR_DISK_FULL = 'System Restore is in Standby Mode because disk space is low.';
SERROR_FILE_EXISTS = 'Pending file rename operations exist.';
SERROR_INTERNAL_ERROR = 'An internal error occurred.';
SERROR_INVALID_DATA = 'The sequence number is invalid.';
SERROR_SERVICE_DISABLED = 'System Restore is disabled.';
SERROR_TIMEOUT = 'The call timed out.';
begin
case inerr of
ERROR_SUCCESS: error_report := SERROR_SUCCESS;
ERROR_BAD_ENVIRONMENT: error_report := SERROR_BAD_ENVIRONMENT;
ERROR_DISK_FULL: error_report := SERROR_DISK_FULL;
ERROR_FILE_EXISTS: error_report := SERROR_FILE_EXISTS;
ERROR_INTERNAL_ERROR: error_report := SERROR_INTERNAL_ERROR;
ERROR_INVALID_DATA: error_report := SERROR_INVALID_DATA;
ERROR_SERVICE_DISABLED: error_report := SERROR_SERVICE_DISABLED;
ERROR_TIMEOUT: error_report := SERROR_TIMEOUT;
else
error_report := IntToStr(inerr);
end;
end;
initialization
{ find library functions and enable them }
DLLHandle := LoadLibraryW('SRCLIENT.DLL');
if DLLHandle <> 0 then
begin
@set_restore := GetProcAddress(DLLHandle, 'SRSetRestorePointW');
if @set_restore = nil then
begin
messagedlg('Did not find SRSetRestorePointW', mtWarning, [mbOK], 0);
halt(1);
end;
@remove_restore := GetProcAddress(DLLHandle, 'SRRemoveRestorePoint');
if @remove_restore = nil then
begin
messagedlg('Did not find SRRemoveRestorePoint', mtWarning, [mbOK], 0);
halt(1);
end;
end
else
begin
messagedlg('System Restore Interface Not Present.', mtWarning, [mbOK], 0);
halt(1);
end;
finalization
{ release library }
FreeLibrary(DLLHandle);
end.
unit srtool;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, sysrestore;
type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
{ demonstration of making a system restore session }
var
seqnum: int64;
retval: integer;
testfile: TextFile;
i: integer;
inputstring: string;
begin
InputString:= InputBox('Input Box',
'Prompt', 'Test System Restore Session');
seqnum := 0;
retval := begin_restore(seqnum, WideString(inputstring));
if retval = 0 then
label1.caption := 'System Restore Entry Set: ' + IntToStr(trunc(seqnum))
else
label1.caption := 'Error Str1: ' + error_report(retval);
{ do stuff here we want to back out }
AssignFile(testfile, 'TEST.DLL');
rewrite(testfile);
for i := 1 to 500000 do
begin
writeln(testfile, i);
application.processmessages;
end;
closeFile(testfile);
{ end do stuff here we want to back out of }
label1.caption := 'Finished.';
retval := end_restore(seqnum);
if retval <> 0 then
label1.caption := 'Error Str2: ' + error_report(retval);
end;
procedure TForm1.Button2Click(Sender: TObject);
{ clear system restore }
var
inresult: DWord;
i: integer;
seqnum: int64;
topnum: integer;
begin
label1.caption := 'Please wait, cleaning system restore.';
application.processmessages;
{ get last sequence number }
begin_restore(seqnum, 'Test');
cancel_restore(seqnum);
topnum := trunc(seqnum) - 1;
inresult := 0;
i := topnum;
while inresult = 0 do
begin
inresult := remove_restore(i);
dec(i);
end;
label1.caption := 'Now Done.';
end;
end.