O Microsoft Access permite que múltiplos usuários acessem simultaneamente um banco de dados, gerando um arquivo de bloqueio (.ldb) que rastreia quais usuários estão conectados. A função WhoIsInTheDatabaseLockFile descrita acima permite identificar, de maneira eficiente, quem está conectado ao banco de dados, incluindo informações detalhadas sobre o nome do computador, o nome de login do usuário e o status da conexão.
Esse tipo de monitoramento é extremamente útil em ambientes onde a colaboração é necessária, mas o controle de acesso e a auditoria de quem está utilizando os recursos são fundamentais para evitar conflitos, como a sobrescrição de dados ou bloqueios inesperados. O código acessa o esquema de usuários conectado ao Jet 4.0 OLE DB Provider, permitindo visualizar todas as conexões ativas ou que recentemente estiveram ativas, mesmo se a conexão do usuário foi encerrada abruptamente.
Public Function WhoIsInTheDatabaseLockFile() As String
' Esta função retorna uma lista de usuários que estão no arquivo de bloqueio (LDB) de um banco de dados Access.
' Informações fornecidas incluem:
' 1. Nome do computador
' 2. Nome de login do usuário
' 3. Se o usuário ainda está conectado
' 4. Estado suspeito da conexão do usuário (se foi desconectado de forma inesperada)
' Variáveis ADODB e DAO para manipulação de conexão e recordsets
Dim cn As New ADODB.Connection
Dim dbs As DAO.Database
Dim xlngLoop As Long
Dim rs As New ADODB.Recordset
Dim strNewDataSource As String, strCNString As String, xTT As String
Dim strCurrConnectString As String, xstrUserArray As String
' Constantes para nomes de tabelas e strings de conexão
Const strDummyTableName As String = "tbl__DummyTable_KeepRecordsetOpen"
Const strDatabaseString As String = "DATABASE="
Const strDataSourceText As String = "Data Source="
Const strPipeDelimiterChar As String = "|"
On Error GoTo Err_Msg ' Tratamento de erros
' Inicializa a variável para armazenar a lista de usuários
xstrUserArray = ""
' Obtém a string de conexão atual do projeto
strCurrConnectString = CurrentProject.Connection
' Extraindo o nome do arquivo do banco de dados da string de conexão
strCNString = Mid(strCurrConnectString, InStr(strCurrConnectString, strDataSourceText) + Len(strDataSourceText))
strCNString = Left(strCNString, InStr(strCNString, ";") - 1)
' Obtém o banco de dados atual e conecta-se a uma tabela "dummy"
Set dbs = CurrentDb
strNewDataSource = dbs.TableDefs(strDummyTableName).Connect
strNewDataSource = Mid(strNewDataSource, InStr(strNewDataSource, strDatabaseString) + Len(strDatabaseString))
Debug.Print "Arquivo contendo as tabelas de dados: " & strNewDataSource
' Atualiza a string de conexão para usar o caminho correto do arquivo de dados
cn.ConnectionString = Replace(strCurrConnectString, strCNString, strNewDataSource, 1, 1, vbTextCompare)
cn.Open ' Abre a conexão
' A função OpenSchema é usada para acessar o "User Roster", um esquema específico do Jet 4.0 OLE DB
Set rs = cn.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
' Exibe os nomes dos campos da tabela que serão retornados
Debug.Print rs.Fields(0).Name, "", rs.Fields(1).Name, "", rs.Fields(2).Name, rs.Fields(3).Name
' Loop para iterar sobre todos os registros (usuários) retornados
While Not rs.EOF
Debug.Print rs.Fields(0), rs.Fields(1), rs.Fields(2), rs.Fields(3)
' Para cada campo da linha atual, armazena o valor no array de usuários
For xlngLoop = 0 To 3
xTT = Trim(Nz(rs.Fields(xlngLoop), "")) ' Remove espaços e nulos
If Len(xTT) > 1 Then
' Remove caracteres nulos no final da string, se houver
If Right(xTT, 1) = Chr(0) Then xTT = Left(xTT, Len(xTT) - 1)
End If
' Concatena os valores usando um delimitador
xstrUserArray = xstrUserArray & xTT & strPipeDelimiterChar
Next xlngLoop
rs.MoveNext ' Avança para o próximo registro
Wend
' Remove o último delimitador se existir
If Len(xstrUserArray) > 0 Then xstrUserArray = Left(xstrUserArray, Len(xstrUserArray) - 1)
' Retorna a string com os usuários
WhoIsInTheDatabaseLockFile = xstrUserArray
Exit_Function:
On Error Resume Next
rs.Close ' Fecha o recordset
Set rs = Nothing
cn.Close ' Fecha a conexão
Set cn = Nothing
dbs.Close ' Fecha o banco de dados
Set dbs = Nothing
Exit Function
Err_Msg:
' Em caso de erro, exibe a mensagem de erro no console de depuração
Debug.Print "Ocorreu um erro. Número do erro " & Err.Number & ": " & Err.Description
Resume Exit_Function
End Function
Além de fornecer informações detalhadas sobre o status de cada conexão, a função garante que as informações sejam apresentadas em um formato delimitado, ideal para auditoria ou análise posterior. Ela também lida com as nuances de tratamento de erros de forma robusta, garantindo que a função não falhe inesperadamente, mesmo se houver problemas durante a execução.
Que tal aprender estes códigos também:
MS Access | Aplicando Função Concatenação de Valores nos Campos das Consultas
MS Access | Utilizando SendKeys de Forma Eficiente
MS Access | Automatizando a Compactação do Bancos de Dados
MS Access | Como Gerenciar Links das Tabelas
MS Access | Quebra de Texto em Linhas com Comprimento Máximo
MS Access | Monitoramento de Conexões de Usuários
MS Access | Mapeando 3.500 Erros com a Criação de Tabelas de Erros
MS Access | Código para Registro de Logs
MS Access | 17 Passos Essenciais para Melhorar seu Código VBA
MS Access | Código VBA para Backup de Todas as Tabelas Comentado
Uma aplicação prática desse código seria em cenários onde o administrador do banco de dados precisa saber quem está bloqueando o banco de dados ou quem pode ter causado uma interrupção. Isso é importante, especialmente quando múltiplos usuários precisam realizar alterações e o bloqueio do banco pode prejudicar o andamento dos processos.
Por fim, a função demonstra uma abordagem sofisticada de uso do ADO e DAO no Access, combinando a manipulação de strings de conexão com o acesso a esquemas específicos do provedor OLE DB. Esse tipo de solução oferece uma visão clara e eficaz da infraestrutura de conectividade do banco de dados, permitindo ao administrador tomar ações mais informadas e garantir a disponibilidade contínua do sistema para todos os usuários.
Clique aqui e nos contate via What's App para avaliarmos seus projetos
Nenhum comentário:
Postar um comentário