INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

How To

How do I use System Restore in my program? by Glenn9999
Posted: 22 Apr 07

This is intended to describe how to use the System Restore facility that exists in Windows ME and XP in your Delphi program.  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:

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 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.

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

CODE

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.

Back to Embarcadero: Delphi FAQ Index
Back to Embarcadero: Delphi Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close