Using System Restore

[Glenn9999]

This is intended to describe how to use the System Restore facility that exists in Windows XP in your Delphi program. Of course, this can be useful to find out how to use it for other languages.

System restore enables the user to revert the computer to a previous state before that change is made. You will see it done commonly with install programs, but can also be done with any kind of code or registry change made to a system. Sample code, including a unit and a main program will be shown.

Using System Restore requires that the SRCLIENT.DLL be present on the system. The general recommendation is to load the functions dynamically, so you will see that in the initialization of the unit. There are two functions that interest us:

1) 'SRSetRestorePointW' (also an A version for ANSI, W is Unicode)

2) 'SRRemoveRestorePoint'

The first does everything we want in the creation of a restore point. The second removes restore points.

In the creation of a restore point, a call is made to start the restore point, then the program does what is restorable, then a call to end the point is made. There is also the option to cancel a restore point. Calls for all three options exist in the unit below, along with the remove restore point call. Specific code examples can be gleaned from it. Also, a error string routine is provided for documentation purposes.

When a restore point is made, an index number is created. This index number is provided in the function call of the unit. This number is required to make any subsequent references to the restore point.

Sample code is provided below to handle the unit calls. Button1 creates a restore point session where a test file is written. Button2 will delete all system restore points.

To test the restore point function (Button1):

1) Run the program and use the Button1 option. You will see a text file named TEST.DLL file created.

2) Go into the System Restore Utility, select to restore using the point name created.

3) once the reboot is completed, you should not find the TEST.DLL file anymore.

Unit Code:

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 Turbo Delphi 2006 by Glenn9999 at msfn.org
    }

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 = packed record
      dwEventType: DWord;
      dwRestorePtType: DWord;
      llSequenceNumber: int64;
      szDescription: array[0..max_desc] of widechar;
    end;
    prestoreptinfo = ^restoreptinfo;
    statemgrstatus = packed 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): DWord;
  function end_restore(seqnum: int64): DWord;
  function cancel_restore(seqnum: int64): integer;
  function error_report(inerr: integer): string;

  implementation
     uses sysutils, dialogs;

  function begin_restore(var seqnum: int64; instr: widestring): DWord;
    { starts a restore point }
    var
      r_point: restoreptinfo;
      smgr: statemgrstatus;
      fret: boolean;
      retval: integer;
    begin
      retval := 0;
      fillchar(r_point, sizeof(r_point), 0);
      fillchar(smgr, sizeof(smgr), 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): DWord;
    { ends restore point }
    var
      r_point: restoreptinfo;
      smgr: statemgrstatus;
      fret: boolean;
      retval: integer;
    begin
      retval := 0;
      fillchar(r_point, sizeof(r_point), 0);
      fillchar(smgr, sizeof(smgr), 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.

Sample code (use it in a form with two buttons and a label):

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);
    MessageDlg(label1.caption, mtInformation, [mbOK], 0);

    { 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);
    MessageDlg(label1.caption, mtInformation, [mbOK], 0);
 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.';
    MessageDlg(label1.caption, mtInformation, [mbOK], 0);
  end;
end.

I can dig up the actual files and throw 'em into a ZIP if people need them, but I don't have them handy right now.

Edited February 13, 2009 by Glenn9999

[gunsmokingman]

Thank you for posting this code. If you could zip up any of the files needed for this, and post them.

Gsm

[Glenn9999]

Thank you for posting this code. If you could zip up any of the files needed for this, and post them.

Gsm

I redid the code a bit to show what is going on a little more at each step, and recompiled it within Turbo Delphi 2006. Files in the link below.

http://rsgp0g.bay.livefilestore.com/y1pDdy...ls.zip?download

[gunsmokingman]

Thank you