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 "frm_openaccess"

End Function

Public Function make_sources(Optional ByVal options As String = "") As Integer
'exports the source-code of the app
On Error GoTo err
Dim step As String

    make_sources = opInterrupted
    
    If InStr(options, "-d") Then set_debug_mode
    
    step = "Initialization"
    
    ' backup of the sources date, in case of error
    Dim old_sources_date As Date
    old_sources_date = oa_param("sources_date", #1/1/1900#)
    
    '*** If '-f' is not in the options: set the optimizer on
    If Not InStr(options, "-f") > 0 Then
        Dim msg As String
        
        If old_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


    ' new sources date, before export so that date will be exported with tbl_vsc
    step = "Updates sources date"
    logger "make_sources", "INFO", step
    Call update_sources_date

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

    make_sources = opCompleted
    Exit Function
err:
    Call update_oa_param("sources_date", CStr(old_sources_date))
    logger "make_sources", "CRITICAL", "Unknown error at: " & step & " - " & err.Description
    Exit Function
cancelOp:
    make_sources = opCancelled
    Exit Function
End Function


Public Function update_from_sources(Optional ByVal options As String = "") As Integer
'updates the application from the sources

    Dim backup As Boolean
    Dim step, msg As String
    
    update_from_sources = opInterrupted

    If InStr(options, "-d") Then set_debug_mode

    step = "Creates a backup of the app file"
    logger "update_from_sources", "INFO", step
    backup = make_backup()
    
    If Not backup 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

    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
   
    ' 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:
    logger "update_from_sources", "CRITICAL", "Unknown error at: " & step & " - " & err.Description
    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