openaccess/source/modules/OA_Main.bas

Option Compare Database

'****
'*
'* Main methods for OpenAccess add-in
'*
'****
Public Const opInterrupted = 10
Public Const opCancelled = 11
Public Const opCompleted = 12

'>> main function, called when addin is run
Public Function main()

    DoCmd.OpenForm "OpenAccess"

End Function

Public Function make_sources(ByVal include_tables As String, _
                             Optional ByVal optimizer As Boolean = True, _
                             Optional ByVal zip As Boolean = True) As Integer
'exports the source-code of the app
On Error GoTo err
Dim step As String

    make_sources = opInterrupted
    
    step = "Initialization"
    
    '*** If '-f' is not in the options: set the optimizer on
    If optimizer Then
        Dim msg As String
        
        If get_sources_date() > #1/1/1900# Then

            msg = msg_list_to_export()
            logger "make_sources", "INFO", "Optimizer: ask for confirmation"
            If Not Len(msg) > 0 Then
                msg = "** O.A. OPTIMIZER **" & vbNewLine & ">> Nothing new to export" & vbNewLine & _
                            "Only the following will be exported:" & vbNewLine & _
                            " - included table data" & vbNewLine & _
                            " - relations" & vbNewLine & vbNewLine & _
                            "TIP: use 'makesources -f' to force a complete export (could be long)."
            Else
                msg = "** O.A. OPTIMIZER **" & vbNewLine & _
                      ">> Following objects will be exported:" & vbNewLine & _
                      msg & vbNewLine & _
                      "> DATA: " & vbNewLine & get_include_tables() & vbNewLine & vbNewLine & _
                      "> RELATIONS"
            End If
            
            Call activate_optimizer
        
        Else
            ' no sources date recorded, it may be the first export
            msg = "FIRST EXPORT: " & vbNewLine & vbNewLine & _
                  "Everything will be exported, it could be quite long..."
        
        End If
        
        If MsgBox(msg, vbOKCancel + vbExclamation, "Export") = vbCancel Then GoTo cancelOp
        logger "make_sources", "INFO", "Activates Optimizer"
    End If

    If zip Then
        ' zip the app file
        step = "Zip the app file"
        logger "make_sources", "INFO", step
        Call zip_app_file
    End If
    
    ' run the export
    step = "Run VCS Export"
    logger "make_sources", "INFO", step
    Call ExportAllSource

    ' new sources date
    step = "Updates sources date"
    logger "make_sources", "INFO", step
    Call update_sources_date

    make_sources = opCompleted
    Exit Function
    
err:
    MsgBox "Unknown error - " & err.Description & " (#" & err.number & ")" & vbNewLine & "See the log file for more information", vbCritical, "CRITICAL ERROR"
    If err.number <> "60000" Then
        logger "make_sources", "ERROR", "Unknown error at: " & step & " - " & err.Description & "(#" & err.number & ")"
    End If
    
    Call update_oa_param("sources_date", CStr(old_sources_date))
    
    Exit Function
cancelOp:
    make_sources = opCancelled
    Exit Function
End Function


Public Function update_from_sources(Optional ByVal backup As Boolean) As Integer
'updates the application from the sources

    Dim backup_ok As Boolean
    Dim step, msg As String
    
    update_from_sources = opInterrupted
    
    If backup Then
        step = "Creates a backup of the app file"
        logger "update_from_sources", "INFO", step
        backup_ok = make_backup()
    
        If Not backup_ok Then
            logger "update_from_sources", "ERROR", "Error: unable to backup the app file, do it manually, then click OK"
            MsgBox "Error: unable to backup the app file, do it manually, then click OK", vbExclamation, "Backup"
        End If
    End If

    step = "Check for unexported work"
    logger "update_from_sources", "INFO", step
    msg = msg_list_to_export()
    If Len(msg) > 0 Then
        msg = "** IMPORT WARNING **" & vbNewLine & _
                    UCase(CurrentProject.name) & " is going to be updated " & _
                    "with the source files. " & vbNewLine & vbNewLine & _
                    "(!) FOLLOWING NON EXPORTED WORK WILL BE LOST (!): " & vbNewLine & _
                    msg & vbNewLine & _
                    "Are you sure you want to continue?"
        If MsgBox(msg, vbOKCancel + vbExclamation, "Warning") = vbCancel Then GoTo cancelOp
        If MsgBox("Really sure?", vbOKCancel + vbQuestion, "Warning") = vbCancel Then GoTo cancelOp
    End If

    step = "Run VCS Import"
    logger "update_from_sources", "INFO", step
    Call ImportAllSource
   
    step = "Cleaning obsolete objects in app"
    msg = "Following objects do not exist in the sources, do you want to delete them?" & _
          "" & CleanApp(True)
    If MsgBox(msg, vbYesNo, "Cleaning" = vbYes) Then
        Call CleanApp
    End If
   
    ' new sources date to keep the optimizer working
    step = "Updates sources date"
    logger "update_from_sources", "INFO", step
    Call update_sources_date
    
    update_from_sources = opCompleted
    Exit Function
err:
    MsgBox "Unknown error - " & err.Description & " (#" & err.number & ")" & vbNewLine & "See the log file for more information", vbCritical, "CRITICAL ERROR"
    If err.number <> "60000" Then
        logger "update_from_sources", "CRITICAL", "Unknown error at: " & step & " - " & err.Description & "(#" & err.number & ")"
    End If
    
    Exit Function
cancelOp:
    update_from_sources = opCancelled
    Exit Function
End Function


Public Function zip_app_file() As Boolean
    On Error GoTo UnknownErr
    Dim command, shortname As String
    
    zip_app_file = False
    
    shortname = Split(CurrentProject.name, ".")(0)
    
    'run the shell comand
    Call cmd("cd " & CurrentProject.Path & " & " & _
             "zip tmp_" & shortname & ".zip " & CurrentProject.name & _
             " & exit")
    
    'remove the old zip file
    If dir(CurrentProject.Path & "\" & shortname & ".zip") <> "" Then
        Kill CurrentProject.Path & "\" & shortname & ".zip"
    End If
    
    'rename the temporary zip
    Call cmd("cd " & CurrentProject.Path & " & " & _
            "ren tmp_" & shortname & ".zip" & " " & shortname & ".zip" & _
            " & exit")
    
    logger "zip_app_file", "INFO", CurrentProject.Path & "\" & CurrentProject.name & " zipped to " & CurrentProject.Path & "\" & shortname & ".zip"
    zip_app_file = True

end_:
    Exit Function
UnknownErr:
    logger "zip_app_file", "ERROR", "Unable to zip " & CurrentProject.Path & "\" & CurrentProject.name & " - " & err.Description
    MsgBox "Unknown error: unable to ZIP the app file, do it manually"
    GoTo end_
End Function

Public Function make_backup() As Boolean
    On Error GoTo err
    
    make_backup = False
    If dir(CurrentProject.Path & "\" & CurrentProject.name & ".old") <> "" Then
        Kill CurrentProject.Path & "\" & CurrentProject.name & ".old"
    End If

    Call cmd("copy " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & Chr(34) & _
             " " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & ".old" & Chr(34))
    
    logger "make_backup", "INFO", CurrentProject.Path & "\" & CurrentProject.name & " copied to " & CurrentProject.Path & "\" & CurrentProject.name & ".old"
    
    make_backup = True
    Exit Function
err:
    logger "make_backup", "ERROR", "Error during the backup of " & CurrentProject.name & ": " & err.Description
    MsgBox "Error during the backup of " & CurrentProject.name & ": " & err.Description & vbNewLine & "Do it manually"
End Function