Automatic *.mdb synchronisation with VB6.

I have a third party VB6 db app that presents a very convoluted means of sychronising local (laptop) copies of an *.mdb that will be too difficult for my team to use on a daily basis. I'd like to build a utility in VB6 that will automatically synch. their local copies with the master at a predetermined time. How can this be done?
BouletAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
jelliott720Connect With a Mentor Commented:
This example uses subclassing to place the App in the System Tray.. The database locations (Master & Replica), and the start time are obtained from local profile named AutoSync.ini. The App assumes the profile resides in App.Path..

The contents of the profile might look like :
''''''''''''''''''''''''''''''''''''''
[General Setup]
Master Replica=E:\AutoSync\LanLocation\DMHProvidersMaster.mdb
Local Replica=E:\AutoSync\DMHProvidersReplica.mdb
Time Window Start=11:41:00 AM
''''''''''''''''''''''''''''''''''''''
Begin by Creating a new standard project. Name the Project AutoSync. Save the Project in a subdirectory name AutoSync.

The following assumes you have made a reference to the appropriate DAO Object library (3.51 or 3.6)
'''''''''''''''''''''''''''''''''''''''

' The Form Begins here....
VERSION 5.00
Begin VB.Form frmSync
   BorderStyle     =   1  'Fixed Single
   Caption         =   " "
   ClientHeight    =   2220
   ClientLeft      =   1980
   ClientTop       =   4275
   ClientWidth     =   7290
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2220
   ScaleWidth      =   7290
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer Timer1
      Interval        =   1000
      Left            =   360
      Top             =   1410
   End
   Begin VB.PictureBox picNotifier
      Height          =   540
      Left            =   6570
      ScaleHeight     =   480
      ScaleWidth      =   555
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   1335
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.Label lblStatus
      Alignment       =   2  'Center
      Height          =   360
      Left            =   1245
      TabIndex        =   3
      Top             =   1380
      Width           =   4695
   End
   Begin VB.Label lblScreenTitle1
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Database Synchronization"
      BeginProperty Font
         Name            =   "Courier New"
         Size            =   21.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   705
      Left            =   705
      TabIndex        =   2
      Top             =   525
      Width           =   6165
   End
   Begin VB.Label lblScreenTitle3
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Database Synchronization"
      BeginProperty Font
         Name            =   "Courier New"
         Size            =   21.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   705
      Left            =   675
      TabIndex        =   1
      Top             =   525
      Width           =   6135
   End
   Begin VB.Menu mnuOptions
      Caption         =   "&Functions"
      Begin VB.Menu mnuOpts
         Caption         =   "&Sync Now"
         Index           =   0
      End
      Begin VB.Menu mnuOpts
         Caption         =   "&Hide"
         Index           =   1
      End
      Begin VB.Menu mnuOpts
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu mnuOpts
         Caption         =   "E&xit"
         Index           =   3
      End
   End
   Begin VB.Menu mnuPopMenu
      Caption         =   "Menu"
      Visible         =   0   'False
      Begin VB.Menu mnuPopMenuShow
         Caption         =   "&Show"
      End
      Begin VB.Menu mnuSeparator
         Caption         =   "-"
      End
      Begin VB.Menu mnuPopMenuExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "frmSync"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim dtmStartTime As Date
Dim strReplicaMaster As String, strLocalReplica As String
Dim Db As Database, bolMenuExit As Boolean
'
' Declaration for retrieving Info from a Profile
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
'
' Variables used inconjunction with the Profile
Dim strProfileAppName As String
Dim strProfileName As String
Dim strProfileKeyName As String
'
'
' Declaration of the Shell_NotifyIcon
'
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
'
' Constants Used with Shell_NotifyIcon
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

' The NOTIFYICONDATA Type Declaration
Private Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uId As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

' We'll make the CallBackParms dimmed as NOTIFYICONDATA
Dim CallBackParms As NOTIFYICONDATA

'
' Retrieve Values from the Profile
'
Function GetPKeyStr(sProfileSection As String, _
                    sProfileKey As String, _
                    sFileName As String) As String

    Dim strKeyValue As String, lngCharsReturned As Long

    strKeyValue = String$(128, 0)

    lngCharsReturned = GetPrivateProfileString(sProfileSection, _
                       sProfileKey, "", strKeyValue, 127, sFileName)

    If lngCharsReturned > 0 Then
        strKeyValue = Left$(strKeyValue, lngCharsReturned)
    Else
        strKeyValue = ""
    End If

    GetPKeyStr = strKeyValue

End Function


Function OKSynchronized() As Boolean

    On Error GoTo SyncErr

    Set Db = OpenDatabase(strLocalReplica)  ' Replica

    ' Sends changes made in each replica to the other.
    Db.Synchronize strReplicaMaster, _
        dbRepImpExpChanges

    'dbRepExportChanges Sends changes from database to pathname.
    'dbRepImportChanges Sends changes from pathname to database.
    '

    Db.Close
    Set Db = Nothing

    OKSynchronized = True

    Exit Function

SyncErr:
'
'  Error Routine
'

 MsgBox "Synchronization Failed " & vbCrLf _
         & Err & " " & Error
 OKSynchronized = False
End Function

Private Sub Form_Load()
  '
  ' Setup Callback Parameters
  With CallBackParms
    .cbSize = Len(CallBackParms)
    ' Use the picNotifier's hWnd as our handle
    .hWnd = picNotifier.hWnd
    ' Change the uId to 1&
    .uId = 1&
    ' Use the respective Flags that should be used,
    ' so it works properly, just like any other.
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    ' When there's WM_MOUSEMOVE, we'll need to see it
     .uCallbackMessage = WM_MOUSEMOVE
    ' Use the Main Form's Icon for the process.
    .hIcon = Me.Icon
    ' Use the Tip "Database Sync" as our Tooltip
    .szTip = "Database Sync" & Chr$(0)

    End With

    ' Now, we actually add the App to the SystemTray.
    Shell_NotifyIcon NIM_ADD, CallBackParms
    ' Hide the Main Form.
    Me.Hide
    ' Don't show the App on the Taskbar.
    App.TaskVisible = False
    '
    Timer1.Enabled = True
    '
    ' Get of Local Profiles' name...
    strProfileName = App.Path & "\" & App.EXEName & ".INI"
    If Dir(strProfileName) = "" Then
        MsgBox "The Profile file : " & strProfileName & vbCrLf & " was not found.." & vbCrLf & "Run Aborted...", vbCritical, "Initilization Error"
        End
    End If

    Call GetProfileEntries

End Sub

Sub GetProfileEntries()
    Dim varTimeWk As Variant
    On Error Resume Next

    strProfileAppName = "General Setup"
      '
    '
    strProfileKeyName = "Master Replica"
    strReplicaMaster = GetPKeyStr(strProfileAppName, strProfileKeyName, strProfileName)

    If strReplicaMaster = "" Or Dir(strReplicaMaster) = "" Or Err = 68 Then
       MsgBox "The Master Replica database was not found. ", _
               vbOK, "Run Aborted"
       End
    End If
    '
    strProfileKeyName = "Local Replica"
    strLocalReplica = GetPKeyStr(strProfileAppName, strProfileKeyName, strProfileName)

    If strLocalReplica = "" Or Dir(strLocalReplica) = "" Or Err = 68 Then
        MsgBox "The Local Replica database was not found. ", _
               vbOK, "Run Aborted"
         End
    End If

    strProfileKeyName = "Time Window Start"
    varTimeWk = GetPKeyStr(strProfileAppName, strProfileKeyName, strProfileName)
    If Not IsDate(varTimeWk) Then
       dtmStartTime = #11:00:00 AM#
       Exit Sub
      Else
       dtmStartTime = CDate(varTimeWk)
    End If


End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  '
  ' Only shutdown if exiting using Menu Function
  '
  If bolMenuExit <> True Then
     Cancel = True
     Me.Hide
     Exit Sub
  End If

    ' We need to remove the app from the System Tray....

    CallBackParms.cbSize = Len(CallBackParms)
    CallBackParms.hWnd = picNotifier.hWnd
    CallBackParms.uId = 1&
    Shell_NotifyIcon NIM_DELETE, CallBackParms

End Sub


Private Sub mnuOpts_Click(Index As Integer)
'
'
Select Case Index
  Case 0
    If OKSynchronized Then
       lblStatus.Caption = "Sync Complete..:" & Now
       Timer1.Enabled = False
    End If
  Case 1
     Me.Hide
  Case 3
     Unload Me
     Set frmSync = Nothing
     End
End Select
Exit Sub

End Sub

Private Sub mnuPopMenuExit_Click()
    bolPopExit = True
    Unload Me
    Set frmMain = Nothing
    End
End Sub

Private Sub mnuPopMenuShow_Click()
    Me.Show
End Sub

Private Sub picNotifier_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' We'll use this sub to determine if the icon
    ' was doubleclicked, rightclicked or just a
    ' normal click.

Static bolInprocess As Boolean, lngEventType As Long
    ' lngEventType is the current X divided by the Screen's
    ' X in TwipsPerPixel Measurement's, so it's the
    ' same as the picNotifier.
    lngEventType = X / Screen.TwipsPerPixelX

    ' If bolInprocess is False
    If bolInprocess = False Then
        ' Make bolInprocess True.
        bolInprocess = True
        ' Determine Click Event Type and react to it...
        Select Case lngEventType
            ' If DoubleClick
            Case WM_LBUTTONDBLCLK:
                Me.Show vbModal
            ' If Button is Down
            Case WM_LBUTTONDOWN:

            'If Button is Up
            Case WM_LBUTTONUP:

            'If the RightButton is clicked
            Case WM_RBUTTONDBLCLK:

            'If the RightBurron is Down
            Case WM_RBUTTONDOWN:

            'If RightButton is Up show Pop Up Menu
            Case WM_RBUTTONUP:
                PopupMenu mnuPopMenu
        'End Determination
        End Select

        'Change bolInprocess Back to False.
        bolInprocess = False
    End If

End Sub


Private Sub Timer1_Timer()

If TimeValue(Time$) >= dtmStartTime Then
   If OKSynchronized = True Then
      lblStatus.Caption = "Sync Complete..:" & Now
      Timer1.Enabled = False
   Else ' Try again in 15 minutes
      dtmStartTime = DateAdd("n", 15, Time$)
      lblStatus.Caption = "Sync Pending.."
   End If
  Else
      lblStatus.Caption = "Sync Waiting until.." & dtmStartTime
End If

End Sub


' The form ends here    


 
0
 
adjenninCommented:
Use Windows Briefcase.
0
All Courses

From novice to tech pro — start learning today.