olivier.massot 9 rokov pred
rodič
commit
079e2cdc2e

BIN
OpenAccess.zip


+ 4 - 0
source/modules/OA_Log.bas

@@ -24,12 +24,16 @@ Public Sub set_log_path(ByVal path As String)
     Dim FSO As Object
     Dim oFile As Object
     
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    
     Call MkLogDir
     
     If Not FSO.FileExists(path) Then
         Set oFile = FSO.CreateTextFile(path)
         oFile.Close
     End If
+    
+    log_file_path = path
         
 End Sub
 

+ 8 - 1
source/modules/OA_Main.bas

@@ -9,6 +9,11 @@ Public Const opInterrupted = 10
 Public Const opCancelled = 11
 Public Const opCompleted = 12
 
+Dim debug_mode As Boolean
+Public Sub activate_debug_mode()
+    debug_mode = True
+End Sub
+
 '>> main function, called when addin is run
 Public Function main()
 
@@ -19,7 +24,7 @@ End Function
 Public Function make_sources(Optional ByVal optimizer As Boolean = True, _
                              Optional ByVal zip As Boolean = True) As Integer
 'exports the source-code of the app
-On Error GoTo err
+If Not debug_mode Then On Error GoTo err
 Dim step As String
 
     make_sources = opInterrupted
@@ -85,6 +90,8 @@ End Function
 Public Function update_from_sources(Optional ByVal backup As Boolean) As Integer
 'updates the application from the sources
 
+    If Not debug_mode Then On Error GoTo err
+
     Dim backup_ok As Boolean
     Dim step, msg As String
     

+ 2 - 2
source/modules/VCS_DataMacro.bas

@@ -13,7 +13,7 @@ Public Sub ExportDataMacros(ByVal tableName As String, ByVal directory As String
     On Error GoTo Err_export
     Dim filepath As String
     
-    filepath = directory & tableName & ".xml"
+    filepath = directory & to_filename(tableName) & ".xml"
 
     VCS_IE_Functions.ExportObject acTableDataMacro, tableName, filepath, VCS_File.UsingUcs2
     FormatDataMacro filepath
@@ -28,7 +28,7 @@ Public Sub ImportDataMacros(ByVal tableName As String, ByVal directory As String
     On Error GoTo Err_import
     Dim filepath As String
     
-    filepath = directory & tableName & ".xml"
+    filepath = directory & to_filename(tableName) & ".xml"
     VCS_IE_Functions.ImportObject acTableDataMacro, tableName, filepath, VCS_File.UsingUcs2
     
     Exit Sub

+ 1 - 1
source/modules/VCS_IE_Functions.bas

@@ -213,7 +213,7 @@ Public Sub SanitizeTextFiles(ByVal path As String, ByVal Ext As String)
 
 End Sub
 
-Public Function to_filename(object_name As String) As String
+Public Function to_filename(ByVal 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:

+ 14 - 14
source/modules/VCS_ImportExport.bas

@@ -53,7 +53,7 @@ End Function
 ' macros, modules, and lookup tables to `source` folder under the
 ' database's folder.
 Public Sub ExportAllSource()
-    Dim Db As Object ' DAO.Database
+    Dim db As Object ' DAO.Database
     Dim source_path As String
     Dim obj_path As String
     Dim qry As Object ' DAO.QueryDef
@@ -79,7 +79,7 @@ Public Sub ExportAllSource()
     
     SaveProject
     
-    Set Db = CurrentDb
+    Set db = CurrentDb
 
     CloseFormsReports
     'InitUsingUcs2
@@ -97,7 +97,7 @@ Public Sub ExportAllSource()
     logger "ExportAllSource", "INFO", "Exporting queries..."
     
     obj_count = 0
-    For Each qry In Db.QueryDefs
+    For Each qry In db.QueryDefs
     
         '### 11/10/2016: add optimizer
         If optimizer_activated() Then
@@ -117,7 +117,7 @@ Public Sub ExportAllSource()
         End If
         
 next_qry:
-        Call SysCmd(4, "Export query: " & obj_count & " on " & Db.QueryDefs.count)
+        Call SysCmd(4, "Export query: " & obj_count & " on " & db.QueryDefs.count)
     Next
     logger "ExportAllSource", "INFO", "> " & obj_count & " queries exported"
     
@@ -145,13 +145,13 @@ next_qry:
         
         logger "ExportAllSource", "INFO", "Exporting " & obj_type_label & "..."
         
-        For Each doc In Db.Containers(obj_type_name).Documents
+        For Each doc In db.Containers(obj_type_name).Documents
         
             '### 11/10/2016: add optimizer
             If optimizer_activated() Then
                 If Not needs_export(obj_type_num, doc.name) > 0 Then
                     obj_count = obj_count + 1
-                    Call SysCmd(4, "Exporting " & obj_type_label & ": " & obj_count & " on " & Db.Containers(obj_type_name).Documents.count)
+                    Call SysCmd(4, "Exporting " & obj_type_label & ": " & obj_count & " on " & db.Containers(obj_type_name).Documents.count)
                     logger "ExportAllSource", "DEBUG", obj_type_label & " '" & doc.name & " skipped"
                     GoTo next_doc
                 End If
@@ -177,7 +177,7 @@ next_qry:
                     VCS_Report.ExportPrintVars doc.name, obj_path & doc.name & ".pv"
                 End If
                 
-                Call SysCmd(4, "Exporting " & obj_type_label & ": " & obj_count & " on " & Db.Containers(obj_type_name).Documents.count)
+                Call SysCmd(4, "Exporting " & obj_type_label & ": " & obj_count & " on " & db.Containers(obj_type_name).Documents.count)
 
                 obj_count = obj_count + 1
             End If
@@ -207,7 +207,7 @@ next_doc:
     
     Dim td As DAO.TableDef
     Dim tds As DAO.TableDefs
-    Set tds = Db.TableDefs
+    Set tds = db.TableDefs
 
     obj_type_label = "tbldef"
     obj_type_name = "Table_Def"
@@ -246,7 +246,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, VCS_IE_Functions.to_filename(td.name), obj_path
+                    VCS_Table.ExportTableDef db, td, obj_path
                 Else
                     logger "ExportAllSource", "DEBUG", "TableDef " & td.name & " skipped"
                 End If
@@ -538,8 +538,8 @@ On Error GoTo errorHandler
         Exit Sub
     End If
 
-    Dim Db As DAO.Database
-    Set Db = CurrentDb
+    Dim db As DAO.Database
+    Set db = CurrentDb
     CloseFormsReports
 
     Debug.Print
@@ -555,11 +555,11 @@ On Error GoTo errorHandler
     Next
 
     Dim dbObject As Object
-    For Each dbObject In Db.QueryDefs
+    For Each dbObject In db.QueryDefs
         DoEvents
         If Left$(dbObject.name, 1) <> "~" Then
 '            Debug.Print dbObject.Name
-            Db.QueryDefs.Delete dbObject.name
+            db.QueryDefs.Delete dbObject.name
         End If
     Next
     
@@ -588,7 +588,7 @@ On Error GoTo errorHandler
         )
         objTypeArray = Split(objType, "|")
         DoEvents
-        For Each doc In Db.Containers(objTypeArray(OTNAME)).Documents
+        For Each doc In db.Containers(objTypeArray(OTNAME)).Documents
             DoEvents
             If (Left$(doc.name, 1) <> "~") And _
                (IsNotVCS(doc.name)) Then

+ 1 - 1
source/modules/VCS_Reference.bas

@@ -82,7 +82,7 @@ Public Sub ExportReferences(ByVal obj_path As String)
     For Each ref In Application.References
         
         For Each item In Split(ignoreref, ",")
-            If item.name = CStr(item) Then GoTo go_on
+            If ref.name = CStr(item) Then GoTo go_on
         Next item
     
         If ref.GUID <> vbNullString Then ' references of types mdb,accdb,mde etc don't have a GUID

+ 10 - 3
source/modules/VCS_Relation.bas

@@ -7,6 +7,10 @@ Option Explicit
 Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filepath As String)
     Dim FSO As Object
     Dim OutFile As Object
+    
+    Dim relname As String
+    relname = rel.name
+    
     Set FSO = CreateObject("Scripting.FileSystemObject")
     
     Set OutFile = FSO.CreateTextFile(filepath, overwrite:=True, unicode:=False)
@@ -26,7 +30,7 @@ Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filepath As String)
     
     OutFile.Close
 
-    logger "ExportRelation", "DEBUG", "Relation " & rel.name & " exported to " & filepath
+    logger "ExportRelation", "DEBUG", "Relation " & relname & " exported to " & filepath
 
 End Sub
 
@@ -37,7 +41,10 @@ Public Sub ImportRelation(ByVal filepath As String)
     Set InFile = FSO.OpenTextFile(filepath, iomode:=ForReading, Create:=False, Format:=TristateFalse)
     Dim rel As DAO.Relation
     Set rel = New DAO.Relation
-    
+
+    Dim relname As String
+    relname = rel.name
+
     rel.Attributes = InFile.readline
     rel.name = InFile.readline
     rel.table = InFile.readline
@@ -63,6 +70,6 @@ next_rel:
     
     CurrentDb.Relations.Append rel
 
-    logger "ImportRelation", "DEBUG", "Relation " & rel.name & " imported from " & filepath
+    logger "ImportRelation", "DEBUG", "Relation " & relname & " imported from " & filepath
 
 End Sub

+ 30 - 26
source/modules/VCS_Table.bas

@@ -53,10 +53,10 @@ Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal obj_path As String)
     OutFile.Write CurrentDb.TableDefs(tbl_name).SourceTableName
     OutFile.Write vbCrLf
     
-    Dim Db As DAO.Database
-    Set Db = CurrentDb
+    Dim db As DAO.Database
+    Set db = CurrentDb
     Dim td As DAO.TableDef
-    Set td = Db.TableDefs(tbl_name)
+    Set td = db.TableDefs(tbl_name)
     Dim idx As DAO.index
     
     For Each idx In td.Indexes
@@ -112,10 +112,12 @@ Private Function formatDecimal(ByVal tableName As String, ByVal fieldName As Str
 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"
+Public Sub ExportTableDef(ByRef db As DAO.Database, ByRef td As DAO.TableDef, ByVal directory As String)
+    Dim tableName, filename As String
+    
+    tableName = td.name
+    filename = directory & to_filename(tableName) & ".sql"
+    
     Dim sql As String
     Dim fieldAttributeSql As String
     Dim idx As DAO.index
@@ -152,7 +154,7 @@ Public Sub ExportTableDef(Db As DAO.Database, td As DAO.TableDef, ByVal tableNam
                 If idx.Required Then fieldAttributeSql = fieldAttributeSql & " NOT NULL "
                 If idx.Foreign Then
                     Set ff = idx.Fields
-                    fieldAttributeSql = fieldAttributeSql & formatReferences(Db, ff, tableName)
+                    fieldAttributeSql = fieldAttributeSql & formatReferences(db, ff, tableName)
                 End If
                 If Len(fieldAttributeSql) > 0 Then fieldAttributeSql = " CONSTRAINT " & strName(idx.name) & fieldAttributeSql
             End If
@@ -170,7 +172,7 @@ Public Sub ExportTableDef(Db As DAO.Database, td As DAO.TableDef, ByVal tableNam
             If Not idx.Foreign Then
                 If Len(constraintSql) > 0 Then
                     sql = sql & "," & vbCrLf & "  " & constraintSql
-                    sql = sql & formatReferences(Db, idx.Fields, tableName)
+                    sql = sql & formatReferences(db, idx.Fields, tableName)
                 End If
             End If
         End If
@@ -189,14 +191,14 @@ Public Sub ExportTableDef(Db As DAO.Database, td As DAO.TableDef, ByVal tableNam
     
 End Sub
 
-Private Function formatReferences(Db As DAO.Database, ff As Object, _
+Private Function formatReferences(db As DAO.Database, ff As Object, _
                                   ByVal tableName As String) As String
 
     Dim rel As DAO.Relation
     Dim sql As String
     Dim f As DAO.Field
     
-    For Each rel In Db.Relations
+    For Each rel In db.Relations
         If (rel.foreignTable = tableName) Then
          If FieldsIdentical(ff, rel.Fields) Then
           sql = " REFERENCES "
@@ -311,7 +313,7 @@ End Function
 '
 ' RETURNS: True (it exists) or False (it does not exist).
 Private Function TableExists(ByVal TName As String) As Boolean
-    Dim Db As DAO.Database
+    Dim db As DAO.Database
     Dim Found As Boolean
     Dim test As String
     
@@ -319,13 +321,13 @@ Private Function TableExists(ByVal TName As String) As Boolean
     
      ' Assume the table or query does not exist.
     Found = False
-    Set Db = CurrentDb()
+    Set db = CurrentDb()
     
      ' Trap for any errors.
     On Error Resume Next
      
      ' See if the name is in the Tables collection.
-    test = Db.TableDefs(TName).name
+    test = db.TableDefs(TName).name
     If err.Number <> NAME_NOT_IN_COLLECTION Then Found = True
     
     ' Reset the error variable.
@@ -453,7 +455,7 @@ End Sub
 
 
 ' Kill Table if Exists
-Private Sub KillTable(ByVal tblName As String, Db As Object)
+Private Sub KillTable(ByVal tblName As String, db As Object)
     If TableExists(tblName) Then
         'Db.Execute "DROP TABLE [" & tblName & "]"
         run_sql "DROP TABLE [" & tblName & "]"
@@ -461,11 +463,11 @@ Private Sub KillTable(ByVal tblName As String, Db As Object)
 End Sub
 
 Public Sub ImportLinkedTable(ByVal tblName As String, ByRef obj_path As String)
-    Dim Db As DAO.Database
+    Dim db As DAO.Database
     Dim FSO As Object
     Dim InFile As Object
     
-    Set Db = CurrentDb
+    Set db = CurrentDb
     Set FSO = CreateObject("Scripting.FileSystemObject")
     
     Dim tempFilePath As String
@@ -489,7 +491,7 @@ err_notable_fin:
     On Error GoTo Err_CreateLinkedTable:
     
     Dim td As DAO.TableDef
-    Set td = Db.CreateTableDef(InFile.readline())
+    Set td = db.CreateTableDef(InFile.readline())
     
     Dim connect As String
     connect = InFile.readline()
@@ -499,7 +501,7 @@ err_notable_fin:
     td.connect = connect
     
     td.SourceTableName = InFile.readline()
-    Db.TableDefs.Append td
+    db.TableDefs.Append td
     
     GoTo Err_CreateLinkedTable_Fin
     
@@ -540,8 +542,10 @@ 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 Db As Object ' DAO.Database
+    
+    filepath = directory & to_filename(tblName) & ".sql"
+    
+    Dim db As Object ' DAO.Database
     Dim FSO As Object
     Dim InFile As Object
     Dim buf As String
@@ -562,9 +566,9 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
     
     ' 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
+    Set db = CurrentDb
     
-    KillTable tblName, Db
+    KillTable tblName, db
 
     buf = ReadFile(filepath, "x-ansi")
     
@@ -631,7 +635,7 @@ End Sub
 ' Import the lookup table `tblName` from `source\tables`.
 Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
     'On Error GoTo err
-    Dim Db As Object ' DAO.Database
+    Dim db As Object ' DAO.Database
     Dim rs As Object ' DAO.Recordset
     Dim fieldObj As Object ' DAO.Field
     Dim FSO As Object
@@ -650,11 +654,11 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
     
     ' 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
+    Set db = CurrentDb
 
     'Db.Execute "DELETE FROM [" & tblName & "]"
     run_sql "DELETE FROM [" & tblName & "]"
-    Set rs = Db.OpenRecordset(tblName)
+    Set rs = db.OpenRecordset(tblName)
     buf = InFile.readline()
     
     Do Until InFile.AtEndOfStream

+ 1 - 1
source/tables/USysOpenAccess.txt

@@ -1,3 +1,3 @@
 key	val
 include_tables	USysOpenAccess,USysRegInfo
-sources_date	24/11/2016 15:42:49
+sources_date	25/11/2016 14:41:25