Impedir abrir libro usando macro apartir de un serial

24/10/2006 - 01:12 por Edixon | Informe spam
Hola un saludo a todos y a nuestro gran amigo Héctor que es de gran
ayuda.

Las siguientes macros que son del grupo.
1.-
Sub ShowSerial()
Dim fs, d
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName("c:\")))
MsgBox d.serialnumber
End Sub

Cuando esta se ejecuta ella devuelve un serial relacionado con el disco
duro de la maquina donde se ejecutó.(La probabilidad de que dos discos
tengan el mismo serial es casi nula). Ese código se anota y se coloca
en la macro 2 despues de If d.serialnumber <> (en este caso
1222748760)

La siguiete macro cuando se abre el libro y ese serial coincide
arroja un mensaje con OK sino arroja Equipo no autorizado
2.-
Private Sub Workbook_Open()
Dim fs, d
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName("c:\")))
If d.serialnumber <> 1222748760 Then MsgBox "Equipo no autorizado":
End
MsgBox "Ok"
End Sub

Bueno lo que necesito es que con esta informacion si alguien copia
el libro, cuando lo abra en otra maquina aparte de dar el mensaje de
"Equipo no autorizado" automaticamente se bloquee el libro o se borre o
cualquier otra cosa, lo importante es que no lo pueda ejecutar ni ver.

Gracias por su ayuda de antemano
 

Leer las respuestas

#1 sorenkierkegaard
24/10/2006 - 03:08 | Informe spam
Hola, sólo agréga la instrucción de: Application.Quit y cada vez que
abras el archivo en un equipo no autorizado impedirá su apertura y se
cerrará automáticamente.

Private Sub Workbook_Open()
Dim fs, d
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName("c:\")))
If d.serialnumber <> 1222748760 Then MsgBox "Equipo no autorizado":
Application.Quit
End Sub

Sólo una cosa más, para los que saben, ese código y muchos otros, no
sirven de nada, de todas formas podrán abrirlo sin problemas. Si
tienes MSN contáctame y podemos ver algo un poco más seguro. De todas
formas espero que te sirva.

Atte.

Preguntas similares