como crear un punto de restauracion desde bv6?

[guidosl]

como crear un punto de restauracion instantaneo???

esto es en .vbs por si alguien sabe como pasarlo a vb6

rp = "Scripted Restore Point by " & WScript.ScriptName GetObject("winmgmts:.rootdefault:Systemrestore").CreateRestorePoint rp, 0, 100

gracias

[guidosl]

el script anterior no me funciona

este si: Como lo puedo pasar a bv6???




If GetOS = "Windows XP" Then
   CreateSRP
End If

If GetOS = "Windows Vista" Or GetOS = "Windows 7" Then
   If WScript.Argume nts.length =0 Then
        Set objShell = CreateObject("Shell.Applicat ion")
      objShell.ShellExecute "wscript.exe", """" & _
          WScript.Script FullName & """" & " uac","", "runas", 1
   Else
        CreateSRP
     End If
End If

Sub CreateSRP
   Set SRP = getobject("winmgmts:\\.\root\default:Systemrestore")
   sDesc = "Manual Restore Point"
   sDesc = InputBox ("Enter a description.", "System Restore script : winhelponline. com","Manual Restore Point")
   If Trim(sDesc) <> "" Then
      sOut = SRP.createrest orepoint (sDesc, 0, 100)
      If sOut <> 0 Then
          WScript.echo "Error " & sOut & _
            ": Unable to create Restore Point."
      End If
   End If
End Sub

Function GetOS   
    Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
       ".\root\cimv2")
    Set colOS = objWMI.ExecQue ry("Select * from Win32_Operatin gSystem")
    For Each objOS in colOS
        If instr(objOS.Caption, "Windows 7") Then
           GetOS = "Windows 7"   
        ElseIf instr(objOS.Caption, "Vista") Then
           GetOS = "Windows Vista"
        elseIf instr(objOS.Caption, "Windows XP") Then
            GetOS = "Windows XP"
        End If
   Next
End Function

[XcryptOR]

Asi se lo hace sin usar WMI, el código es de Syntax_err

Código (vb) [Seleccionar] Expandir

Private Const BEGIN_SYSTEM_CHANGE = 100
Private Const END_SYSTEM_CHANGE = 101

Private Const APPLICATION_INSTALL = 0

Private Const MAX_DESC = 64


Private Type PRESTOREPOINTINFOA
    dwEventType As Long
    dwRestorePtType As Long
    llSequenceNumber As Long
    szDescription As String * MAX_DESC
End Type

Private Type PSTATEMGRSTATUS
    nStatus As Long
    llSequenceNumber  As Long
End Type

Private Declare Function SRSetRestorePointA Lib "srclient" (ByRef pRestorePtSpec As PRESTOREPOINTINFOA, ByRef pSMgrStatus As PSTATEMGRSTATUS) As Boolean
Declare Function lstrcpyA Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Sub main()

   Dim RestPtInfo As PRESTOREPOINTINFOA
   Dim SMGRSTATUS As PSTATEMGRSTATUS

   '// Inicializa la estructura RESTOREPOINTINFO
   RestPtInfo.dwEventType = BEGIN_SYSTEM_CHANGE

   '// Notifica al sistema los cambios que se hacen.
   '// una instalacion esta en proceso.
   RestPtInfo.dwRestorePtType = APPLICATION_INSTALL

   '// setea RestPtInfo.llSequenceNumber.
   RestPtInfo.llSequenceNumber = 0

   '// Nombre que se le dara al punto de restauración.
   RestPtInfo.szDescription = String(4, Chr(0)) & "Elhacker Restore Point" & Chr(0)

   
   
   If Not SRSetRestorePointA(RestPtInfo, SMGRSTATUS) Then
    Debug.Print "Couldn't set the beginning of the restore point."
   End If

   '// la aplicacion lleva a cabo algunos procesos aqui
    FileCopy "c:\windows\notepad.exe", "c:\1.txt"
   '// re-inicializa la estructura RESTOREPOINTINFO para notificar al sistema que la operacion termino
   
   RestPtInfo.dwEventType = END_SYSTEM_CHANGE

   '// los cambios en el sistema terminan al recibir el resultado de la llamada a SRSetRestorePoint.
   RestPtInfo.llSequenceNumber = SMGRSTATUS.llSequenceNumber

   '// Notifica al sistema que la creación del punto de restauracion ha sido exitosa
   If Not SRSetRestorePointA(RestPtInfo, SMGRSTATUS) Then Debug.Print "Couldn't set the end of the restore point."

End Sub


[guidosl]

gracias me va perfecto

pero tengo una duda...que datos son los que guarda en a.txt??

y como puedo poner para que se muestre un msjbox si se creo correctamente o si hubo error?


mil gracias

[seba123neo]

si lees el codigo hasta esta comentado cuando se crea correctamente y cuando no...

[guidosl]

muchas gracias