Просмотр исходного кода

inclus sanitize à exportobject

olivier.massot 9 лет назад
Родитель
Сommit
9a48cdae16

BIN
OpenAccess.zip


+ 4 - 0
_.gitlab-ci.yml

@@ -0,0 +1,4 @@
+job1:
+  script:
+    - cd .\tests
+    - python test.py

+ 134 - 2
source/modules/VCS_IE_Functions.bas

@@ -34,8 +34,13 @@ Public Sub ExportObject(ByVal obj_type_num As Integer, ByVal obj_name As String,
     Else
         Application.SaveAsText obj_type_num, obj_name, file_path
     End If
-    
+
     logger "ExportObject", "DEBUG", "Object of type " & obj_type_num & " named " & obj_name & " exported to " & file_path
+    
+    If obj_type_num <> acModule Then
+        SanitizeFile file_path
+    End If
+    
 End Sub
 
 ' Import a database object with optional UTF-8-to-UCS2 conversion.
@@ -70,7 +75,134 @@ err:
     logger "ImportObject", "CRITICAL", "Unable to import the object " & obj_name & " (" & obj_type_num & ")" & "[" & err.Description & "]"
 End Sub
 
-'shouldn't this be SanitizeTextFile (Singular)?
+Public Sub SanitizeFile(ByVal filepath As String)
+' cleans the file from unnecessary lines
+
+    Dim FSO As Object
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    
+    '  Setup Block matching Regex.
+    Dim rxBlock As Object
+    Set rxBlock = CreateObject("VBScript.RegExp")
+    rxBlock.ignoreCase = False
+    
+    '  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
+        srchPattern = srchPattern & "|GUID|""GUID""|NameMap|dbLongBinary ""DOL"""
+        srchPattern = srchPattern & ")"
+    End If
+    
+    '  Ensure that this is the begining of a block.
+    srchPattern = srchPattern & " = Begin"
+    rxBlock.Pattern = srchPattern
+
+    '  Setup Line Matching Regex.
+    Dim rxLine As Object
+    Set rxLine = CreateObject("VBScript.RegExp")
+    srchPattern = "^\s*(?:"
+    srchPattern = srchPattern & "Checksum ="
+    srchPattern = srchPattern & "|BaseInfo|NoSaveCTIWhenDisabled =1"
+    If (StripPublishOption = True) Then
+        srchPattern = srchPattern & "|dbByte ""PublishToWeb"" =""1"""
+        srchPattern = srchPattern & "|PublishOption =1"
+    End If
+    srchPattern = srchPattern & ")"
+    rxLine.Pattern = srchPattern
+    
+    
+    Dim isReport As Boolean
+    isReport = False
+
+'    Dim dir_name, file_name, obj_name As String
+'
+'    obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+
+    Dim InFile As Object
+    Set InFile = FSO.OpenTextFile(filepath, iomode:=ForReading, Create:=False, Format:=TristateFalse)
+    
+    Dim OutFile As Object
+    Set OutFile = FSO.CreateTextFile(filepath & ".sanitize", overwrite:=True, unicode:=False)
+
+    Dim getLine As Boolean
+    getLine = True
+    
+    Do Until InFile.AtEndOfStream
+        DoEvents
+        Dim txt As String
+        '
+        ' Check if we need to get a new line of text
+        If getLine = True Then
+            txt = InFile.readline
+        Else
+            getLine = True
+        End If
+        
+        ' Skip lines starting with line pattern
+        If rxLine.test(txt) Then
+            Dim rxIndent As Object
+            Set rxIndent = CreateObject("VBScript.RegExp")
+            rxIndent.Pattern = "^(\s+)\S"
+            '
+            ' Get indentation level.
+            Dim matches As Object
+            Set matches = rxIndent.Execute(txt)
+            '
+            ' Setup pattern to match current indent
+            Select Case matches.count
+                Case 0
+                    rxIndent.Pattern = "^" & vbNullString
+                Case Else
+                    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
+            Loop
+            ' We've moved on at least one line so do get a new one
+            ' when starting the loop again.
+            getLine = False
+        '
+        ' skip blocks of code matching block pattern
+        ElseIf rxBlock.test(txt) Then
+            Do Until InFile.AtEndOfStream
+                txt = InFile.readline
+                If InStr(txt, "End") Then Exit Do
+            Loop
+        ElseIf InStr(1, txt, "Begin Report") = 1 Then
+            isReport = True
+            OutFile.WriteLine txt
+        ElseIf isReport = True And (InStr(1, txt, "    Right =") Or InStr(1, txt, "    Bottom =")) Then
+            'skip line
+            If InStr(1, txt, "    Bottom =") Then
+                isReport = False
+            End If
+        Else
+            OutFile.WriteLine txt
+        End If
+    Loop
+    OutFile.Close
+    InFile.Close
+
+    FSO.DeleteFile (filepath)
+
+    Dim thisFile As Object
+    Set thisFile = FSO.GetFile(filepath & ".sanitize")
+    thisFile.Move (filepath)
+    
+    logger "SanitizeFile", "DEBUG", "> File " & filepath & " sanitized"
+
+
+End Sub
+
 
 ' For each *.txt in `Path`, find and remove a number of problematic but
 ' unnecessary lines of VB code that are inserted automatically by the

+ 0 - 10
source/modules/VCS_ImportExport.bas

@@ -121,10 +121,6 @@ next_qry:
     Next
     logger "ExportAllSource", "INFO", "> " & obj_count & " queries exported"
     
-    
-    Call SysCmd(4, "Sanitize queries")
-    logger "ExportAllSource", "INFO", "Sanitize queries..."
-    VCS_IE_Functions.SanitizeTextFiles obj_path, "bas"
         
     For Each obj_type In Split( _
         "forms|Forms|" & acForm & "," & _
@@ -187,12 +183,6 @@ next_doc:
         
         logger "ExportAllSource", "INFO", "> " & obj_count & " " & obj_type_label & " exported"
         
-        Call SysCmd(4, "Sanitize " & obj_type_label)
-        If obj_type_label <> "modules" Then
-            logger "ExportAllSource", "INFO", "Sanitizing " & obj_type_label
-            VCS_IE_Functions.SanitizeTextFiles obj_path, "bas"
-        End If
-        
     Next
     
     Call SysCmd(4, "Exporting references")

+ 1 - 1
source/tables/USysOpenAccess.txt

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