[resolvido] Backup não solicitar a senha do BD

Moderador: Avelino Sampaio

Avatar do usuário
Carvalho
Mensagens: 143
Registrado em: 21 Ago 2015, 23:22

[resolvido] Backup não solicitar a senha do BD

Mensagempor Carvalho » 25 Out 2017, 13:52

Bom dia pessoal, eu faço o Backup das tabelas pelo sistema que o Avelino disponibilizou no outro site dele http://www.usandoaccess.com.br/, só que gostaria de digitar a senha do BD no próprio código para ele não me solicitar ao fazer backup.


código para gerar o Backup:

Código: Selecionar todos

Private Sub Form_Timer()
'---------------------------------------------------------------------------
'Este código se encontra no evento timer para alimentar a barra de progresso
'---------------------------------------------------------------------------
On Error GoTo trataerro
Evento = Evento + 1
Select Case Evento
    Case 1
        '-------------------------------------------------------------------------
        'Desabilita os botões enquanto a cópia estiver sendo realizada
        'Divide a barra de progresso, que tem um comprimento de 11cm, em 8 pedaços
        '-------------------------------------------------------------------------
        Me!cx1.visible = True
        Me!btFoco.SetFocus
        Me!btCaminho.enabled = False
        Me!btIniciarBackup.enabled = False
        Escala = (11.2 * 567) / 8
        Me!cx1.Width = Escala
    Case 2
        Me!cx1.Width = Escala * 2
        Set objfs = CreateObject("Scripting.FileSystemObject")
        Me!Status.Caption = "Verificando Base de Dados..."
    Case 3
        Me!Status.Caption = "Copiando Base de Dados..."
        Me!cx1.Width = Escala * 3
    Case 4
        '----------------------------------------------------------------------------
        'Inicia o processo de cópia simples da base de dados para o destino indicado.
        'Aqui a barra de progresso fica parada até a cópia ser concluída
        '----------------------------------------------------------------------------
        objfs.CopyFile Me!txOrigem, Me!txDestino
    Case 5
        '----------------------------------------------
        'Após a conclusão da cópia o código prossegue
        '----------------------------------------------
        Me!Status.Caption = "Compactando Base de Dados..."
        Me!cx1.Width = Escala * 4
    Case 6
      Dim booResultado As Boolean
        '---------------------------------------------------------------------------------
        'Se a sua base de dados contiver uma senha de acesso, o método compactar e reparar
        'irá solicitá-la.
        '
        'A função do SendKeys é passar a senha no processo sem a intervenção do usuário.
        '
        'A função fncProtegido verifica se a base de dados possui senha e então permite
        'o uso do SendKeys.
        '
        'A função fncCapturSenha captura a senha informada na tabela tblCaminhoBe
        '---------------------------------------------------------------------------------
        If fncProtegido = True Then
       
       
       ''' Aqui inserimos a senha se o banco caso esteja com a senha
       
       '''Conn = "MS Access;PWD=wemilly889129;DATABASE=" & CaminhoAtual
     
       
      Dim objws As Object
    Set objws = CreateObject("wscript.shell")
           '-------------------------------------------------------------------------------------------
            'verifica se não há outro programa com o foco, como o word, excel ou o bloco de notas.
            'Enqunto o Access não tiver o foco, fica aguardando
            '------------------------------------------------------------------------------------------
            'Do While GetFocus <> Me.hwnd
                'Call Sleep(500) 'aguarda por meio segundo
                'DoEvents'
            'Loop
            '-------------------------------------------------------------------------------------------
          objws.SendKeys fncCapturaSenha, True
            objws.SendKeys "{ENTER}"
       End If
        '-----------------------------------------------------------------------
        'Observe que está sendo compactado e reparado a copia que foi gerada
        'pelo objfs.CopyFile no destino.
        '
        'É gerado então um outro arquivo, devidamente compactado e reparado, no
        'mesmo local de destino.
        '-----------------------------------------------------------------------
        DestinoNovo = Replace(Me!txDestino, "-", "-c")
        booResultado = Application.CompactRepair(Me!txDestino, DestinoNovo, True)
        '-----------------------------------------------------------------------------
        'O arquivo que foi copiado para o destino, pelo objfs.CopyFile, será excluído,
        'pois só nos interessa o que foi compactado e reparado.
        '-----------------------------------------------------------------------------
        If booResultado = True Then FileSystem.Kill Me!txDestino
        Me!cx1.Width = Escala * 5
        Set objws = Nothing
    Case 7
        '-------------------------------------------------
        'Executa o winrar oculto se este tiver habilitado
        '--------------------------------------------------
        If Me!selWinrar = True Then
            Me!Status.Caption = "Compactando com o Winrar..."
            Dim compri
            compri = Shell(strLocalWinRar & "\Winrar\WinRAR.EXE a " & Chr(34) & Replace(DestinoNovo, ".accdb", "") & ".rar" & Chr(34) & " " & Chr(34) & DestinoNovo & Chr(34), vbHide)
        End If
        Me!cx1.Width = Escala * 6
    Case 8
        If Me!selWinrar = True Then
            '--------------------------------------------------------------------------
            'Enquanto o winrar não completar a tarefa de compactação, o comprimento
            'do arquivo gerado fica em zero. Verifico este comprimento com o FileLen.
            'A barra de progresso vai crescendo gradativamente enquanto o winrar não
            'concluir a tarefa.
            '--------------------------------------------------------------------------
            If FileSystem.FileLen((Replace(DestinoNovo, ".accdb", "") & ".rar ")) = 0 Then
                Evento = 7
                If Me!cx1.Width < (11.2 * 567) Then intCont = intCont + 1
                Me!cx1.Width = (Escala * 7) + (15 * intCont)
            Else
                '----------------------------------------------------
                'Deleto o arquivo que não foi compactado pelo WinRAR
                '----------------------------------------------------
                FileSystem.Kill DestinoNovo
                Me!Status.Caption = "Backup concluído..."
                Screen.MousePointer = 0
                Me!cx1.Width = Escala * 8
                Me.TimerInterval = 3000
            End If
        Else
            Me!Status.Caption = "Backup concluído..."
            Screen.MousePointer = 0
            Me!cx1.Width = Escala * 8
            Me.TimerInterval = 3000
        End If
    Case 9
        Set objfs = Nothing
        '-------------------------------------------------------------------------------------
        'Caso tenha ocorrido uma correção da base de dados, pelo método compactar e reparar
        'é gerado um arquilo de log.
        '
        'Então abre um comunicado, para chamada urgente do adminitrador, que deverá verificar
        'e corrigir a base de dados em uso.
        '-------------------------------------------------------------------------------------
        If Len(Dir(Left(Me!txDestino, InStrRev(Me!txDestino, "\")) & "*.log", vbArchive) & "") > 0 Then
            MsgBox "Foi detectado problemas no arquivo de backup." & vbCrLf & _
            vbCrLf & "Entre em contato imediatamente com o administrador do Banco de Dados", vbCritical, "Aviso"
        End If
        Me.TimerInterval = 0
        Evento = 0
End Select
sair:
    If Me.TimerInterval = 0 Then DoCmd.Close acDefault
    Exit Sub
trataerro:
    MsgBox Err.Number & " - " & Err.Description, vbInformation, "Aviso"
    Evento = 0: Screen.MousePointer = 0: Me.TimerInterval = 0
    Resume sair
End Sub



Código: Selecionar todos

Public Function fncProtegido() As Boolean
Dim bd As DAO.Database
On Error Resume Next
'-------------------------------------------------
'Tento abrir o banco sem passar a senha
'Se o banco tiver a senha irá ocorrer o erro 3031
'-------------------------------------------------
Set bd = OpenDatabase(Me!txDestino, False, False)
If Err.Number = 3031 Then
    fncProtegido = True
Else
    bd.Close
End If
Set bd = Nothing
End Function
Provérbios 1:7 “O temor do SENHOR é o princípio do saber, mas os loucos desprezam a sabedoria e o ensino.”

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.


Avatar do usuário
Carvalho
Mensagens: 143
Registrado em: 21 Ago 2015, 23:22

Re: [Resolvido] Backup não solicitar a senha do BD

Mensagempor Carvalho » 28 Out 2017, 00:54

Pesoal boa noite,
consegui resolver, e é bem simples é só colocar a senha do BD no código abaixo.

objws.SendKeys "Senha aqui do Bd", True

ai ele não solicita a senha.


obrigado
Provérbios 1:7 “O temor do SENHOR é o princípio do saber, mas os loucos desprezam a sabedoria e o ensino.”

Avatar do usuário
Avelino Sampaio
Mensagens: 1897
Registrado em: 04 Jun 2015, 18:27
Contato:

Re: Backup não solicitar a senha do BD

Mensagempor Avelino Sampaio » 28 Out 2017, 10:47

Carvalho

colocar a senha direto no código é u risco a segurança. Observe que eu uso uma função para capturar a senha

objws.SendKeys fncCapturaSenha, True

Sugiro vc estudar esta função do Maestro, que uso a descriptografia para extrair a senha criptografada da tabela

Bom estudo!
==================================================
Clique no link abaixo e veja um ótimo kit de ensino que tenho para você.
http://www.usandoaccess.com.br
==================================================

Avatar do usuário
Carvalho
Mensagens: 143
Registrado em: 21 Ago 2015, 23:22

Re: [resolvido] Backup não solicitar a senha do BD

Mensagempor Carvalho » 28 Out 2017, 14:13

Segue seu conselho e acabei de fazer todas as alterações de segurança do backup e do vinculo de acordo com o seu maestro e deu tudo certinho, agora com mais segurança. obrigado Avelino pela dica :)
Provérbios 1:7 “O temor do SENHOR é o princípio do saber, mas os loucos desprezam a sabedoria e o ensino.”

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.



Voltar para “Módulos VBA”

Quem está online

Usuários neste fórum: Nenhum usuário registrado e 2 visitantes