Optimizer ok pour l'export

source/modules/Shell.bas

@@ -1,5 +1,11 @@
 Option Compare Database
 
+'****
+'*
+'* Shell: use shell commands
+'*
+'****
+
 Private Const STARTF_USESHOWWINDOW& = &H1
 Private Const NORMAL_PRIORITY_CLASS = &H20&
 Private Const INFINITE = -1&
@@ -47,6 +53,7 @@ Private Declare Function CloseHandle Lib "kernel32" (ByVal _
     hObject As Long) As Long
     
 Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
+' run a shell command and waits for its ending before return
     Dim proc As PROCESS_INFORMATION
     Dim start As STARTUPINFO
     Dim ret As Long
@@ -66,10 +73,11 @@ Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
     ret& = CloseHandle(proc.hProcess)
 End Sub
 
-Public Function cmd(ByVal command As String, Optional WindowStyle As Long = vbHide, Optional dir As String = "")
+Public Function cmd(ByVal command As String, Optional WindowStyle As Long = vbHide, Optional in_dir As String = "")
+' runs a comand with windows command line
 
-    If Len(dir) = 0 Then dir = CurrentProject.Path
+    If Len(in_dir) = 0 Then in_dir = CurrentProject.Path
 
-    Call ShellWait("cmd.exe /r cd " & dir & " & " & command, WindowStyle)
+    Call ShellWait("cmd.exe /r cd " & in_dir & " & " & command, WindowStyle)
 
 End Function

source/modules/VCS_Dir.bas

@@ -32,7 +32,16 @@ DelIfNotExist_Noop:
 End Sub
 
 ' Erase all *.`ext` files in `Path`.
-Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String)
+Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String, Optional ByVal force As Boolean = False)
+    
+    '### 13/10/2016: add optimizer
+    ' we don't want to clear the text files of the objects which will not be exported
+    'BUT we still want to clear obsolete files: see CleanDirs in optimizer
+    If optimizer_activated() And Not force Then
+        Exit Sub
+    End If
+    '###
+    
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     If Not fso.FolderExists(Path) Then Exit Sub

source/modules/VCS_File.bas

@@ -269,5 +269,4 @@ Public Function IsValidFileName(ByVal sName As String) As Boolean
 
     IsValidFileName = (InStr(sName, "\") = 0 And InStr(sName, "/") = 0 And InStr(sName, "*") = 0 And InStr(sName, "?") = 0 And InStr(sName, Chr(34)) = 0 And InStr(sName, "|") = 0 And InStr(sName, ":") = 0 And InStr(sName, ">") = 0 And InStr(sName, "<") = 0)
                         
-
 End Function

source/modules/VCS_IE_Functions.bas

@@ -92,15 +92,15 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
     srchPattern = srchPattern & ")"
 'Debug.Print srchPattern
     rxLine.Pattern = srchPattern
-    Dim fileName As String
-    fileName = dir$(Path & "*." & Ext)
+    Dim filename As String
+    filename = dir$(Path & "*." & Ext)
     Dim isReport As Boolean
     isReport = False
     
-    Do Until Len(fileName) = 0
+    Do Until Len(filename) = 0
         DoEvents
         Dim obj_name As String
-        obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+        obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
 
         Dim InFile As Object
         Set InFile = fso.OpenTextFile(Path & obj_name & "." & Ext, iomode:=ForReading, create:=False, Format:=TristateFalse)
@@ -170,12 +170,12 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
         OutFile.Close
         InFile.Close
 
-        fso.DeleteFile (Path & fileName)
+        fso.DeleteFile (Path & filename)
 
         Dim thisFile As Object
         Set thisFile = fso.GetFile(Path & obj_name & ".sanitize")
-        thisFile.Move (Path & fileName)
-        fileName = dir$()
+        thisFile.Move (Path & filename)
+        filename = dir$()
     Loop
 
 End Sub

source/modules/VCS_ImportExport.bas

@@ -190,7 +190,7 @@ next_doc:
     Call SysCmd(4, "Export tables")
     obj_path = source_path & "tables\"
     VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
-    VCS_Dir.ClearTextFilesFromDir obj_path, "txt"
+    VCS_Dir.ClearTextFilesFromDir obj_path, "txt", True
     
     Dim td As DAO.TableDef
     Dim tds As DAO.TableDefs
@@ -215,15 +215,14 @@ next_doc:
     
     Debug.Print VCS_String.PadRight("Exporting " & obj_type_label & "...", 24);
     
+    Dim update_this_tabledef As Boolean
+    
     For Each td In tds
     
         '### 11/10/2016: add optimizer
-        If optimizer_activated() Then
-            If Not is_dirty(acTable, td.name) Then
-                obj_count = obj_count + 1
-                GoTo next_td
-            End If
-        End If
+        'only update the table definition if this is a complete export
+        'or if the table definition has been modified since last export
+        update_this_tabledef = (Not optimizer_activated() Or is_dirty(acTable, td.name))
         '###
     
         If Not IsValidFileName(td.name) Then
@@ -239,7 +238,11 @@ next_doc:
         Left$(td.name, 1) <> "~" Then
             
             If Len(td.connect) = 0 Then ' this is not an external table
-                VCS_Table.ExportTableDef Db, td, td.name, obj_path
+                
+                If update_this_tabledef Then
+                    VCS_Table.ExportTableDef Db, td, td.name, obj_path
+                End If
+                
                 If include_tables = "*" Then
                     DoEvents
                     VCS_Table.ExportTableData CStr(td.name), source_path & "tables\"
@@ -258,7 +261,9 @@ Err_TableNotFound:
                 'else don't export table data
                 End If
             Else
-                VCS_Table.ExportLinkedTable td.name, obj_path
+                If update_this_tabledef Then
+                    VCS_Table.ExportLinkedTable td.name, obj_path
+                End If
             End If
             
             obj_count = obj_count + 1
@@ -282,7 +287,7 @@ next_td:
     obj_path = source_path & "relations\"
     VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
 
-    VCS_Dir.ClearTextFilesFromDir obj_path, "txt"
+    VCS_Dir.ClearTextFilesFromDir obj_path, "txt", True
 
     Dim aRelation As DAO.Relation
     
@@ -298,6 +303,18 @@ next_td:
     Next
     Debug.Print "[" & obj_count & "]"
     
+    '### 13/10/2016: add optimizer
+    ' cleans the obsolete files (see CleanDirs in optimizer)
+    If optimizer_activated() Then
+        Call SysCmd(4, "Cleans the directories")
+        Debug.Print VCS_String.PadRight("Cleans the directories", 24);
+        
+        Call CleanDirs
+        
+    End If
+    '###
+    
+    Call SysCmd(4, "Export done")
     Debug.Print "Done."
 End Sub
 
@@ -314,7 +331,7 @@ Public Sub ImportAllSource()
     Dim obj_type_label As String
     Dim obj_type_num As Integer
     Dim obj_count As Integer
-    Dim fileName As String
+    Dim filename As String
     Dim obj_name As String
     Dim ucs2 As Boolean
 
@@ -342,22 +359,22 @@ Public Sub ImportAllSource()
     End If
 
     obj_path = source_path & "queries\"
-    fileName = dir$(obj_path & "*.bas")
+    filename = dir$(obj_path & "*.bas")
     
     Dim tempFilePath As String
     tempFilePath = VCS_File.TempFile()
     
-    If Len(fileName) > 0 Then
+    If Len(filename) > 0 Then
         Debug.Print VCS_String.PadRight("Importing queries...", 24);
         obj_count = 0
-        Do Until Len(fileName) = 0
+        Do Until Len(filename) = 0
             DoEvents
-            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
-            VCS_IE_Functions.ImportObject acQuery, obj_name, obj_path & fileName, VCS_File.UsingUcs2
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            VCS_IE_Functions.ImportObject acQuery, obj_name, obj_path & filename, VCS_File.UsingUcs2
             VCS_IE_Functions.ExportObject acQuery, obj_name, tempFilePath, VCS_File.UsingUcs2
             VCS_IE_Functions.ImportObject acQuery, obj_name, tempFilePath, VCS_File.UsingUcs2
             obj_count = obj_count + 1
-            fileName = dir$()
+            filename = dir$()
         Loop
         Debug.Print "[" & obj_count & "]"
     End If
@@ -369,12 +386,12 @@ Public Sub ImportAllSource()
 
     ' restore table definitions
     obj_path = source_path & "tbldef\"
-    fileName = dir$(obj_path & "*.sql")
-    If Len(fileName) > 0 Then
+    filename = dir$(obj_path & "*.sql")
+    If Len(filename) > 0 Then
         Debug.Print VCS_String.PadRight("Importing tabledefs...", 24);
         obj_count = 0
-        Do Until Len(fileName) = 0
-            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+        Do Until Len(filename) = 0
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             If DebugOutput Then
                 If obj_count = 0 Then
                     Debug.Print
@@ -384,7 +401,7 @@ Public Sub ImportAllSource()
             End If
             VCS_Table.ImportTableDef CStr(obj_name), obj_path
             obj_count = obj_count + 1
-            fileName = dir$()
+            filename = dir$()
         Loop
         Debug.Print "[" & obj_count & "]"
     End If
@@ -393,12 +410,12 @@ Public Sub ImportAllSource()
     SysCmd acSysCmdUpdateMeter, counter
     
     ' restore linked tables - we must have access to the remote store to import these!
-    fileName = dir$(obj_path & "*.LNKD")
-    If Len(fileName) > 0 Then
+    filename = dir$(obj_path & "*.LNKD")
+    If Len(filename) > 0 Then
         Debug.Print VCS_String.PadRight("Importing Linked tabledefs...", 24);
         obj_count = 0
-        Do Until Len(fileName) = 0
-            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+        Do Until Len(filename) = 0
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             If DebugOutput Then
                 If obj_count = 0 Then
                     Debug.Print
@@ -408,7 +425,7 @@ Public Sub ImportAllSource()
             End If
             VCS_Table.ImportLinkedTable CStr(obj_name), obj_path
             obj_count = obj_count + 1
-            fileName = dir$()
+            filename = dir$()
         Loop
         Debug.Print "[" & obj_count & "]"
     End If
@@ -418,16 +435,16 @@ Public Sub ImportAllSource()
     
     ' NOW we may load data
     obj_path = source_path & "tables\"
-    fileName = dir$(obj_path & "*.txt")
-    If Len(fileName) > 0 Then
+    filename = dir$(obj_path & "*.txt")
+    If Len(filename) > 0 Then
         Debug.Print VCS_String.PadRight("Importing tables...", 24);
         obj_count = 0
-        Do Until Len(fileName) = 0
+        Do Until Len(filename) = 0
             DoEvents
-            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             VCS_Table.ImportTableData CStr(obj_name), obj_path
             obj_count = obj_count + 1
-            fileName = dir$()
+            filename = dir$()
         Loop
         Debug.Print "[" & obj_count & "]"
     End If
@@ -437,17 +454,17 @@ Public Sub ImportAllSource()
     
     'load Data Macros - not DRY!
     obj_path = source_path & "tbldef\"
-    fileName = dir$(obj_path & "*.xml")
-    If Len(fileName) > 0 Then
+    filename = dir$(obj_path & "*.xml")
+    If Len(filename) > 0 Then
         Debug.Print VCS_String.PadRight("Importing Data Macros...", 24);
         obj_count = 0
-        Do Until Len(fileName) = 0
+        Do Until Len(filename) = 0
             DoEvents
-            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             'VCS_Table.ImportTableData CStr(obj_name), obj_path
             VCS_DataMacro.ImportDataMacros obj_name, obj_path
             obj_count = obj_count + 1
-            fileName = dir$()
+            filename = dir$()
         Loop
         Debug.Print "[" & obj_count & "]"
     End If
@@ -471,27 +488,27 @@ Public Sub ImportAllSource()
         obj_path = source_path & obj_type_label & "\"
          
             
-        fileName = dir$(obj_path & "*.bas")
-        If Len(fileName) > 0 Then
+        filename = dir$(obj_path & "*.bas")
+        If Len(filename) > 0 Then
             Debug.Print VCS_String.PadRight("Importing " & obj_type_label & "...", 24);
             obj_count = 0
-            Do Until Len(fileName) = 0
+            Do Until Len(filename) = 0
                 ' DoEvents no good idea!
-                obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+                obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
                 If obj_type_label = "modules" Then
                     ucs2 = False
                 Else
                     ucs2 = VCS_File.UsingUcs2
                 End If
                 If IsNotVCS(obj_name) Then
-                    VCS_IE_Functions.ImportObject obj_type_num, obj_name, obj_path & fileName, ucs2
+                    VCS_IE_Functions.ImportObject obj_type_num, obj_name, obj_path & filename, ucs2
                     obj_count = obj_count + 1
                 Else
                     If ArchiveMyself Then
                             MsgBox "Module " & obj_name & " could not be updated while running. Ensure latest version is included!", vbExclamation, "Warning"
                     End If
                 End If
-                fileName = dir$()
+                filename = dir$()
             Loop
             Debug.Print "[" & obj_count & "]"
         
@@ -507,13 +524,13 @@ Public Sub ImportAllSource()
     obj_count = 0
     
     obj_path = source_path & "reports\"
-    fileName = dir$(obj_path & "*.pv")
-    Do Until Len(fileName) = 0
+    filename = dir$(obj_path & "*.pv")
+    Do Until Len(filename) = 0
         DoEvents
-        obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
-        VCS_Report.ImportPrintVars obj_name, obj_path & fileName
+        obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+        VCS_Report.ImportPrintVars obj_name, obj_path & filename
         obj_count = obj_count + 1
-        fileName = dir$()
+        filename = dir$()
     Loop
     Debug.Print "[" & obj_count & "]"
     
@@ -521,12 +538,12 @@ Public Sub ImportAllSource()
     Debug.Print VCS_String.PadRight("Importing Relations...", 24);
     obj_count = 0
     obj_path = source_path & "relations\"
-    fileName = dir$(obj_path & "*.txt")
-    Do Until Len(fileName) = 0
+    filename = dir$(obj_path & "*.txt")
+    Do Until Len(filename) = 0
         DoEvents
-        VCS_Relation.ImportRelation obj_path & fileName
+        VCS_Relation.ImportRelation obj_path & filename
         obj_count = obj_count + 1
-        fileName = dir$()
+        filename = dir$()
     Loop
     Debug.Print "[" & obj_count & "]"
     DoEvents

source/modules/VCS_Loader.bas

@@ -30,14 +30,14 @@ Fin_DirCheck:
 
     On Error GoTo Err_DelHandler
 
-    Dim fileName As String
+    Dim filename As String
     'Use the list of files to import as the list to delete
-    fileName = dir$(SourceDirectory & "*.bas")
-    Do Until Len(fileName) = 0
+    filename = dir$(SourceDirectory & "*.bas")
+    Do Until Len(filename) = 0
         'strip file type from file name
-        fileName = Left$(fileName, InStrRev(fileName, ".bas") - 1)
-        DoCmd.DeleteObject acModule, fileName
-        fileName = dir$()
+        filename = Left$(filename, InStrRev(filename, ".bas") - 1)
+        DoCmd.DeleteObject acModule, filename
+        filename = dir$()
     Loop
 
     GoTo Fin_DelHandler
@@ -49,17 +49,17 @@ Err_DelHandler:
     Resume Next
     
 Fin_DelHandler:
-    fileName = vbNullString
+    filename = vbNullString
 
 'import files from specific dir? or allow user to input their own dir?
 On Error GoTo Err_LoadHandler
 
-    fileName = dir$(SourceDirectory & "*.bas")
-    Do Until Len(fileName) = 0
+    filename = dir$(SourceDirectory & "*.bas")
+    Do Until Len(filename) = 0
         'strip file type from file name
-        fileName = Left$(fileName, InStrRev(fileName, ".bas") - 1)
-        Application.LoadFromText acModule, fileName, SourceDirectory & fileName & ".bas"
-        fileName = dir$()
+        filename = Left$(filename, InStrRev(filename, ".bas") - 1)
+        Application.LoadFromText acModule, filename, SourceDirectory & filename & ".bas"
+        filename = dir$()
     Loop
 
     GoTo Fin_LoadHandler

source/modules/VCS_Reference.bas

@@ -13,16 +13,16 @@ Public Function ImportReferences(ByVal obj_path As String) As Boolean
     Dim GUID As String
     Dim Major As Long
     Dim Minor As Long
-    Dim fileName As String
+    Dim filename As String
     Dim refName As String
     
-    fileName = dir$(obj_path & "references.csv")
-    If Len(fileName) = 0 Then
+    filename = dir$(obj_path & "references.csv")
+    If Len(filename) = 0 Then
         ImportReferences = False
         Exit Function
     End If
     Set fso = CreateObject("Scripting.FileSystemObject")
-    Set InFile = fso.OpenTextFile(obj_path & fileName, iomode:=ForReading, create:=False, Format:=TristateFalse)
+    Set InFile = fso.OpenTextFile(obj_path & filename, iomode:=ForReading, create:=False, Format:=TristateFalse)
     
 On Error GoTo failed_guid
     Do Until InFile.AtEndOfStream

source/modules/VCS_Table.bas

@@ -18,7 +18,7 @@ Private Type structEnforce
 End Type
 
 ' keeping "on Update" relations to be complemented after table creation
-Private K() As structEnforce
+Private k() As structEnforce
 
 
 Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal obj_path As String)
@@ -109,8 +109,8 @@ End Function
 ' Save a Table Definition as SQL statement
 Public Sub ExportTableDef(Db As DAO.Database, td As DAO.TableDef, ByVal tableName As String, _
                           ByVal directory As String)
-    Dim fileName As String
-    fileName = directory & tableName & ".sql"
+    Dim filename As String
+    filename = directory & tableName & ".sql"
     Dim sql As String
     Dim fieldAttributeSql As String
     Dim idx As DAO.Index
@@ -120,7 +120,7 @@ Public Sub ExportTableDef(Db As DAO.Database, td As DAO.TableDef, ByVal tableNam
     Dim ff As Object
     'Debug.Print tableName
     Set fso = CreateObject("Scripting.FileSystemObject")
-    Set OutFile = fso.CreateTextFile(fileName, overwrite:=True, Unicode:=False)
+    Set OutFile = fso.CreateTextFile(filename, overwrite:=True, Unicode:=False)
     sql = "CREATE TABLE " & strName(tableName) & " (" & vbCrLf
     For Each fi In td.Fields
         sql = sql & "  " & strName(fi.name) & " "
@@ -535,20 +535,20 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
       p = InStr(buf, "ON " & s & " CASCADE")
       Do While p > 0
           n = n + 1
-          ReDim Preserve K(n)
-          K(n).table = tblName
-          K(n).isUpdate = (s = "UPDATE")
+          ReDim Preserve k(n)
+          k(n).table = tblName
+          k(n).isUpdate = (s = "UPDATE")
           
           buf = Left$(buf, p - 1) & Mid$(buf, p + 18)
           p = InStrRev(buf, "REFERENCES", p)
           p1 = InStr(p, buf, "(")
-          K(n).foreignFields = Split(VCS_String.SubString(p1, buf, "(", ")"), ",")
-          K(n).foreignTable = Trim$(Mid$(buf, p + 10, p1 - p - 10))
+          k(n).foreignFields = Split(VCS_String.SubString(p1, buf, "(", ")"), ",")
+          k(n).foreignTable = Trim$(Mid$(buf, p + 10, p1 - p - 10))
           p = InStrRev(buf, "CONSTRAINT", p1)
           p1 = InStrRev(buf, "FOREIGN KEY", p1)
           If (p1 > 0) And (p > 0) And (p1 > p) Then
           ' multifield index
-              K(n).refFields = Split(VCS_String.SubString(p1, buf, "(", ")"), ",")
+              k(n).refFields = Split(VCS_String.SubString(p1, buf, "(", ")"), ",")
           ElseIf p1 = 0 Then
           ' single field
           End If
@@ -557,17 +557,17 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
     Next
     On Error Resume Next
     For i = 0 To n
-        strMsg = K(i).table & " to " & K(i).foreignTable
+        strMsg = k(i).table & " to " & k(i).foreignTable
         strMsg = strMsg & "(  "
-        For j = 0 To UBound(K(i).refFields)
-            strMsg = strMsg & K(i).refFields(j) & ", "
+        For j = 0 To UBound(k(i).refFields)
+            strMsg = strMsg & k(i).refFields(j) & ", "
         Next j
         strMsg = Left$(strMsg, Len(strMsg) - 2) & ") to ("
-        For j = 0 To UBound(K(i).foreignFields)
-            strMsg = strMsg & K(i).foreignFields(j) & ", "
+        For j = 0 To UBound(k(i).foreignFields)
+            strMsg = strMsg & k(i).foreignFields(j) & ", "
         Next j
         strMsg = Left$(strMsg, Len(strMsg) - 2) & ") Check "
-        If K(i).isUpdate Then
+        If k(i).isUpdate Then
             strMsg = strMsg & " on update cascade " & vbCrLf
         Else
             strMsg = strMsg & " on delete cascade " & vbCrLf

source/modules/optimizer.bas

@@ -1,35 +1,41 @@
 Option Compare Database
 Option Explicit
 
+'****
+'*
+'* Optimizer for VCS: only import/export objects which were updated since last import/export
+'*
+'****
+
+Public Function is_dirty(acType As Integer, name As String)
+' has the object been modified since last export?
+
+    is_dirty = (get_last_update_date(acType, name) > get_sources_date)
+
+End Function
+
+
 Public Function get_last_update_date(ByVal acType As Integer, ByVal name As String)
 On Error GoTo err
+'get the date of the last update of an object
 
     Select Case acType
-    
+        'case table or query: get [DateUpdate] in MSysObjects
         Case acTable
-            
             get_last_update_date = DFirst("DateUpdate", "MSysObjects", "([Type]=1 or [Type]=4 or [Type]=6) and [name]='" & name & "'")
-        
         Case acQuery
-        
             get_last_update_date = DFirst("DateUpdate", "MSysObjects", "[Type]=5 and [name]='" & name & "'")
         
+        'MSysObjects is not reliable for other objects,
+        'So we used the DateModified property:
         Case acForm
-            
             get_last_update_date = CurrentProject.AllForms(name).DateModified
-        
         Case acReport
-            
             get_last_update_date = CurrentProject.AllReports(name).DateModified
-        
         Case acMacro
-            
             get_last_update_date = CurrentProject.AllMacros(name).DateModified
-        
         Case acModule
-            
             get_last_update_date = CurrentProject.AllModules(name).DateModified
-            
     End Select
     
     Exit Function
@@ -38,7 +44,10 @@ err:
     get_last_update_date = #1/1/1900#
 End Function
 
+
+'*** displays modified (dirties) objects
 Public Function list_modified(acType As Integer)
+' returns a list (string with ';' separator) of the objects wich were updated since last export
     Dim sources_date As Date
     
     list_modified = ""
@@ -53,12 +62,17 @@ Public Function list_modified(acType As Integer)
     rs.MoveFirst
     
     Do Until rs.EOF
-        If rs![dateupdate] > sources_date Then
-            If Len(list_modified) > 0 Then
-                list_modified = list_modified & ";" & rs![name]
-            Else
-                list_modified = rs![name]
+        If Left$(rs![name], 4) <> "MSys" And _
+            Left$(rs![name], 1) <> "~" Then
+            
+            If rs![dateupdate] > sources_date Then
+                If Len(list_modified) > 0 Then
+                    list_modified = list_modified & ";" & rs![name]
+                Else
+                    list_modified = rs![name]
+                End If
             End If
+            
         End If
         rs.MoveNext
     Loop
@@ -68,6 +82,7 @@ emptylist:
 End Function
 
 Public Function msg_list_modified() As String
+'returns a formatted text listing all of the objects which were updated since last export of the sources
     Dim lstmod, obj_type_split, obj_type_label, obj_type_num As String
     Dim obj_type, objname As Variant
     
@@ -95,23 +110,19 @@ Public Function msg_list_modified() As String
             Next objname
         End If
     Next obj_type
-    
 
 End Function
+'******
 
-Public Function is_dirty(acType As Integer, name As String)
-
-    is_dirty = (get_last_update_date(acType, name) > get_sources_date)
 
-End Function
 
+'*** sources_date is the date of the last export of the sources files
 Public Function get_sources_date() As Date
 
     get_sources_date = CDate(vcs_param("sources_date", "01/01/1900 00:00:00"))
 
 End Function
 
-
 Public Sub update_sources_date()
 
 If Not vcs_tbl_exists() Then
@@ -121,10 +132,82 @@ End If
 Call update_vcs_param("sources_date", CStr(Now))
 
 End Sub
+'*****
 
+'**** cleans sources or objects after differential import/export
+Public Function CleanDirs(Optional ByVal sim As Boolean = False)
+' 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
+    CleanDirs = ""
+    
+    Dim source_path As String
+    source_path = VCS_Dir.ProjectPath() & "source\"
+    
+    Dim rsSys As DAO.Recordset
+    Dim sql As String
+    
+    sql = "SELECT name, type FROM MSysObjects;"
+    Set rsSys = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
+    
+    Dim subdir, filename, objectname, obj_type_label As String
+    Dim obj_type, obj_type_split As Variant
+    Dim obj_type_num As Integer
+    
+    Dim oFSO As Scripting.FileSystemObject
+    Dim oFld As Scripting.folder
+    Dim file As Scripting.file
+    'Instanciation du FSO
+    Set oFSO = New Scripting.FileSystemObject
 
+    For Each obj_type In Split( _
+        "forms|" & acForm & "," & _
+        "reports|" & acReport & "," & _
+        "macros|" & acMacro & "," & _
+        "modules|" & acModule _
+        , "," _
+    )
+    
+        obj_type_split = Split(obj_type, "|")
+        obj_type_label = obj_type_split(0)
+        obj_type_num = obj_type_split(1)
+        
+        subdir = source_path & obj_type_label
+        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)
+            rsSys.FindFirst (typefilter(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, "."))
+                If Not sim Then
+                    oFSO.DeleteFile file
+                End If
+            End If
+            
+        Next file
+next_obj_type:
+    Next obj_type
+
+
+End Function
 
-'NB: types msys
+
+Public Sub CleanObjects()
+
+
+
+
+End Sub
+
+'*** utilities
+Private Function typefilter(acType) As String
+'returns a sql filter string for the object type
+'NB: types in msysobjects table
 '-32768 = Form
 '-32766 = Macro
 '-32764 = Report
@@ -140,8 +223,6 @@ End Sub
 '6   Table - Linked Access Tables
 '8   SubDataSheets
 
-Private Function typefilter(acType) As String
-
     Select Case acType
         Case acTable
             typefilter = "([Type]=1 or [Type]=4 or [Type]=6)"
@@ -163,4 +244,25 @@ Exit Function
 typerror:
     MsgBox "typerror:" & acType & " is not a valid object type"
     typefilter = ""
+End Function
+
+
+
+Public Function remove_ext(ByVal filename As String) As String
+    ' removes the extension of a file name
+    If Not InStr(filename, ".") > 0 Then
+        remove_ext = filename
+        Exit Function
+    End If
+
+    Dim splitted_name As Variant
+    splitted_name = Split(filename, ".")
+
+    Dim i As Integer
+    remove_ext = ""
+    For i = 0 To (UBound(Split(filename, ".")) - 1)
+        If Len(remove_ext) > 0 Then remove_ext = remove_ext & "."
+        remove_ext = remove_ext & Split(filename, ".")(i)
+    Next i
+
 End Function

source/modules/vcs.bas

@@ -1,6 +1,12 @@
 Option Compare Database
 Dim private_optimizer As Boolean
 
+'****
+'*
+'* Main methods for VCS add-in
+'*
+'****
+
 Public Function vcsprompt()
 
     DoCmd.OpenForm "frm_vcs"
@@ -8,30 +14,53 @@ Public Function vcsprompt()
 End Function
 
 
-Public Function make_sources(ByVal options As String)
-'creates the source-code of the app
+Public Function make_sources(Optional ByVal options As String = "")
+'exports the source-code of the app
+On Error GoTo err
+Dim step As String
 
+    step = "Initialization"
     If Not InStr(options, "-f") > 0 Then
         Dim msg As String
-        msg = "** VCS OPTIMIZER **"
-        msg = msg & vbNewLine & "Seuls les objets suivant seront exportés:" & vbNewLine
-        msg = msg & msg_list_modified()
-        If Not MsgBox(msg, vbOKCancel) = vbCancel Then Exit Function
+        msg = msg_list_modified()
+        
+        If Not Len(msg) > 0 Then
+            msg = "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)."
+            If MsgBox(msg, vbOKCancel + vbExclamation, "Export") = vbCancel Then Exit Function
+        Else
+            msg = "** VCS OPTIMIZER **" & vbNewLine & "Seuls les objets suivant seront exportés:" & vbNewLine & msg
+            If MsgBox(msg, vbOKCancel) = vbCancel Then Exit Function
+        End If
+        
         Call activate_optimizer
     End If
 
-    Debug.Print "Zip the app file"
+    step = "Updates sources date"
+    Debug.Print step
+    Call update_sources_date
+    Debug.Print "> done"
+
+    step = "Zip the app file"
+    Debug.Print step
     Call zip_app_file
     Debug.Print "> done"
     
-    Debug.Print "Run VCS Export"
+    step = "Run VCS Export"
+    Debug.Print step
     Call ExportAllSource
     Debug.Print "> done"
 
+    Exit Function
+err:
+    MsgBox "makesources - Unknown error at: " & step & vbNewLine & err.Description
 End Function
 
 
-Public Function update_from_sources()
+Public Function update_from_sources(Optional ByVal options As String = "")
 'updates the application from the sources
 Dim backup As Boolean
 
@@ -126,8 +155,6 @@ Public Function gitcmd(args)
 
 End Function
 
-
-
 Public Function zip_app_file() As Boolean
     On Error GoTo err
     Dim command, shortname As String
@@ -184,14 +211,14 @@ err:
 End Function
 
 Public Function complete_gitignore()
-' creates or complete the .gitignore file of the repo
-Dim gitignore_path, str_existing_keys, str As String
-
-Dim keys() As String
-keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb;*.accde;*.mde;*.accda", ";")
-
-gitignore_path = CurrentProject.Path & "\.gitignore"
-
+    ' creates or complete the .gitignore file of the repo
+    Dim gitignore_path, str_existing_keys, str As String
+    
+    Dim keys() As String
+    keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb;*.accde;*.mde;*.accda", ";")
+    
+    gitignore_path = CurrentProject.Path & "\.gitignore"
+    
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     

source/references.csv

@@ -2,3 +2,4 @@
 {4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28},12,0
 {2A75196C-D9EB-4129-B803-931327F72D5C},2,8
 {00000600-0000-0010-8000-00AA006D2EA4},2,8
+{420B2830-E718-11CF-893D-00A0C9054228},1,0

source/tables/modele_ztbl_vcs.txt

@@ -1,2 +0,0 @@
-key	val
-include_tables	ztbl_vcs,tbl_commands

source/tables/tbl_commands.txt

@@ -2,4 +2,4 @@
 configure_git_repo	config_git_repo	Configure an existing Git repository to be used with VCS	3	Faux
 gitcmd	gitcmd	Runs a git command	4	Vrai
 make_sources	make_sources	Makes the source-code files from the current project (-f to force a complete export)	1	Vrai
-update_from_sources	update_from_sources	Update the current project within the source-code files	2	Faux
+update_from_sources	update_from_sources	Update the current project within the source-code files (-f to force a complete export)	2	Vrai

source/tbldef/modele_ztbl_vcs.sql

@@ -1,4 +0,0 @@
-CREATE TABLE [modele_ztbl_vcs] (
-  [key] VARCHAR (48) CONSTRAINT [Index_516D4AEC_BCC1_4E6B] UNIQUE  CONSTRAINT [PrimaryKey] PRIMARY KEY  UNIQUE  NOT NULL ,
-  [val] VARCHAR (96)
-)