Apresentação
Quem nunca se preocupou com a segurança de seu banco de dados, mesmo que pequeno? Neste artigo veremos a como bloquear a tecla shift ao se abrir um mdb com formulários inicializáveis
Há algumas maneiras de se bloquear o Shift do Access, neste tutorial mostrarei a que julgo mais atrativa.
bloquear a tecla shift ao se abrir um mdb
- Crie um módulo com um nome a sua escolha, neste exemplo, usarei o nome mdl_libera.
- Dentro deste módulo, vamos colocar um script que libere e bloqueie as teclas digitadas ao iniciar o form. Coloque este script no módulo:
Option Compare Database
‘Esta é a função para liberar o Shift
Sub LiberaShift()
Const DB_Boolean As Long = 1
ChangeProperty “AllowBypassKey”, DB_Boolean, True
End Sub
‘Esta para Travar
Sub TravaShift()
Const DB_Boolean As Long = 1
ChangeProperty “AllowBypassKey”, DB_Boolean, False
End Sub
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then ‘ Propriedade não encontrada.
Set prp = dbs.CreateProperty(strPropName, _
varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
‘ Erro desconhecido.
ChangeProperty = False
Resume Change_Bye
End If
End Function
‘Esta é a função para liberar o Shift
Sub LiberaShift()
Const DB_Boolean As Long = 1
ChangeProperty “AllowBypassKey”, DB_Boolean, True
End Sub
‘Esta para Travar
Sub TravaShift()
Const DB_Boolean As Long = 1
ChangeProperty “AllowBypassKey”, DB_Boolean, False
End Sub
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then ‘ Propriedade não encontrada.
Set prp = dbs.CreateProperty(strPropName, _
varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
‘ Erro desconhecido.
ChangeProperty = False
Resume Change_Bye
End If
End Function
- Crie um formulário no Modo Estrutura, com Dois Botões, um para travar e outro para Liberar.
- Nomeie os botões a seu gosto, no nosso exemplo, colocarei os nomes Libera e Bloqueia.
- Chame a função no código dos botões
Botão de Bloquear, evento click:
Private Sub Bloqueia_Click()
TravaShift
End Sub
TravaShift
End Sub
Private Sub Libera_Click()
LiberaShift
End Sub
LiberaShift
End Sub
- Crie um atalho para chamar este form que você criou, lembrando que o lugar deve ser escondido, pois toda a segurança se encontra nesse componente.
- Toda vez que você clique nos botões para bloquear ou liberar o shift, não esqueça de reiniciar o Access, para que as alterações entrem em vigor.
Espero ter ajudado, em caso de dúvida, poste nos comentários!
Fico por aqui, até mais.
5 Comentários. Deixe novo
… [Trackback]…
[…] Read More here: purainfo.com.br/scripts/bloquando-a-tecla-shift-no-access/ […]…
Sim, muito bom !
Giuseppe Zanotti London Croc Zip Sneakers
Bloqueando a tecla Shift no Access | Purainfo
pessoal, boa tarde!
no meu bd não funcionou. alguém pode me dar alguma dica do que estou fazendo errado?
para que o código funcione corretamente na instrução allowbaypasskey, você deve remover as duas aspas que está na instrução e colocar duas aspas digitando no seu teclado. Obs: na linha do código que ficar vermelha, você deve remover a aspa simples .
Option Compare Database
‘Esta é a função para liberar o Shift
Sub LiberaShift()
Const DB_Boolean As Long = 1
ChangeProperty “AllowBypassKey”, DB_Boolean, True
End Sub
‘Esta para Travar
Sub TravaShift()
Const DB_Boolean As Long = 1
ChangeProperty “AllowBypassKey”, DB_Boolean, False
End Sub
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then ‘Propriedade não encontrada.
Set prp = dbs.CreateProperty(strPropName, _
varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
Erro desconhecido.
ChangeProperty = False
Resume Change_Bye
End If
End Function