VBA – Aumente a segurança de seus projetos VBA

 

Logo VBA

Código de autoria do colega Felipe Dasi, colaborador do blog e do nosso fórum.

O conjunto de código abaixo serve para proteger seu arquivo de projeto VBA. Ele faz com que, caso o projeto VBA esteja desprotegido, todo os conteúdo de código dos módulos e planilha sejam excluídos, dificultando o hackeamento de seu aplicativo.

O código abaixo promove a proeza. Os comentários auxiliam na orientações deste e são do próprio autor.

Colocar em Estapasta_de_trabalho:

Option Explicit
 
Private Sub Workbook_Open()
      If Application.Version > 9 Then
            Dim VisualBasicProject As Object
            On Error Resume Next
            Set VisualBasicProject = ActiveWorkbook.VBProject
            If Not Err.Number = 0 Then
 
      End If
      'DESABILITA ESC E INICIA RELOGIO
      Application.EnableCancelKey = xlDisabled
      Run "IniciaRelogio"
      End If
End Sub
 
'
'TODAS AS POSSIBILIDADES
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
      Run "ParaRelogio"
      'PODE COLOCAR CODIGO PROPRIO AQUI
      Run "IniciaRelogio"
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
      Run "ParaRelogio"
      'PODE COLOCAR CODIGO PROPRIO AQUI
      Run "IniciaRelogio"
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
      Run "ParaRelogio"
      'PODE COLOCAR CODIGO PROPRIO AQUI
      Run "IniciaRelogio"
End Sub
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      Run "ParaRelogio"
      'PODE COLOCAR CODIGO PROPRIO AQUI
      Run "IniciaRelogio"
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
      Run "ParaRelogio"
      'PODE COLOCAR CODIGO PROPRIO AQUI'
End Sub

Colocar em um módulo VBA:

'Se a senha em A1 for igual a 123
'Se a senha em Comentários em propriedades da Planilha = 456
'Se a senha do VBA = 123
'RESULTADO O projeto VBA é aberto
'Resumindo, se uma das senha não bater o VBA é apagado
'Se você tirar a senha de A1 e Salvar, a planilha pode ser usada normalmente, mas
' se o usuário quebrar a senha, ao acessar o modulo o VBA serás apagado.
Option Explicit
 
Public IdleTime As Date
 
Private Sub DeletaVBA()
      With ThisWorkbook
            If Plan1.[A1] = "123" _
               And .BuiltinDocumentProperties("Comments") = "456" Then
                  'COLOCANDO A SENHA CORRETA DO VBA E MANTENDO AS OUTRAS DUAS EM A1 E EM PROPRIEDADES O RELOGIO NÃO É ATIVADO.
               'CASO CONTRARIO O RELOGIO É ATIVADO E EM 5 SEGUNDOS O PROJETO VBA SERÁ APAGADO.
                  Run "ParaRelogio"
                  Exit Sub
            Else
                  If .VBProject.Protection = 0 Then   'unlocked
                        Run "ParaRelogio"
 
                        Dim Component As Object
 
                        ' AQUI DELETA TODOS MODULOS DO VBA
                        For Each Component In .VBProject.VBComponents
                              With Component.CodeModule
                                    .DeleteLines 1, .CountOfLines
                              End With
                        Next
 
                        'SALVA AS ALTERAÇÕES FEITAS NA PLANILHA
                        .Save
                        'SE QUISER COLOCAR UMA MENSAGEM
                          MsgBox "SENHA(S) INCORRETA(S) - " & _
                               "TODOS OS MODULOS SERÃO APAGADOS... :o)"
                        Workbooks.Open (.FullName)
                        .Close
                  Else
                        'INICIA A CONTAGEM DO RELOGIO SE VBA FOR QUEBRADO
                        Run "IniciaRelogio"
                  End If
            End If
      End With
      Exit Sub
 
End Sub
 
Private Sub IniciaRelogio()           
      If Plan1.[A1] = "123" _
         And ThisWorkbook.BuiltinDocumentProperties("Comments") = "456" _
         Then Exit Sub
 
            'AQUI É O TEMPO DE ABERTURA DO VBA
      IdleTime = Now + TimeValue("00:00:05")
 
      Application.OnTime IdleTime, "DeletaVBA"
End Sub
 
Private Sub ParaRelogio()
      On Error Resume Next
      Application.OnTime EarliestTime:=IdleTime, _
                         Procedure:="DeletaVBA", Schedule:=False
End Sub

O código e melhorias estão sendo discutidas em nosso fórum:

http://www.tomasvasquez.com.br/forum/viewtopic.php?f=6&t=249&start=10

Bom proveito! Valeu Felipe!

Comentários

comentários