unit Unit1;
interface
uses
Windows,
Forms,
Classes,
SysUtils,
Controls,
StdCtrls;
const
// Type of Event
BEGIN_SYSTEM_CHANGE = 100;
END_SYSTEM_CHANGE = 101;
// Type of Restore Points
APPLICATION_INSTALL = 0;
CANCELLED_OPERATION = 13;
MAX_DESC = 64;
MIN_EVENT = 100;
type
TForm1 =
class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
// Restore point information
PRESTOREPTINFOA = ^_RESTOREPTINFOA;
_RESTOREPTINFOA =
packed record
dwEventType: DWORD;
// Type of Event - Begin or End
dwRestorePtType: DWORD;
// Type of Restore Point - App install/uninstall
llSequenceNumber: INT64;
// Sequence Number - 0 for begin
szDescription:
array [0..MAX_DESC]
of CHAR;
// Description - Name of Application / Operation
end;
RESTOREPOINTINFO = _RESTOREPTINFOA;
PRESTOREPOINTINFOA = ^_RESTOREPTINFOA;
// Status returned by System Restore
PSMGRSTATUS = ^_SMGRSTATUS;
_SMGRSTATUS =
packed record
nStatus: DWORD;
// Status returned by State Manager Process
llSequenceNumber: INT64;
// Sequence Number for the restore point
end;
STATEMGRSTATUS = _SMGRSTATUS;
PSTATEMGRSTATUS = ^_SMGRSTATUS;
TSetRestorePoint =
Function(pRestorePtSpec: PRESTOREPOINTINFOA; pSMgrStatus: PSTATEMGRSTATUS): Bool;
stdcall;
function CreateRestorePoint(s:
string): boolean;
var
hSrClientDLL : THandle;
FSetRestorePoint : TSetRestorePoint;
Form1: TForm1;
implementation
{$R *.dfm}
function CreateRestorePoint(s:
string): boolean;
var
RestorePtSpec: RESTOREPOINTINFO;
SMgrStatus: STATEMGRSTATUS;
begin
Result := False;
23.06.2016
if not assigned(FSetRestorePoint)
then
begin
hSrClientDLL := LoadLibrary('
SrClient.dll');
if hSrClientDLL = 0
then
Exit;
@FSetRestorePoint := GetProcAddress(hSrClientDLL, '
SRSetRestorePointA');
if not assigned(FSetRestorePoint)
then
Exit;
end;
RestorePtSpec.dwEventType := BEGIN_SYSTEM_CHANGE;
RestorePtSpec.dwRestorePtType := APPLICATION_INSTALL;
RestorePtSpec.llSequenceNumber := 0;
copymemory(@RestorePtSpec.szDescription[low(RestorePtSpec.szDescription)],@s[1],sizeof(RestorePtSpec.szDescription));
if FSetRestorePoint(@RestorePtSpec, @SMgrStatus)
then
begin
Result := True;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if CreateRestorePoint('
Test Restore Point')
then Caption := '
success'
else Caption := '
Error';
end;
end.