Dicas do OsmarJr

Sincronização sem Replicação

Como sincronizar bancos de dados sem usar a replicação do Access.

Autor: Hans Karman

Algumas explicações se fazem necessárias:

  1. O sistema foi criado para usar autonumeração randômica, para reduzir as chances de duplicação de chave. Cada registro também tem um campo DateLastUpdated (DataUltimaAtualizacao), com valor padrão Now() (Agora()) para cada alteração do registro, com exatidão de segundo. A sincronização, então, se vale de duas condições: a) se uma chave da tabela na Replica não for encontrada na Mestre, o registro da réplica é incluído na Mestre como novo registro e b) Se a chave for encontrada e DateLastChanged da Réplica é igual à da Mestre, o registro da Réplica é ignorado. Se as datas forem diferentes, os campos fornecidos pelo usuário na Replica e na Mestre são apresentados lado a lado ao operador para que este possa decidir qual registro aceitar. Neste processo o formulário frmDifferences é editável, permitindo ao operador fazer qualquer alteração antes de aceitar uma ou outra versão.
  2. O formulário frmDifferences é um formulário genérico com três campos em colunas. A coluna 1 é o rótulo do campo (de acordo com a vontade do usuário). A coluna 2 mostra o conteúdo do campo na tabela Mestre. A tabela 3 mostra o conteúdo do mesmo campo na tabela Replica. Se o campo é uma Caixa de Combinação ou Caixa de Listagem, são apresentados como uma caixa de listagem com os valores selecionados.
  3. O sistema trabalha em três passos:
    1. Ligar as tabelas Replicas às Mestres. Isto cria nomes duplicados de tabelas, terminando em 1 (mas qualquer caracter pode ser usado).
    2. "Passear" por cada tabela usando o algoritmo acima para apresentar os registros que necessitam de intervenção do usuário.
    3. [Este último passo também poderia ser automatizado, mas não era o que o cliente desejava.]

É necessário criar uma rotina para tratamento de erros para tornar o aplicativo mais robusto. deixo isso por sua conta.

Este código deve ser adaptado para atender a casos particulares. É válido apenas para pequenos aplicativos. Funciona quase que sem overhead (que era mortal na replicação padrão) no nosso caso, já que exige apenas uma chave randômica e um campo Date/Time correto até os segundos.

É possível que registros atravessem a rede, mas bastante improvável: duas chaves randômicas devem ser criadas iguais e/ou os dois registros devem ser atualizados no mesmo segundo em dois (ou mais) computadores distintos. Os riscos são mínimos e bastante toleráveis neste caso.

A sincronização semanal leva menos de cinco minutos e o operador tem controle total sobre as informações.

 

'********* Início do código *********************************
' Este código foi escrito originalmente por Hans Karman
' Ele não deve ser alterado ou distribuído,
' exceto como parte de um aplicativo.
' Use-o livremente em qualquer aplicativo,
' desde que esta nota de copyright não seja alterada.
'
' Código cortesia de
' Hans Karman
'
Private Sub cmdSynchronise_Click()
'
' Vincula a réplica usando a função LinkReplica (abaixo)
'
    If Not LinkReplica() Then
        MsgBox "Réplica não vinculada corretamente. Entre em contato com o Programador."
        DoCmd.Quit
    End If
    MsgBox "Vinculação com a réplica completada. Iniciando a sincronização."
'
'Sincroniza as tabelas. Isto pode ser automatizado verificando a coleção TableDefs
'e a coleção de campos para cada tabela. Neste aplicativo, a codificação
'era de desenvolvimento mais rápido.
' A seqüência de atualização das tabelas é importante. Sincronize primeiro as tabela
' "pesquisa" para evitar registros ausentes ao atualizar as duas últimas tabelas
' (que são as tabelas de ligação em dois relacionamentos muitos-para-muitos).
'
    DoCmd.Hourglass True
    SyncCategories   'Lookup table
    SyncConsultants  'Lookup table
    SyncDepartments  'Lookup table
    SyncSponsors  'Lookup table
    SyncStages    'Lookup table
    SyncJobs      'Main table
    SyncComments  'This is a table used in a subform to the Jobs form
    SyncJobConsultants  'Link table (many-to-many jobs/consultants)
    SyncJobSponsors  'Link table (many-to-many jobs/sponsors)
    DoCmd.Hourglass False
'
' Desvincula as réplicas, usando a função de desvinculação (abaixo)
'
    MsgBox "Sincronização colpletada. Desvincula réplicas."
    If Not UnLinkReplica() Then
        MsgBox "Réplica não desvinculada corretamente. Entre em contato com o programados."
        DoCmd.Quit
    End If
    MsgBox "Réplica desvinculada. Destrói a réplica e substitui pela cópia da Mestre"
End Sub
'
Private Sub SyncCategories()
'
'Esta é uma tabela com apenas um campo de usuário
'
' Limpa os campos globais usados para comunicar com o formulário frmDifferences
'
    InitialiseDifferences
'
' Nome da tabela
'
    XTable = "Categories"
    Set dbs = CurrentDb()
    Set master = dbs.OpenRecordset("tbl" & XTable, dbOpenDynaset)
    Set replica = dbs.OpenRecordset("tbl" & XTable & "1", dbOpenDynaset)
    replica.MoveFirst
    While Not replica.EOF
        master.FindFirst "CategoryID = " & replica!CategoryID
        If master.NoMatch Then
            master.AddNew
            master!CategoryID = replica!CategoryID
            master!Description = replica!Description
            master!DateLastChanged = replica!DateLastChanged
            master.Update
            MsgBox "New category added = " & replica!Description
        Else
            If replica!DateLastChanged <> master!DateLastChanged Then
      '
      ' Acerta os campos globais
      '
                XLabel1 = "Description"
                MField1 = master!Description
                RField1 = replica!Description
      '
      ' Apresenta ao operador para decisão
      '
                DoCmd.OpenForm "frmDifferences", , , , , acDialog
      '
      ' O formulário frmDifferences põe os campos selecionados pelo operador
      ' nas variáveis Globais para a Mestre
      '
                master.Edit
                master!Description = MField1
                master!DateLastChanged = Now()
                master.Update
            End If
        End If
        replica.MoveNext
    Wend
    replica.Close
    master.Close
    Set master = Nothing
    Set rst = Nothing
    Set dbs = Nothing
End Sub
'
Private Sub SyncSponsors()
'
' Esta é uma tabela com uma campo Caixa de Combinação
'
    InitialiseDifferences
    XTable = "Sponsors"
    Set dbs = CurrentDb()
    Set master = dbs.OpenRecordset("tbl" & XTable, dbOpenDynaset)
    Set replica = dbs.OpenRecordset("tbl" & XTable & "1", dbOpenDynaset)
    replica.MoveFirst
    While Not replica.EOF
        master.FindFirst "SponsorID = " & replica!SponsorID
        If master.NoMatch Then
            master.AddNew
            master!SponsorID = replica!SponsorID
       '
       ' este é o campo chave Caixa de Combinação
       '
            master!DepartmentID = replica!DepartmentID
            master!Title = replica!Title
            master!Name = replica!Name
            master!Phone = replica!Phone
            master!Location = replica!Location
            master!DateLastChanged = replica!DateLastChanged
            master.Update
            MsgBox "New Sponsor added = " & replica!Name
        Else
            If replica!DateLastChanged <> master!DateLastChanged Then
                XLabel1 = "Title"
                MField1 = master!Title
                RField1 = replica!Title
                XLabel2 = "Name"
                MField2 = master!Name
                RField2 = replica!Name
                XLabel3 = "Phone"
                MField3 = master!Phone
                RField3 = replica!Phone
                XLabel4 = "Location"
                MField4 = master!Location
                RField4 = replica!Location
                XLabel6 = "Department"
      '
      ' As caixas de combinação são tratadas no formulário frmDifferences
      '
                MCombo6 = master!DepartmentID
                RCombo6 = replica!DepartmentID
                DoCmd.OpenForm "frmDifferences", , , , , acDialog
                master.Edit
                master!Title = MField1
                master!Name = MField2
                master!Phone = MField3
                master!Location = MField4
                master!DepartmentID = MCombo6
                master!DateLastChanged = Now()
                master.Update
            End If
        End If
        replica.MoveNext
    Wend
    replica.Close
    master.Close
    Set master = Nothing
    Set rst = Nothing
    Set dbs = Nothing
End Sub
'
' Este é o código que vai pot trás do formulário frmDifferences
' Você pode imaginar a aparência do formulário frmDifferences
' As colunas são fxLabeln, fmFieldn e frFieldn (label, master, replica)
'


'------------- frmDifferences code ---------------------
Option Compare Database
Option Explicit
'
Private Sub cmdMaster_Click()
'
' O Operador seleciona "use registro mestre"
' Então colocamos o valor da Coluna 2 nas variáveis Globais do Mestre
' para transmissão ao processo de sincronização
'
    On Error GoTo Err_cmdMaster_Click
    MField1 = Me!fmField1
    MField2 = Me!fmField2
    MField3 = Me!fmField3
    MField4 = Me!fmField4
    MField5 = Me!fmField5
    If XLabel6 <> "" Then MCombo6 = Me!fMCombo6
    If XLabel7 <> "" Then MCombo7 = Me!fMCombo7
    DoCmd.Close
Exit_cmdMaster_Click:
    Exit Sub
Err_cmdMaster_Click:
    MsgBox Err.Description
    Resume Exit_cmdMaster_Click
End Sub
'


Private Sub cmdReplica_Click()
'
' O Operador seleciona "Use registro réplica"
' Entãio colocamos o valor da Coluna 3 nas variáveis Globais do Mestre
' para transmissão ao processo de sincronização
'
    On Error GoTo Err_cmdReplica_Click
    MField1 = Me!frField1
    MField2 = Me!frField2
    MField3 = Me!frField3
    MField4 = Me!frField4
    MField5 = Me!frField5
    If XLabel6 <> "" Then MCombo6 = Me!fRCombo6
    If XLabel7 <> "" Then MCombo7 = Me!fRCombo7
    DoCmd.Close
Exit_cmdReplica_Click:
    Exit Sub
Err_cmdReplica_Click:
    MsgBox Err.Description
    Resume Exit_cmdReplica_Click
End Sub
'


Private Sub Form_Load()
'
' Carrega as variáveis Globais nas três colunas de dados
'
    Me!fXTable = XTable
    Me!fLabel1 = XLabel1
    Me!fmField1 = MField1
    Me!frField1 = RField1
    Me!fLabel2 = XLabel2
    Me!fmField2 = MField2
    Me!frField2 = RField2
    Me!fLabel3 = XLabel3
    Me!fmField3 = MField3
    Me!frField3 = RField3
    Me!fLabel4 = XLabel4
    Me!fmField4 = MField4
    Me!frField4 = RField4
    Me!fLabel5 = XLabel5
    Me!fmField5 = MField5
    Me!frField5 = RField5
    Me!fLabel6 = XLabel6
    If XLabel6 <> "" Then
        SetComboBox6
    End If
    Me!fLabel7 = XLabel7
    If XLabel7 <> "" Then
        SetComboBox7
    End If
End Sub
'


Private Sub SetComboBox6()
'
' Esta é uma Caixa de Combinação. Então usamos as propriedades de Caixa de Listagem
' para apresentar os Valores apropriados
' O valor do rótulo determina o tipo de Caixa de Combinação
'
    Select Case XLabel6
        Case "Department"
            Me.RecordSource = "tblDepartments"
            fMCombo6.DefaultValue = MCombo6
            fMCombo6.RowSource = "SELECT DISTINCTROW [tblDepartments].[DepartmentID], " & _
                "[tblDepartments].[Branch], [tblDepartments].[ShortDepartment] " & _
                "FROM [tblDepartments];"
            fMCombo6.ColumnCount = 3
            fMCombo6.ColumnWidths = "0cm;3.8cm;0.75cm"
            fMCombo6.BoundColumn = 1
            fRCombo6.DefaultValue = RCombo6
            fRCombo6.RowSource = "SELECT DISTINCTROW [tblDepartments].[DepartmentID], " & _
                "[tblDepartments].[Branch], [tblDepartments].[ShortDepartment] " & _
                "FROM [tblDepartments];"
            fRCombo6.ColumnCount = 3
            fRCombo6.ColumnWidths = "0cm;3.8cm;0.75cm"
            fRCombo6.BoundColumn = 1
        Case "Category"
            Me.RecordSource = "tblCategories"
            fMCombo6.DefaultValue = MCombo6
            fMCombo6.RowSource = "SELECT DISTINCTROW [tblCategories].[CategoryID], " & _
                "[tblCategories].[Description] FROM [tblCategories];"
            fMCombo6.ColumnCount = 2
            fMCombo6.ColumnWidths = "0cm;4.55cm"
            fMCombo6.BoundColumn = 1
            fRCombo6.DefaultValue = RCombo6
            fRCombo6.RowSource = "SELECT DISTINCTROW [tblCategories].[CategoryID], " & _
                "[tblCategories].[Description] FROM [tblCategories];"
            fRCombo6.ColumnCount = 2
            fRCombo6.ColumnWidths = "0cm;4.55cm"
            fRCombo6.BoundColumn = 1
        Case "Stage"
            Me.RecordSource = "tblStages"
            fMCombo6.DefaultValue = MCombo6
            fMCombo6.RowSource = "SELECT tblStages.StageID, tblStages.Description " & _
                "FROM tblStages ORDER BY tblStages.SortOrder;"
            fMCombo6.ColumnCount = 2
            fMCombo6.ColumnWidths = "0cm;4.55cm"
            fMCombo6.BoundColumn = 1
            fRCombo6.DefaultValue = RCombo6
            fRCombo6.RowSource = "SELECT tblStages.StageID, tblStages.Description " & _
                "FROM tblStages ORDER BY tblStages.SortOrder;"
            fRCombo6.ColumnCount = 2
            fRCombo6.ColumnWidths = "0cm;4.55cm"
            fRCombo6.BoundColumn = 1
        Case Else
    End Select
End Sub


'
' estas são as funções de vinculação e desvinculação que usei.
' Os nomes dos diversos bancos de dados são recuperados em tempo de inicialização
' e armazenados nas variáveis Globais
'
Public Function LinkReplica()
    On Error GoTo LinkReplica_Err
    Dim tdf As TableDef
    Dim strTable As String
    Dim strNewConnect As String
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("SELECT MSysObjects.Connect, MsysObjects.Database, " & _
        "MSysObjects.Name from MSysObjects " & _
        "WHERE MSysObjects.Type = " & IntAttachedTableType)
    rst.MoveLast
    If rst.RecordCount <> 0 Then
        rst.MoveFirst
        strNewConnect = ";DATABASE=" & strDataReplica
        While Not rst.EOF
            strTable = rst!Name
            Set tdf = dbs.CreateTableDef(strTable & "1")
            tdf.Connect = strNewConnect
            tdf.SourceTableName = strTable
            dbs.TableDefs.Append tdf
            Set tdf = Nothing
            rst.MoveNext
        Wend
    End If
    dbs.TableDefs.Refresh
    rst.Close
    Set rst = Nothing
    LinkReplica = True
    Set dbs = Nothing
    Exit Function
LinkReplica_Err:
    LinkReplica = False
    MsgBox "Replica not linked, Contact programmer"
End Function


Public Function UnLinkReplica()
    On Error GoTo UnLinkReplica_Err
    Dim tdf As TableDef
    Dim strTable As String
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("SELECT MSysObjects.Connect, MsysObjects.Database, " & _
        "MSysObjects.Name from MSysObjects " & _
        "WHERE MSysObjects.Type = " & IntAttachedTableType)
    rst.MoveLast
    If rst.RecordCount <> 0 Then
        rst.MoveFirst
        While Not rst.EOF
            strTable = rst!Name
            If right(strTable, 1) = "1" Then
                dbs.TableDefs.Delete (strTable)
            End If
            rst.MoveNext
        Wend
    End If
    dbs.TableDefs.Refresh
    rst.Close
    Set rst = Nothing
    UnLinkReplica = True
    Set dbs = Nothing
    Exit Function
LinkReplica_Err:
    UnLinkReplica = False
    MsgBox "Replica not unlinked, Contact programmer"
End Function
'************** Final do Código ******************************
Home

Contato | Copyright©Osmar José Correia Júnior | 24-Nov-2005 18:23