Browse Source

Corrections bugs import-export (cf. issue tests > ctrl A1)

olivier.massot 9 năm trước cách đây
mục cha
commit
a56a068833

+ 2 - 2
.gitignore

@@ -1,6 +1,6 @@
 *.komodoproject
-test\
-errors\*
+test/
+errors/
 *.accdb
 *.laccdb
 *.accda

+ 0 - 0
erreurs import.TXT


BIN
errors/analytique_import_form.PNG


BIN
errors/analytique_import_form2.PNG


BIN
errors/analytique_import_form3.PNG


BIN
errors/analytique_import_printvars.PNG


BIN
errors/analytique_import_report.PNG


BIN
errors/autorisation_tbl.PNG


BIN
errors/autorisation_tbl_2.PNG


+ 76 - 0
source/modules/VCS_Controls.bas

@@ -0,0 +1,76 @@
+Option Compare Database
+
+'****
+'*
+'* VCS checks
+'*
+'****
+
+
+Sub diagnostic()
+    Dim obj As Object
+    Dim count As Integer
+    Dim td As TableDef
+    Dim qd As QueryDef
+    
+    Dim oFSO As Object
+    Set oFSO = CreateObject("Scripting.FileSystemObject")
+    Dim oFile As Object
+    Set oFile = oFSO.CreateTextFile("c:\applis_parc\ztest\diag_" & CurrentProject.name & ".txt", ForAppending)
+    
+    
+    oFile.WriteLine ("# tbl def")
+    count = 0
+    For Each td In CurrentDb.TableDefs
+        'Debug.Print td.Name
+        oFile.WriteLine td.name
+        count = count + 1
+    Next
+    Debug.Print "tbldef", count
+    
+    oFile.WriteLine ("# query def")
+    count = 0
+    For Each qd In CurrentDb.QueryDefs
+        'Debug.Print qd.Name
+        oFile.WriteLine qd.name
+        count = count + 1
+    Next
+    Debug.Print "queries", count
+    
+    oFile.WriteLine ("# reports")
+    count = 0
+    For Each obj In CurrentProject.AllReports()
+        'Debug.Print obj.Name
+        oFile.WriteLine obj.name
+        count = count + 1
+    Next
+    Debug.Print "reports", count
+    
+    oFile.WriteLine ("# forms")
+    count = 0
+    For Each obj In CurrentProject.AllForms()
+        'Debug.Print obj.Name
+        oFile.WriteLine obj.name
+        count = count + 1
+    Next
+    Debug.Print "forms", count
+    
+    oFile.WriteLine ("# macros")
+    count = 0
+    For Each obj In CurrentProject.AllMacros()
+        'Debug.Print obj.Name
+        oFile.WriteLine obj.name
+        count = count + 1
+    Next
+    Debug.Print "macros", count
+    
+    oFile.WriteLine ("# modules")
+    count = 0
+    For Each obj In CurrentProject.AllModules()
+        oFile.WriteLine obj.name
+        'Debug.Print obj.Name
+        count = count + 1
+    Next
+    Debug.Print "modules", count
+    
+End Sub

+ 10 - 10
source/modules/VCS_DataMacro.bas

@@ -11,12 +11,12 @@ Option Explicit
 
 Public Sub ExportDataMacros(ByVal tableName As String, ByVal directory As String)
     On Error GoTo Err_export
-    Dim filePath As String
+    Dim filepath As String
     
-    filePath = directory & tableName & ".xml"
+    filepath = directory & tableName & ".xml"
 
-    VCS_IE_Functions.ExportObject acTableDataMacro, tableName, filePath, VCS_File.UsingUcs2
-    FormatDataMacro filePath
+    VCS_IE_Functions.ExportObject acTableDataMacro, tableName, filepath, VCS_File.UsingUcs2
+    FormatDataMacro filepath
 
     Exit Sub
 
@@ -26,10 +26,10 @@ End Sub
 
 Public Sub ImportDataMacros(ByVal tableName As String, ByVal directory As String)
     On Error GoTo Err_import
-    Dim filePath As String
+    Dim filepath As String
     
-    filePath = directory & tableName & ".xml"
-    VCS_IE_Functions.ImportObject acTableDataMacro, tableName, filePath, VCS_File.UsingUcs2
+    filepath = directory & tableName & ".xml"
+    VCS_IE_Functions.ImportObject acTableDataMacro, tableName, filepath, VCS_File.UsingUcs2
     
     Exit Sub
     
@@ -39,7 +39,7 @@ End Sub
 
 'Splits exported DataMacro XML onto multiple lines
 'Allows git to find changes within lines using diff
-Private Sub FormatDataMacro(ByVal filePath As String)
+Private Sub FormatDataMacro(ByVal filepath As String)
 
     Dim saveStream As Object 'ADODB.Stream
 
@@ -55,7 +55,7 @@ Private Sub FormatDataMacro(ByVal filePath As String)
     objStream.Charset = "utf-8"
     objStream.Type = 2 'adTypeText
     objStream.Open
-    objStream.LoadFromFile (filePath)
+    objStream.LoadFromFile (filepath)
     
     Do While Not objStream.EOS
         strData = objStream.ReadText(-2) 'adReadLine
@@ -71,7 +71,7 @@ Private Sub FormatDataMacro(ByVal filePath As String)
     Loop
     
     objStream.Close
-    saveStream.SaveToFile filePath, 2 'adSaveCreateOverWrite
+    saveStream.SaveToFile filepath, 2 'adSaveCreateOverWrite
     saveStream.Close
 
 End Sub

+ 9 - 9
source/modules/VCS_Dir.bas

@@ -6,7 +6,7 @@ Option Explicit
 
 ' Path/Directory of the current database file.
 Public Function ProjectPath() As String
-    ProjectPath = CurrentProject.Path
+    ProjectPath = CurrentProject.path
     If Right$(ProjectPath, 1) <> "\" Then ProjectPath = ProjectPath & "\"
 End Function
 
@@ -16,23 +16,23 @@ Public Function SourcePath() As String
 End Function
 
 ' Create folder `Path`. Silently do nothing if it already exists.
-Public Sub MkDirIfNotExist(ByVal Path As String)
+Public Sub MkDirIfNotExist(ByVal path As String)
     On Error GoTo MkDirIfNotexist_noop
-    MkDir Path
+    MkDir path
 MkDirIfNotexist_noop:
     On Error GoTo 0
 End Sub
 
 ' Delete a file if it exists.
-Public Sub DelIfExist(ByVal Path As String)
+Public Sub DelIfExist(ByVal path As String)
     On Error GoTo DelIfNotExist_Noop
-    Kill Path
+    Kill path
 DelIfNotExist_Noop:
     On Error GoTo 0
 End Sub
 
 ' Erase all *.`ext` files in `Path`.
-Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String, Optional ByVal force As Boolean = False)
+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
@@ -44,11 +44,11 @@ Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String, Opti
     
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
-    If Not fso.FolderExists(Path) Then Exit Sub
+    If Not fso.FolderExists(path) Then Exit Sub
 
     On Error GoTo ClearTextFilesFromDir_noop
-    If dir$(Path & "*." & Ext) <> vbNullString Then
-        fso.DeleteFile Path & "*." & Ext
+    If dir$(path & "*." & Ext) <> vbNullString Then
+        fso.DeleteFile path & "*." & Ext
     End If
     
 ClearTextFilesFromDir_noop:

+ 19 - 0
source/modules/VCS_File.bas

@@ -170,6 +170,8 @@ Public Sub ConvertUtf8Ucs2(ByVal Source As String, ByVal dest As String)
     f_in = BinOpen(Source, "r")
     f_out = BinOpen(dest, "w")
 
+    Debug.Print Source, dest
+
     Do While Not f_in.at_eof
         in_1 = BinRead(f_in)
         If (in_1 And &H80) = 0 Then
@@ -252,6 +254,23 @@ Public Function UsingUcs2() As Boolean
     fso.DeleteFile (tempFileName)
 End Function
 
+Public Function ReadFile(filepath As String, Optional encoding As String = "utf-8") As String
+    Dim objStream As ADODB.Stream
+    Set objStream = New ADODB.Stream
+
+    objStream.Charset = "x-ansi"
+    objStream.Open
+    objStream.LoadFromFile (filepath)
+    ReadFile = objStream.ReadText()
+    
+    objStream.Close
+    Set objStream = Nothing
+End Function
+
+
+
+
+
 ' Generate Random / Unique tempprary file name.
 Public Function TempFile(Optional ByVal sPrefix As String = "VBA") As String
     Dim sTmpPath As String * 512

+ 2 - 2
source/modules/VCS_Git.bas

@@ -2,7 +2,7 @@ Option Compare Database
 
 Public Function is_git_repo() As Boolean
 ' returns True if current app dir is a git repository
-    is_git_repo = (dir(CurrentProject.Path & "\.git\", vbDirectory) <> "")
+    is_git_repo = (dir(CurrentProject.path & "\.git\", vbDirectory) <> "")
     
 End Function
 
@@ -21,7 +21,7 @@ Public Function complete_gitignore()
     Dim keys() As String
     keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb;*.accde;*.mde;*.accda", ";")
     
-    gitignore_path = CurrentProject.Path & "\.gitignore"
+    gitignore_path = CurrentProject.path & "\.gitignore"
     
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")

+ 86 - 11
source/modules/VCS_IE_Functions.bas

@@ -10,6 +10,9 @@ Private Const StripPublishOption As Boolean = True
 Public Const ForReading = 1, ForWriting = 2, ForAppending = 8
 Public Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2
 
+' constants for names conversion
+Public Const ForbiddenCars = "34,42,47,58,60,62,63,92,124"
+
 
 ' Can we export without closing the form?
 
@@ -17,13 +20,17 @@ Public Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2
 Public Sub ExportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _
                     ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)
 
-
     VCS_Dir.MkDirIfNotExist Left$(file_path, InStrRev(file_path, "\"))
+    
     If Ucs2Convert Then
         Dim tempFileName As String
         tempFileName = VCS_File.TempFile()
         Application.SaveAsText obj_type_num, obj_name, tempFileName
         VCS_File.ConvertUcs2Utf8 tempFileName, file_path
+
+        Dim fso As Object
+        Set fso = CreateObject("Scripting.FileSystemObject")
+        fso.DeleteFile tempFileName
     Else
         Application.SaveAsText obj_type_num, obj_name, file_path
     End If
@@ -33,12 +40,18 @@ End Sub
 Public Sub ImportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _
                     ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)
     
-    If Not VCS_Dir.FileExists(file_path) Then Exit Sub
+    If Not VCS_Dir.FileExists(file_path) Then
+        logger "ImportObject", "ERROR", "Can't find the file " & file_path
+        Exit Sub
+    End If
+    
+    On Error GoTo err
     
     If Ucs2Convert Then
         Dim tempFileName As String
         tempFileName = VCS_File.TempFile()
         VCS_File.ConvertUtf8Ucs2 file_path, tempFileName
+        
         Application.LoadFromText obj_type_num, obj_name, tempFileName
         
         Dim fso As Object
@@ -47,6 +60,9 @@ Public Sub ImportObject(ByVal obj_type_num As Integer, ByVal obj_name As String,
     Else
         Application.LoadFromText obj_type_num, obj_name, file_path
     End If
+Exit Sub
+err:
+    logger "ImportObject", "CRITICAL", "Unable to import the object " & obj_name & " (" & obj_type_num & ")" & "[" & err.Description & "]"
 End Sub
 
 'shouldn't this be SanitizeTextFile (Singular)?
@@ -55,7 +71,7 @@ End Sub
 ' unnecessary lines of VB code that are inserted automatically by the
 ' Access GUI and change often (we don't want these lines of code in
 ' version control).
-Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
+Public Sub SanitizeTextFiles(ByVal path As String, ByVal Ext As String)
 
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
@@ -68,6 +84,7 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
     '  Match PrtDevNames / Mode with or  without W
     Dim srchPattern As String
     srchPattern = "PrtDev(?:Names|Mode)[W]?"
+    
     If (AggressiveSanitize = True) Then
       '  Add and group aggressive matches
       srchPattern = "(?:" & srchPattern
@@ -93,7 +110,7 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
 'Debug.Print srchPattern
     rxLine.Pattern = srchPattern
     Dim filename As String
-    filename = dir$(Path & "*." & Ext)
+    filename = dir$(path & "*." & Ext)
     Dim isReport As Boolean
     isReport = False
     
@@ -103,9 +120,9 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
         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)
+        Set InFile = fso.OpenTextFile(path & obj_name & "." & Ext, iomode:=ForReading, create:=False, Format:=TristateFalse)
         Dim OutFile As Object
-        Set OutFile = fso.CreateTextFile(Path & obj_name & ".sanitize", overwrite:=True, Unicode:=False)
+        Set OutFile = fso.CreateTextFile(path & obj_name & ".sanitize", overwrite:=True, unicode:=False)
     
         Dim getLine As Boolean
         getLine = True
@@ -136,11 +153,12 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
                     Case 0
                         rxIndent.Pattern = "^" & vbNullString
                     Case Else
-                        rxIndent.Pattern = "^" & matches(0).SubMatches(0)
+                        rxIndent.Pattern = "^(\s{0," & Len(matches(0).SubMatches(0)) & "})"
                 End Select
                 rxIndent.Pattern = rxIndent.Pattern + "\S"
                 '
                 ' Skip lines with deeper indentation
+
                 Do Until InFile.AtEndOfStream
                     txt = InFile.readline
                     If rxIndent.test(txt) Then Exit Do
@@ -170,12 +188,69 @@ 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)
+        Set thisFile = fso.GetFile(path & obj_name & ".sanitize")
+        thisFile.Move (path & filename)
         filename = dir$()
     Loop
 
-End Sub
+End Sub
+
+Public Function to_filename(object_name As String) As String
+    ' return a file name for the object's name
+    ' 1- access does not accept brackets for object's names
+    ' 2- file's names can not contain those caracters:
+    ' \ [92]
+    ' / [47]
+    ' : [58]
+    ' * [42]
+    ' ? [63]
+    ' " [34]
+    ' < [60]
+    ' > [62]
+    ' | [124]
+    '
+    ' this function replaces caracters which are not allowed for file names by [x],
+    'where x is the ascii code of the character
+    ' test: "test_\_/_:_*_?_""_<_>_|" should become test_[92]_[47]_[58]_[42]_[63]_[34]_[60]_[62]_[124]
+    ' to convert back the string, use to_accessname
+    
+    Dim result As String
+    Dim ascii_code As Variant
+    
+    result = object_name
+    
+    For Each ascii_code In Split(ForbiddenCars, ",")
+        result = Replace(result, Chr(CInt(ascii_code)), "[" & ascii_code & "]")
+    Next
+
+    to_filename = result
+Exit Function
+err:
+    Call logger("to_accessname", "ERROR", "Unable to convert object's name " & object_name & " to file's name")
+    to_filename = object_name
+End Function
+
+Public Function to_accessname(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
+    ' test: "test_[92]_[47]_[58]_[42]_[63]_[34]_[60]_[62]_[124]" should become test_\_/_:_*_?_"_<_>_|
+
+    Dim result As String
+    Dim ascii_code As Variant
+    
+    result = file_name
+    
+    For Each ascii_code In Split(ForbiddenCars, ",")
+        result = Replace(result, "[" & ascii_code & "]", Chr(CInt(ascii_code)))
+    Next
+
+    to_accessname = result
+Exit Function
+err:
+    Call logger("to_accessname", "ERROR", "Unable to convert file's name " & file_name & " to access object's name")
+    to_accessname = file_name
+End Function

+ 22 - 21
source/modules/VCS_ImportExport.bas

@@ -61,6 +61,7 @@ Public Sub ExportAllSource()
     Dim obj_count As Integer
     Dim obj_data_count As Integer
     Dim ucs2 As Boolean
+    Dim full_path As String
 
     include_tables = get_include_tables()
     
@@ -75,6 +76,7 @@ Public Sub ExportAllSource()
     obj_path = source_path & "queries\"
     VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
     
+    
     Debug.Print VCS_String.PadRight("Exporting queries...", 24);
     
     obj_count = 0
@@ -82,22 +84,17 @@ Public Sub ExportAllSource()
     
         '### 11/10/2016: add optimizer
         If optimizer_activated() Then
-            If Not is_dirty(acQuery, qry.name) Then
+            If Not needs_export(acQuery, qry.name) > 0 Then
                 obj_count = obj_count + 1
                 GoTo next_qry
             End If
         End If
         '###
-
-        If Not IsValidFileName(qry.name) Then
-            Debug.Print "ERROR:" & qry.name & " is not a valid file name, query has been ignored"
-            obj_count = obj_count + 1
-            GoTo next_qry
-        End If
         
         DoEvents
         If Left$(qry.name, 1) <> "~" Then
-            VCS_IE_Functions.ExportObject acQuery, qry.name, obj_path & qry.name & ".bas", VCS_File.UsingUcs2
+            full_path = obj_path & VCS_IE_Functions.to_filename(qry.name) & ".bas"
+            VCS_IE_Functions.ExportObject acQuery, qry.name, full_path, VCS_File.UsingUcs2
             obj_count = obj_count + 1
         End If
         
@@ -134,7 +131,7 @@ next_qry:
         
             '### 11/10/2016: add optimizer
             If optimizer_activated() Then
-                If Not is_dirty(obj_type_num, doc.name) Then
+                If Not needs_export(obj_type_num, doc.name) > 0 Then
                     obj_count = obj_count + 1
                     GoTo next_doc
                 End If
@@ -143,12 +140,6 @@ next_qry:
         
             DoEvents
             
-            If Not IsValidFileName(doc.name) Then
-                Debug.Print "ERROR:" & doc.name & " is not a valid file name, " & obj_type_name & " has been ignored"
-                obj_count = obj_count + 1
-                GoTo next_doc
-            End If
-            
             If (Left$(doc.name, 1) <> "~") And _
                (IsNotVCS(doc.name) Or ArchiveMyself) Then
                 If obj_type_label = "modules" Then
@@ -156,9 +147,12 @@ next_qry:
                 Else
                     ucs2 = VCS_File.UsingUcs2
                 End If
-                VCS_IE_Functions.ExportObject obj_type_num, doc.name, obj_path & doc.name & ".bas", ucs2
+                
+                full_path = obj_path & VCS_IE_Functions.to_filename(doc.name) & ".bas"
+                VCS_IE_Functions.ExportObject obj_type_num, doc.name, full_path, ucs2
                 
                 If obj_type_label = "reports" Then
+                    full_path = obj_path & VCS_IE_Functions.to_filename(doc.name) & ".pv"
                     VCS_Report.ExportPrintVars doc.name, obj_path & doc.name & ".pv"
                 End If
                 
@@ -221,7 +215,7 @@ next_doc:
         '### 11/10/2016: add optimizer
         '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))
+        update_this_tabledef = (Not optimizer_activated() Or needs_export(acTable, td.name) > 0)
         '###
     
         If Not IsValidFileName(td.name) Then
@@ -239,7 +233,7 @@ next_doc:
             If Len(td.connect) = 0 Then ' this is not an external table
                 
                 If update_this_tabledef Then
-                    VCS_Table.ExportTableDef Db, td, td.name, obj_path
+                    VCS_Table.ExportTableDef Db, td, VCS_IE_Functions.to_filename(td.name), obj_path
                 End If
                 
                 If include_tables = "*" Then
@@ -346,8 +340,8 @@ Public Sub ImportAllSource()
 
     source_path = VCS_Dir.ProjectPath() & "source\"
     If Not fso.FolderExists(source_path) Then
-        MsgBox "No source found at:" & vbCrLf & source_path, vbExclamation, "Import failed"
-        Exit Sub
+        logger "ImportAllSource", "CRITICAL", "No source found at:" & source_path
+        Call err.Raise(60000, "Critical error", "Critical error occured, see the log file for more informations")
     End If
 
     Debug.Print
@@ -369,6 +363,7 @@ Public Sub ImportAllSource()
         Do Until Len(filename) = 0
             DoEvents
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = VCS_IE_Functions.to_accessname(obj_name)
             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
@@ -391,6 +386,7 @@ Public Sub ImportAllSource()
         obj_count = 0
         Do Until Len(filename) = 0
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = VCS_IE_Functions.to_accessname(obj_name)
             If DebugOutput Then
                 If obj_count = 0 Then
                     Debug.Print
@@ -415,6 +411,7 @@ Public Sub ImportAllSource()
         obj_count = 0
         Do Until Len(filename) = 0
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = VCS_IE_Functions.to_accessname(obj_name)
             If DebugOutput Then
                 If obj_count = 0 Then
                     Debug.Print
@@ -441,6 +438,7 @@ Public Sub ImportAllSource()
         Do Until Len(filename) = 0
             DoEvents
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = VCS_IE_Functions.to_accessname(obj_name)
             VCS_Table.ImportTableData CStr(obj_name), obj_path
             obj_count = obj_count + 1
             filename = dir$()
@@ -460,6 +458,7 @@ Public Sub ImportAllSource()
         Do Until Len(filename) = 0
             DoEvents
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = VCS_IE_Functions.to_accessname(obj_name)
             'VCS_Table.ImportTableData CStr(obj_name), obj_path
             VCS_DataMacro.ImportDataMacros obj_name, obj_path
             obj_count = obj_count + 1
@@ -494,6 +493,7 @@ Public Sub ImportAllSource()
             Do Until Len(filename) = 0
                 ' DoEvents no good idea!
                 obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+                obj_name = VCS_IE_Functions.to_accessname(obj_name)
                 If obj_type_label = "modules" Then
                     ucs2 = False
                 Else
@@ -504,7 +504,7 @@ Public Sub ImportAllSource()
                     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"
+                        logger "ImportAllSource", "WARNING", "Module " & obj_name & " could not be updated while running. Ensure latest version is included!"
                     End If
                 End If
                 filename = dir$()
@@ -527,6 +527,7 @@ Public Sub ImportAllSource()
     Do Until Len(filename) = 0
         DoEvents
         obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+        obj_name = VCS_IE_Functions.to_accessname(obj_name)
         VCS_Report.ImportPrintVars obj_name, obj_path & filename
         obj_count = obj_count + 1
         filename = dir$()

+ 1 - 1
source/modules/VCS_Loader.bas

@@ -4,7 +4,7 @@ Option Explicit
 
 Public Sub loadVCS(Optional ByVal SourceDirectory As String)
     If SourceDirectory = vbNullString Then
-      SourceDirectory = CurrentProject.Path & "\MSAccess-VCS\"
+      SourceDirectory = CurrentProject.path & "\MSAccess-VCS\"
     End If
 
 'check if directory exists! - SourceDirectory could be a file or not exist

+ 34 - 0
source/modules/VCS_Log.bas

@@ -0,0 +1,34 @@
+Option Compare Database
+Dim log_file_path As String
+
+Public Function log_file()
+    log_file = log_file_path
+End Function
+
+Public Sub logger(origin As String, level As String, msg As String)
+    Dim fso As Object
+    Dim oFile As Object
+
+    Set fso = CreateObject("Scripting.FileSystemObject")
+
+    If Not Len(log_file_path) > 0 Then
+    
+        log_file_path = CurrentProject.path & "\" & "logVCS_" & Format(Now, "yymmdd_hhMMss") & ".log"
+        
+        Debug.Print log_file_path
+        If Not fso.FileExists(log_file_path) Then
+            Set oFile = fso.CreateTextFile(log_file_path)
+            oFile.Close
+        End If
+        
+    End If
+
+    Set oFile = fso.OpenTextFile(log_file_path, ForAppending)
+
+    'oFile.WriteBlankLines (2)
+    oFile.WriteLine (CStr(Now) + " - " + origin + " - " + level + " - " + msg)
+    
+    oFile.Close
+    Set fso = Nothing
+    Set oFile = Nothing
+End Sub

+ 24 - 17
source/modules/VCS_Main.bas

@@ -37,7 +37,7 @@ Dim step As String
         
         If old_sources_date > #1/1/1900# Then
 
-            msg = msg_list_modified()
+            msg = msg_list_to_export()
             
             If Not Len(msg) > 0 Then
                 msg = "** VCS OPTIMIZER **" & vbNewLine & ">> Nothing new to export" & vbNewLine & _
@@ -46,7 +46,11 @@ Dim step As String
                             " - relations" & vbNewLine & vbNewLine & _
                             "TIP: use 'makesources -f' to force a complete export (could be long)."
             Else
-                msg = "** VCS OPTIMIZER **" & vbNewLine & ">> Following objects will be exported:" & vbNewLine & msg
+                msg = "** VCS OPTIMIZER **" & vbNewLine & _
+                      ">> Following objects will be exported:" & vbNewLine & _
+                      msg & vbNewLine & _
+                      "> DATA: " & vbNewLine & get_include_tables() & vbNewLine & vbNewLine & _
+                      "> RELATIONS"
             End If
             
             Call activate_optimizer
@@ -113,15 +117,16 @@ update_from_sources = opInterrupted
 
     step = "Check for unexported work"
     Debug.Print step
-    msg = msg_list_modified()
+    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 & _
+                    "(!) 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"
@@ -129,6 +134,12 @@ update_from_sources = opInterrupted
     Call ImportAllSource
     Debug.Print "> done"
    
+    ' new sources date to keep the optimizer working
+    step = "Updates sources date"
+    Debug.Print step
+    Call update_sources_date
+    Debug.Print "> done"
+   
     update_from_sources = opCompleted
     Exit Function
 err:
@@ -185,11 +196,7 @@ End Function
 
 
 Public Function get_include_tables()
-    If CurrentProject.name = "VCS.accda" Then
-        get_include_tables = "tbl_commands,modele_ztbl_vcs"
-    Else
-        get_include_tables = vcs_param("include_tables")
-    End If
+    get_include_tables = vcs_param("include_tables")
 End Function
 
 Public Function vcs_param(ByVal key As String, Optional ByVal default_value As String = "") As String
@@ -209,17 +216,17 @@ Public Function zip_app_file() As Boolean
     shortname = Split(CurrentProject.name, ".")(0)
     
     'run the shell comand
-    Call cmd("cd " & CurrentProject.Path & " & " & _
+    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"
+    If dir(CurrentProject.path & "\" & shortname & ".zip") <> "" Then
+        Kill CurrentProject.path & "\" & shortname & ".zip"
     End If
     
     'rename the temporary zip
-    Call cmd("cd " & CurrentProject.Path & " & " & _
+    Call cmd("cd " & CurrentProject.path & " & " & _
             "ren tmp_" & shortname & ".zip" & " " & shortname & ".zip" & _
             " & exit")
     
@@ -240,12 +247,12 @@ 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"
+    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))
+    Call cmd("copy " & Chr(34) & CurrentProject.path & "\" & CurrentProject.name & Chr(34) & _
+             " " & Chr(34) & CurrentProject.path & "\" & CurrentProject.name & ".old" & Chr(34))
     
     make_backup = True
     Exit Function

+ 74 - 20
source/modules/VCS_Optimizer.bas

@@ -10,6 +10,11 @@ Option Explicit
 ' *** activates the optimizer
 Private p_optimizer As Boolean
 
+'needs_export
+Public Const NoExportNeeded = 0
+Public Const MissingFiles = 1
+Public Const UpdateNeeded = 2
+
 Public Sub activate_optimizer()
     p_optimizer = True
 End Sub
@@ -21,17 +26,26 @@ End Function
 
 
 '*** main methods
-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)
+Public Function needs_export(acType As Integer, name As String) As Integer
+    ' a file needs to be export if it has been updated since last export, or if its source files are missing
+    ' returns an integer (see constants)
+    
+    If Not files_exist_for(acType, name) Then
+        needs_export = MissingFiles
+    
+    ElseIf get_last_update_date(acType, name) > get_sources_date() Then
+        needs_export = UpdateNeeded
+        
+    Else
+        needs_export = NoExportNeeded
+    End If
 
 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
+    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
@@ -60,11 +74,12 @@ 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
+Public Function list_to_export(acType As Integer)
+' returns a list (string with ';' separator) of the objects wich will be exported
+
     Dim sources_date As Date
     
-    list_modified = ""
+    list_to_export = ""
     
     sources_date = get_sources_date()
     
@@ -79,11 +94,12 @@ Public Function list_modified(acType As Integer)
         If Left$(rs![name], 4) <> "MSys" And _
             Left$(rs![name], 1) <> "~" Then
             
-            If get_last_update_date(acType, rs![name]) > sources_date Then
-                If Len(list_modified) > 0 Then
-                    list_modified = list_modified & ";" & rs![name]
+            If get_last_update_date(acType, rs![name]) > sources_date Or _
+                Not files_exist_for(acType, rs![name]) Then
+                If Len(list_to_export) > 0 Then
+                    list_to_export = list_to_export & ";" & rs![name]
                 Else
-                    list_modified = rs![name]
+                    list_to_export = rs![name]
                 End If
             End If
             
@@ -95,12 +111,12 @@ Public Function list_modified(acType As Integer)
 emptylist:
 End Function
 
-Public Function msg_list_modified() As String
+Public Function msg_list_to_export() 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
     
-    msg_list_modified = ""
+    msg_list_to_export = ""
 
     For Each obj_type In Split( _
         "tables|" & acTable & "," & _
@@ -115,13 +131,15 @@ Public Function msg_list_modified() As String
         obj_type_label = obj_type_split(0)
         obj_type_num = obj_type_split(1)
 
-        lstmod = list_modified(CInt(obj_type_num))
+        lstmod = list_to_export(CInt(obj_type_num))
         
         If Len(lstmod) > 0 Then
-            msg_list_modified = msg_list_modified & "** " & UCase(obj_type_label) & " **" & vbNewLine
+            msg_list_to_export = msg_list_to_export & "> " & UCase(obj_type_label) & ":" & vbNewLine
             For Each objname In Split(lstmod, ";")
-                msg_list_modified = msg_list_modified & "   - " & objname & vbNewLine
+                msg_list_to_export = msg_list_to_export & objname
+                msg_list_to_export = msg_list_to_export & ", "
             Next objname
+            msg_list_to_export = Left(msg_list_to_export, Len(msg_list_to_export) - 2) & vbNewLine & vbNewLine
         End If
     Next obj_type
 
@@ -166,7 +184,7 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
     Dim obj_type_num As Integer
     
     Dim oFSO As Scripting.FileSystemObject
-    Dim oFld As Scripting.folder
+    Dim oFld As Scripting.Folder
     Dim file As Scripting.file
     'Instanciation du FSO
     Set oFSO = New Scripting.FileSystemObject
@@ -194,7 +212,7 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
             If rsSys.NoMatch Then
                 'object doesn't exist anymore
                 If Len(CleanDirs) > 0 Then CleanDirs = CleanDirs & "|"
-                CleanDirs = CleanDirs & (Replace(file.Path, CurrentProject.Path, "."))
+                CleanDirs = CleanDirs & (Replace(file.path, CurrentProject.path, "."))
                 If Not sim Then
                     oFSO.DeleteFile file
                 End If
@@ -205,4 +223,40 @@ next_obj_type:
     Next obj_type
 
 
+End Function
+
+Public Function files_exist_for(acType As Integer, name As String) As Boolean
+'does the object has its files in sources
+    Dim source_path As String
+    source_path = VCS_Dir.ProjectPath() & "source\"
+    
+    Select Case acType
+        Case acForm
+            files_exist_for = (dir(source_path & "forms\" & name & ".bas") <> "")
+            
+        Case acReport
+            files_exist_for = (dir(source_path & "reports\" & name & ".bas") <> "" _
+                               And _
+                               dir(source_path & "reports\" & name & ".pv") <> "")
+    
+        Case acQuery
+            files_exist_for = (dir(source_path & "queries\" & name & ".bas") <> "")
+        
+        Case acTable
+            
+            files_exist_for = ( _
+                                 dir(source_path & "tbldef\" & name & ".sql") <> "" _
+                                 Or _
+                                 dir(source_path & "tbldef\" & name & ".lnkd") <> "" _
+                               )
+        
+        Case acMacro
+            files_exist_for = (dir(source_path & "macros\" & name & ".bas") <> "")
+        
+        Case acModule
+            files_exist_for = (dir(source_path & "modules\" & name & ".bas") <> "")
+    
+    End Select
+
+
 End Function

+ 2 - 3
source/modules/VCS_Reference.bas

@@ -51,8 +51,7 @@ failed_guid:
         'The reference is already present in the access project - so we can ignore the error
         Resume Next
     Else
-        MsgBox "Failed to register " & GUID, , "Error: " & err.number
-        'Do we really want to carry on the import with missing references??? - Surely this is fatal
+        logger "ImportReferences", "ERROR", "Failed to register " & GUID
         Resume go_on
     End If
     
@@ -66,7 +65,7 @@ Public Sub ExportReferences(ByVal obj_path As String)
     Dim ref As Reference
 
     Set fso = CreateObject("Scripting.FileSystemObject")
-    Set OutFile = fso.CreateTextFile(obj_path & "references.csv", overwrite:=True, Unicode:=False)
+    Set OutFile = fso.CreateTextFile(obj_path & "references.csv", overwrite:=True, unicode:=False)
     For Each ref In Application.References
         If ref.GUID <> vbNullString Then ' references of types mdb,accdb,mde etc don't have a GUID
             If Not ref.BuiltIn Then

+ 5 - 5
source/modules/VCS_Relation.bas

@@ -4,11 +4,11 @@ Option Private Module
 Option Explicit
 
 
-Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filePath As String)
+Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filepath As String)
     Dim fso As Object
     Dim OutFile As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
-    Set OutFile = fso.CreateTextFile(filePath, overwrite:=True, Unicode:=False)
+    Set OutFile = fso.CreateTextFile(filepath, overwrite:=True, unicode:=False)
 
     OutFile.WriteLine rel.Attributes 'RelationAttributeEnum
     OutFile.WriteLine rel.name
@@ -27,11 +27,11 @@ Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filePath As String)
 
 End Sub
 
-Public Sub ImportRelation(ByVal filePath As String)
+Public Sub ImportRelation(ByVal filepath As String)
     Dim fso As Object
     Dim InFile As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
-    Set InFile = fso.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)
+    Set InFile = fso.OpenTextFile(filepath, iomode:=ForReading, create:=False, Format:=TristateFalse)
     Dim rel As DAO.Relation
     Set rel = New DAO.Relation
     
@@ -48,7 +48,7 @@ Public Sub ImportRelation(ByVal filePath As String)
             f.ForeignName = InFile.readline
             If "End" <> InFile.readline Then
                 Set f = Nothing
-                err.Raise 40000, "ImportRelation", "Missing 'End' for a 'Begin' in " & filePath
+                err.Raise 40000, "ImportRelation", "Missing 'End' for a 'Begin' in " & filepath
             End If
             rel.Fields.Append f
         End If

+ 9 - 5
source/modules/VCS_Report.bas

@@ -42,7 +42,7 @@ End Type
 
 
 'Exports print vars for reports
-Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
+Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filepath As String)
   DoEvents
   Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
@@ -57,6 +57,7 @@ Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
    DoCmd.SetWarnings False
    DoCmd.OpenReport obj_name, acViewDesign, , , acHidden
    DoCmd.SetWarnings True
+   
    Set rpt = Reports(obj_name)
   
   
@@ -73,7 +74,7 @@ Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
   End If
   
   Dim OutFile As Object
-  Set OutFile = fso.CreateTextFile(filePath, overwrite:=True, Unicode:=False)
+  Set OutFile = fso.CreateTextFile(filepath, overwrite:=True, unicode:=False)
   
   'print out print var values
   OutFile.WriteLine DM.intOrientation
@@ -88,8 +89,8 @@ Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
   DoCmd.Close acReport, obj_name, acSaveYes
 End Sub
 
-Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filePath As String)
-  
+Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filepath As String)
+  On err GoTo err
   Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   
@@ -118,7 +119,7 @@ Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filePath As String)
   End If
   
   Dim InFile As Object
-  Set InFile = fso.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)
+  Set InFile = fso.OpenTextFile(filepath, iomode:=ForReading, create:=False, Format:=TristateFalse)
   
   'print out print var values
   DM.intOrientation = InFile.readline
@@ -136,4 +137,7 @@ Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filePath As String)
   Set rpt = Nothing
   
   DoCmd.Close acReport, obj_name, acSaveYes
+Exit Sub
+err:
+    logger "ImportPrintVars", "ERROR", "Report " & obj_name & " was not found, import print vars cancelled"
 End Sub

+ 1 - 1
source/modules/VCS_ShellUtilities.bas

@@ -75,6 +75,6 @@ End Sub
 
 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(in_dir) = 0 Then in_dir = CurrentProject.Path
+    If Len(in_dir) = 0 Then in_dir = CurrentProject.path
     Call ShellWait("cmd.exe /r cd " & in_dir & " & " & command, WindowStyle)
 End Function

+ 39 - 20
source/modules/VCS_Table.bas

@@ -35,15 +35,15 @@ Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal obj_path As String)
     ' open file for writing with Create=True, Unicode=True (USC-2 Little Endian format)
     VCS_Dir.MkDirIfNotExist obj_path
     
-    Set OutFile = fso.CreateTextFile(tempFilePath, overwrite:=True, Unicode:=True)
+    Set OutFile = fso.CreateTextFile(tempFilePath, overwrite:=True, unicode:=True)
     
     OutFile.Write CurrentDb.TableDefs(tbl_name).name
     OutFile.Write vbCrLf
     
-    If InStr(1, CurrentDb.TableDefs(tbl_name).connect, "DATABASE=" & CurrentProject.Path) Then
+    If InStr(1, CurrentDb.TableDefs(tbl_name).connect, "DATABASE=" & CurrentProject.path) Then
         'change to relatave path
         Dim connect() As String
-        connect = Split(CurrentDb.TableDefs(tbl_name).connect, CurrentProject.Path)
+        connect = Split(CurrentDb.TableDefs(tbl_name).connect, CurrentProject.path)
         OutFile.Write connect(0) & "." & connect(1)
     Else
         OutFile.Write CurrentDb.TableDefs(tbl_name).connect
@@ -71,13 +71,14 @@ Err_LinkedTable_Fin:
     On Error Resume Next
     OutFile.Close
     'save files as .odbc
-    VCS_File.ConvertUcs2Utf8 tempFilePath, obj_path & tbl_name & ".LNKD"
+    VCS_File.ConvertUcs2Utf8 tempFilePath, obj_path & VCS_IE_Functions.to_filename(tbl_name) & ".LNKD"
     
     Exit Sub
     
 Err_LinkedTable:
     OutFile.Close
-    MsgBox err.Description, vbCritical, "ERROR: EXPORT LINKED TABLE"
+    logger "ImportLinkedTable", "CRITICAL", "ERROR: IMPORT LINKED TABLE: " & err.Description
+    Call err.Raise(60000, "Critical error", "Critical error occured, see the log file for more informations")
     Resume Err_LinkedTable_Fin
 End Sub
 
@@ -120,8 +121,10 @@ 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) & " "
         If (fi.Attributes And dbAutoIncrField) Then
@@ -382,7 +385,7 @@ Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
     Dim tempFileName As String
     tempFileName = VCS_File.TempFile()
 
-    Set OutFile = fso.CreateTextFile(tempFileName, overwrite:=True, Unicode:=True)
+    Set OutFile = fso.CreateTextFile(tempFileName, overwrite:=True, unicode:=True)
 
     c = 0
     For Each fieldObj In rs.Fields
@@ -417,7 +420,7 @@ Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
     rs.Close
     OutFile.Close
 
-    VCS_File.ConvertUcs2Utf8 tempFileName, obj_path & tbl_name & ".txt"
+    VCS_File.ConvertUcs2Utf8 tempFileName, obj_path & VCS_IE_Functions.to_filename(tbl_name) & ".txt"
     fso.DeleteFile tempFileName
 End Sub
 
@@ -440,6 +443,7 @@ Public Sub ImportLinkedTable(ByVal tblName As String, ByRef obj_path As String)
     tempFilePath = VCS_File.TempFile()
     
     ConvertUtf8Ucs2 obj_path & tblName & ".LNKD", tempFilePath
+    
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
     Set InFile = fso.OpenTextFile(tempFilePath, iomode:=ForReading, create:=False, Format:=TristateTrue)
     
@@ -461,7 +465,7 @@ err_notable_fin:
     Dim connect As String
     connect = InFile.readline()
     If InStr(1, connect, "DATABASE=.\") Then 'replace relative path with literal path
-        connect = Replace(connect, "DATABASE=.\", "DATABASE=" & CurrentProject.Path & "\")
+        connect = Replace(connect, "DATABASE=.\", "DATABASE=" & CurrentProject.path & "\")
     End If
     td.connect = connect
     
@@ -471,7 +475,8 @@ err_notable_fin:
     GoTo Err_CreateLinkedTable_Fin
     
 Err_CreateLinkedTable:
-    MsgBox err.Description, vbCritical, "ERROR: IMPORT LINKED TABLE"
+    logger "ImportLinkedTable", "CRITICAL", "ERROR: IMPORT LINKED TABLE: " & err.Description
+    Call err.Raise(60000, "Critical error", "Critical error occured, see the log file for more informations")
     Resume Err_CreateLinkedTable_Fin
     
 Err_CreateLinkedTable_Fin:
@@ -502,8 +507,8 @@ End Sub
 
 ' Import Table Definition
 Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
-    Dim filePath As String
-    filePath = directory & tblName & ".sql"
+    Dim filepath As String
+    filepath = directory & tblName & ".sql"
     Dim Db As Object ' DAO.Database
     Dim fso As Object
     Dim InFile As Object
@@ -520,18 +525,20 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
 
     n = -1
     Set fso = CreateObject("Scripting.FileSystemObject")
-    VCS_File.ConvertUtf8Ucs2 filePath, tempFileName
+
+    VCS_File.ConvertUtf8Ucs2 filepath, tempFileName
+    
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
-    Set InFile = fso.OpenTextFile(tempFileName, iomode:=ForReading, create:=False, Format:=TristateTrue)
+    'Set InFile = fso.OpenTextFile(tempFileName, iomode:=ForReading, create:=False, Format:=TristateTrue)
     Set Db = CurrentDb
+    
     KillTable tblName, Db
-    buf = InFile.readline()
-    Do Until InFile.AtEndOfStream
-        buf = buf & InFile.readline()
-    Loop
+
+    buf = ReadFile(filepath, "x-ansi")
     
     ' The following block is needed because "on update" actions may cause problems
     For Each s In Split("UPDATE|DELETE", "|")
+    
       p = InStr(buf, "ON " & s & " CASCADE")
       Do While p > 0
           n = n + 1
@@ -555,7 +562,9 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
           p = InStr(p, "ON " & s & " CASCADE", buf)
       Loop
     Next
+    
     On Error Resume Next
+    
     For i = 0 To n
         strMsg = k(i).table & " to " & k(i).foreignTable
         strMsg = strMsg & "(  "
@@ -573,10 +582,15 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
             strMsg = strMsg & " on delete cascade " & vbCrLf
         End If
     Next
+    
     On Error GoTo 0
     Db.execute buf
-    InFile.Close
-    If Len(strMsg) > 0 Then MsgBox strMsg, vbOKOnly, "Correct manually"
+    'InFile.Close
+    
+    If Len(strMsg) > 0 Then
+        MsgBox strMsg, vbOKOnly, "Correct manually"
+        logger "ImportTableDef", "ERROR", strMsg & " - Correct manually"
+    End If
         
 End Sub
 
@@ -593,7 +607,9 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
     
     Dim tempFileName As String
     tempFileName = VCS_File.TempFile()
+    
     VCS_File.ConvertUtf8Ucs2 obj_path & tblName & ".txt", tempFileName
+    
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
     Set InFile = fso.OpenTextFile(tempFileName, iomode:=ForReading, create:=False, Format:=TristateTrue)
     Set Db = CurrentDb
@@ -617,6 +633,9 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
                     value = Replace(value, "\n", vbCrLf)
                     value = Replace(value, "\\", "\")
                 End If
+                '** correct a bug due to internationalization
+                If fieldObj.Type = dbBoolean Then value = CBool(value)
+                '**
                 rs(fieldObj.name) = value
                 c = c + 1
             Next

+ 3 - 2
source/modules/VCS_Utilities.bas

@@ -44,7 +44,8 @@ End Function
 
 Public Function msys_type_filter(acType) As String
 'returns a sql filter string for the object type
-'NB: types in msysobjects table
+'NB: do not return system tables
+'NB2: here are the types in msysobjects table:
 '-32768 = Form
 '-32766 = Macro
 '-32764 = Report
@@ -62,7 +63,7 @@ Public Function msys_type_filter(acType) As String
 
     Select Case acType
         Case acTable
-            msys_type_filter = "([Type]=1 or [Type]=4 or [Type]=6)"
+            msys_type_filter = "(([Type]=1 or [Type]=4 or [Type]=6) AND ([name] Not Like 'MSys*' AND [name] Not Like 'f_*_Data'))"
         Case acQuery
             msys_type_filter = "[Type]=5"
         Case acForm

+ 1 - 1
source/tables/ztbl_vcs.txt

@@ -1,3 +1,3 @@
 key	val
 include_tables	ztbl_vcs,tbl_commands
-sources_date	17/10/2016 18:10:20
+sources_date	03/11/2016 17:03:20

+ 7 - 0
source/tbldef/vcs_log.sql

@@ -0,0 +1,7 @@
+CREATE TABLE [vcs_log] (
+  [command] VARCHAR (255),
+  [dt] VARCHAR (255),
+  [origin] VARCHAR (255),
+  [level] VARCHAR (255),
+  [msg] VARCHAR (255)
+)

BIN
vcs.zip