correction apres test ctrl b

source/modules/OA_Main.bas

@@ -28,15 +28,11 @@ Dim step As String
     
     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
+        If get_sources_date() > #1/1/1900# Then
 
             msg = msg_list_to_export()
             logger "make_sources", "INFO", "Optimizer: ask for confirmation"
@@ -83,11 +79,22 @@ Dim step As String
     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:
+    If err.number <> "60000" Then
+        logger "make_sources", "CRITICAL", "Unknown error at: " & step & " - " & err.Description & "(#" & err.number & ")"
+    End If
+    MsgBox "Unknown error - " & err.Description & "(#" & err.number & ")", vbCritical, "CRITICAL ERROR"
+    
     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
@@ -136,11 +143,15 @@ Public Function update_from_sources(Optional ByVal options As String = "") As In
     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
+    If err.number <> "60000" Then
+        logger "update_from_sources", "CRITICAL", "Unknown error at: " & step & " - " & err.Description & "(#" & err.number & ")"
+    End If
+    MsgBox "Unknown error - " & err.Description & "(#" & err.number & ")", vbCritical, "CRITICAL ERROR"
+    
     Exit Function
 cancelOp:
     update_from_sources = opCancelled

source/modules/OA_Optimizer.bas

@@ -185,7 +185,7 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
     sql = "SELECT name, type FROM MSysObjects;"
     Set rsSys = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
     
-    Dim subdir, filename, objectname, obj_type_label As String
+    Dim subdir, filename, objectname, dirname, short_path As String
     Dim obj_type, obj_type_split As Variant
     Dim obj_type_num As Integer
     
@@ -196,6 +196,9 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
     Set oFSO = New Scripting.FileSystemObject
 
     For Each obj_type In Split( _
+        "tables|" & acTable & "," & _
+        "tbldef|" & acTable & "," & _
+        "queries|" & acQuery & "," & _
         "forms|" & acForm & "," & _
         "reports|" & acReport & "," & _
         "macros|" & acMacro & "," & _
@@ -204,31 +207,37 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
     )
     
         obj_type_split = Split(obj_type, "|")
-        obj_type_label = obj_type_split(0)
+        dirname = obj_type_split(0)
         obj_type_num = obj_type_split(1)
         
-        subdir = source_path & obj_type_label
+        subdir = source_path & dirname
         If Not oFSO.FolderExists(subdir) Then GoTo next_obj_type
         Set oFld = oFSO.GetFolder(subdir)
         
         For Each file In oFld.Files
             objectname = remove_ext(file.name)
+            objectname = to_accessname(objectname)
             rsSys.FindFirst (msys_type_filter(obj_type_num) & " AND [name]='" & objectname & "'")
             
             If rsSys.NoMatch Then
                 'object doesn't exist anymore
                 If Len(CleanDirs) > 0 Then CleanDirs = CleanDirs & "|"
-                CleanDirs = CleanDirs & (Replace(file.path, CurrentProject.path, "."))
+                short_path = Replace(file.path, CurrentProject.path, ".")
+                CleanDirs = CleanDirs & short_path
+                
                 If Not sim Then
                     oFSO.DeleteFile file
-                    logger "CleanDirs", "DEBUG", "> removed: " & file
+                    logger "CleanDirs", "DEBUG", "> removed: " & short_path
                 End If
             End If
             
         Next file
+        
+        
 next_obj_type:
     Next obj_type
-
+    
+    logger "CleanDirs", "INFO", "> Cleaned: " & CleanDirs
 
 End Function
 
@@ -237,6 +246,8 @@ Public Function files_exist_for(acType As Integer, name As String) As Boolean
     Dim source_path As String
     source_path = VCS_Dir.ProjectPath() & "source\"
     
+    name = to_filename(name)
+    
     Select Case acType
         Case acForm
             files_exist_for = (dir(source_path & "forms\" & name & ".bas") <> "")
@@ -266,4 +277,73 @@ Public Function files_exist_for(acType As Integer, name As String) As Boolean
     End Select
 
 
+End Function
+
+Public Function CleanApp(Optional ByVal sim As Boolean = False) As String
+' cleans the directories after a differential export
+' returns a list of the deleted relative file paths (string with '|' separator)
+' if 'sim' is set to True, doesn't process to the delete but still return the list
+    Dim subdir, filename, objectname, dirname, short_path As String
+    Dim obj_type, obj_type_split As Variant
+    Dim obj_type_num As Integer
+    Dim acType As Integer
+    
+    CleanApp = ""
+    
+    logger "CleanApp", "INFO", "Cleans the application objects"
+    
+    Dim rsSys As DAO.Recordset
+    Dim sql As String
+    
+    sql = "SELECT name, type FROM MSysObjects;"
+    Set rsSys = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
+    
+    On Error GoTo next_record
+    
+    rsSys.MoveFirst
+    Do Until rsSys.EOF = True
+        If Left(rsSys![name], 1) = "~" Or Left(rsSys![name], 4) = "MSys" Then GoTo next_record
+        
+        Select Case rsSys![Type]
+            Case -32768 'form
+                acType = acForm
+            Case -32766 'macro
+                acType = acMacro
+            Case -32764 'report
+                acType = acReport
+            Case 32761 'module
+                acType = acModule
+            Case 1 'local table
+                acType = acTable
+            Case 4  'linked table
+                acType = acTable
+            Case 5  'queries
+                acType = acQuery
+            Case Else
+                GoTo next_record
+        End Select
+        
+        If Not files_exist_for(acType, rsSys![name]) Then
+            
+            If sim = False Then
+                logger "CleanApp", "DEBUG", "> remove: " & rsSys![name] & " (" & acType & ")"
+                DoCmd.DeleteObject acType, rsSys![name]
+            End If
+            
+            If Len(CleanApp) > 0 Then CleanApp = CleanApp & "|"
+            CleanApp = CleanApp & rsSys![name]
+    
+        End If
+next_record:
+        If err.number > 0 Then
+            logger "CleanApp", "ERROR", "Unable to delete " & rsSys![name] & " (" & acType & "): " & err.Description
+            err.Clear
+        End If
+        rsSys.MoveNext
+        
+    Loop
+        
+
+    logger "CleanApp", "INFO", "> Cleaned: " & CleanApp
+
 End Function

source/modules/VCS_Dir.bas

@@ -28,7 +28,7 @@ End Sub
 Public Sub DelIfExist(ByVal path As String)
     On Error GoTo DelIfNotExist_Noop
     Kill path
-    logger "DelIfExist", "INFO", "Killed: " & path
+    logger "DelIfExist", "DEBUG", "Killed: " & path
 DelIfNotExist_Noop:
     On Error GoTo 0
 End Sub

source/modules/VCS_IE_Functions.bas

@@ -252,7 +252,7 @@ err:
     to_filename = object_name
 End Function
 
-Public Function to_accessname(file_name As String) As String
+Public Function to_accessname(ByVal file_name As String) As String
 On Error GoTo err
     ' return an object name from a file's name
     ' see function 'to_filename' for more informations

source/tables/ztbl_openaccess.txt

@@ -1,3 +1,3 @@
 key	val
 include_tables	ztbl_openaccess,tbl_commands,USysRegInfo
-sources_date	07/11/2016 14:09:52
+sources_date	07/11/2016 17:35:57