cleanandvalidate/Redaction/Validation.xba

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Validation" script:language="StarBasic">Sub markval9

End Sub

Private Function isInDoc(searchString As String) As Boolean
	Dim founds As Object
	Dim sDesc As Object
	Dim srch(0) as new com.sun.star.beans.PropertyValue
	sDesc = Thiscomponent.createSearchDescriptor()
	sDesc.SearchAll = true
	sDesc.ValueSearch = false
	sDesc.SearchStyles = false 
	sDesc.SearchRegularExpression = true
	sDesc.SearchString = searchString 
	founds = Thiscomponent.findAll(sDesc)
	If founds.count &lt;&gt; 0 Then
		isInDoc = true
	Else
		isInDoc = false
	EndIf
End Function

Sub validateButton
	Dim footnotesReport As String
	Dim graphicsReport As String
	Dim sectionsReport As String
	Dim outlinePageStylesReport As String
	Dim outlineInNotesReport As String
	Dim oulineInTablesReport As String
	Dim badText As Boolean
	Dim badNumberings As Boolean
	Dim needExtendedInfo As Boolean
	Dim config As Object
 	config = initRedactionConfiguration()
	badText = false
	badNumberings = false
	footnotesReport = noteSingsCheck
	graphicsReport = checkGraphics
	sectionsReport = checkSectionsInTables
	outlineInNotesReport = checkNotesOutline()
	outlinePageStylesReport = checkHeadingsInHeadersFooters
	oulineInTablesReport = checkHeadingsInTextTables
	If outlineInNotesReport &lt;&gt; &quot;&quot; Then
		MsgBox outlineInNotesReport
	EndIf
	If oulineInTablesReport &lt;&gt; &quot;&quot; Then
		MsgBox oulineInTablesReport
	EndIf
	If outlinePageStylesReport &lt;&gt; &quot;&quot; Then
		MsgBox outlinePageStylesReport
	EndIf
	
	If footnotesReport &lt;&gt; &quot;&quot; Then
		MsgBox footnotesReport
	EndIf	
	If graphicsReport &lt;&gt; &quot;&quot; Then
		MsgBox graphicsReport
	EndIf
	If sectionsReport &lt;&gt; &quot;&quot; Then
		MsgBox sectionsReport
	EndIf
	If isInDoc(&quot;[\uE000-\uF8FF]&quot;) Then
		badText = true	
	EndIf

	If config.getPropertyValue(&quot;complexity&quot;) = &quot;makerUp&quot; then
		needExtendedInfo = true
	Else
		needExtendedInfo = false
	EndIf
	
	printNumberingSymbols(needExtendedInfo)
	
	If badText OR badNumberings OR footnotesReport &lt;&gt; &quot;&quot; OR graphicsReport &lt;&gt; &quot;&quot; Or outlineInNotesReport &lt;&gt; &quot;&quot; Or sectionsReport &lt;&gt; &quot;&quot; OR oulineInTablesReport &lt;&gt; &quot;&quot; OR outlinePageStylesReport &lt;&gt; &quot;&quot; Then
		MsgBox getTranslation(&quot;validationWarning&quot;)	
		If badText Then
			MsgBox getTranslation(&quot;validationBadSymbolsNotification&quot;)
			removeBadCharacters
		EndIf
	Else
      MsgBox getTranslation(&quot;validationSuccess&quot;)
	EndIf
End Sub

Private Function checkGraphics() As String
	Dim drawPages As Object
	Dim count as Integer
	Dim draw As Object
	Dim result As String
	result = &quot;&quot;
	Dim shapeType As String
	Dim embeededObject As Object
	Dim badFrame As Long
	badFrame = 0
	Dim drawingN As Long
	drawingN = 0
	drawPages = ThisComponent.DrawPage
	Dim i As Integer
	count = drawPages.getCount()
	For i = 0 to count-1
		draw = drawPages.getByIndex(i)
		shapeType = draw.ShapeType
		If InStr(shapeType,&quot;com.sun.star.drawing&quot;) = 1 Then
			drawingN = drawingN + 1 
		EndIf	
		If InStr(shapeType,&quot;FrameShape&quot;) = 1 Then
			If draw.supportsService(&quot;com.sun.star.text.TextEmbeddedObject&quot;) Then
				embeededObject = draw.getEmbeddedObject()
				If IsNull(embeededObject) Then
					badFrame = badFrame + 1 
				Else
					If Not embeededObject.supportsService(&quot;com.sun.star.formula.FormulaProperties&quot;) Then
						badFrame = badFrame + 1 
					Else
						&apos;Formula
					EndIf	
				EndIf
			EndIf
		EndIf	
	Next i
	If drawingN &lt;&gt; 0 Then
		result = result &amp; getTranslation(&quot;validationBadDrawings&quot;) &amp; drawingN &amp; getTranslation(&quot;validationExcerptNotSuitable&quot;) &amp; chr(10)
	EndIf
	If badFrame &lt;&gt; 0 Then
		result = result &amp; getTranslation(&quot;validationBadEmbeededObjects&quot;) &amp; badFrame &amp; getTranslation(&quot;validationExcerptNotSuitable&quot;) &amp; chr(10)
	EndIf
	checkGraphics = result
End Function

Private Sub removeBadCharacters
	StartTracking
    AskAndReplace(&quot;[\uE000-\uF8FF]+&quot;,&quot;&quot;)
	StopTracking
	showTrackedChanges
End Sub

Private Function noteSingsCheck() As String
	Dim footnotes As Object
	Dim footnote As Object
	Dim endnote As Object
	Dim endnotes As Object
	Dim count as Integer
	Dim charNum as Long
	Dim char As Long
	Dim label As String
	Dim result As String
	result = &quot;&quot;
	footnotes = ThisComponent.footnotes
	endnotes = ThisComponent.Footnotes
	count = footnotes.getCount
	Dim i As Integer
	Dim j As Integer
	For i = 0 to count-1
		footnote = footnotes.getByIndex(i)
		label = footnote.Label
		charNum = Len(label)
		For j = 1 to charNum
		  char = Asc(Right(Left(label,j),1))
		  If char &gt;= 57344 AND char &lt;= 63743 then
		  	result = result &amp; getTranslation(&quot;validateFootnotes1&quot;) &amp; &quot; &quot; &amp; Chr(char) &amp; &quot; &quot; &amp; getTranslation(&quot;validateFootnotes2&quot;) &amp; &quot; &quot; &amp; i &amp; &quot; &quot; &amp; getTranslation(&quot;validateFootnotes3&quot;) &amp; chr(10)
		  End If
		Next j
	Next i
	count = endnotes.getCount
	For i = 0 to count-1
		endnote = endnotes.getByIndex(i)
		label = endnote.Label
		charNum = Len(label)
		For j = 1 to charNum
		  char = Asc(Right(Left(label,j),1))
		  If char &gt;= 57344 AND char &lt;= 63743 then
		  	result = result &amp; getTranslation(&quot;validateFootnotes1&quot;) &amp; &quot; &quot; &amp; Chr(char) &amp; &quot; &quot; &amp; getTranslation(&quot;validateEndnotes1&quot;) &amp; &quot; &quot; &amp; i &amp; &quot; &quot; &amp; getTranslation(&quot;validateFootnotes3&quot;) &amp; chr(10)
		  End If
		Next j
	Next i
	noteSingsCheck = result
End Function

Function checkNotesOutline As String
	Dim oDescriptor As Object
	Dim footNotes As Object
	Dim endNotes As Object
	Dim x As Integer
	Dim aNote As Object
	Dim oEnum As Object
	Dim oCurPar As Object
	Dim result As String
	result = &quot;&quot;
	footNotes = thisComponent.footNotes
	endNotes = thisComponent.EndNotes
	for x = 0 to footNotes.Count -1
	  aNote = footNotes.getByIndex(x)
	  aNote.Anchor.CharStyleName=&quot;Footnote anchor&quot;
	  oEnum = aNote.Text.createEnumeration()
	  Do While oEnum.hasMoreElements()
	    oCurPar = oEnum.nextElement()
	    If oCurPar.OutlineLevel &gt; 0 Then
	    result = result &amp; getTranslation(&quot;validateFootnotes2&quot;)  &amp; &quot; &quot; &amp; x &amp; &quot; &quot; &amp; getTranslation(&quot;setOutlineLevel&quot;) &amp; &quot; &quot; &amp; oCurPar.OutlineLevel &amp; chr(10)
	    EndIf
	  Loop
	Next
	for x = 0 to endNotes.Count -1
	  aNote = endNotes.getByIndex(x)
	  aNote.Anchor.CharStyleName=&quot;Footnote anchor&quot;
	  oEnum = aNote.Text.createEnumeration()
	  Do While oEnum.hasMoreElements()
	    oCurPar = oEnum.nextElement()
	    If oCurPar.OutlineLevel &gt; 0 Then
	    result = result &amp; getTranslation(&quot;validateEndnotes1&quot;)  &amp; &quot; &quot; &amp; x &amp; &quot; &quot; &amp; getTranslation(&quot;setOutlineLevel&quot;) &amp; &quot; &quot; &amp; oCurPar.OutlineLevel &amp; chr(10)
	    EndIf
	  Loop
	Next
	checkNotesOutline = result
End Function

Function checkSectionsInTables As String
	Dim x As Integer
	Dim oEnum As Object
	Dim result As String
	Dim sections As Object
	Dim section As Object
	Dim anchor As Object
	Dim anchorText As Object
	result = &quot;&quot;
	sections = thisComponent.TextSections
	for x = 0 to sections.Count -1
	  section = sections.getByIndex(x)
	  anchor = section.getAnchor()
	  anchorText = anchor.getText()
	  If anchorText.supportsService(&quot;com.sun.star.text.CellProperties&quot;) Then
	    result = result &amp; getTranslation(&quot;section&quot;) &amp; &quot; &quot; &amp; section.Name &amp; &quot; &quot; &amp; getTranslation(&quot;isInTable&quot;) &amp; chr(10)
	  EndIf
	Next
	checkSectionsInTables = result
End Function

Function checkHeadingsInHeadersFooters As String
	Dim result As String
	Dim count As Integer
	Dim oStyle As Object
	Dim i As Integer
	result = &quot;&quot;
	Dim pageStyles As Object
    pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
	count = pageStyles.count - 1
    For i = 0  to count
      oStyle = pageStyles.getByIndex(i)
      If oStyle.isInUse Then
        If oStyle.HeaderIsOn Then
          If oStyle.HeaderIsShared Then
            If isHeadingsInText(oStyle.HeaderText) Then
              result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inHeader&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName()  &amp; chr(10)
            EndIf
          Else
            If isHeadingsInText(oStyle.HeaderTextLeft) Then
              result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inHeader&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName()  &amp; chr(10)
            EndIf
            If isHeadingsInText(oStyle.HeaderTextRight) Then
              result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inHeader&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName()  &amp; chr(10)
            EndIf
          EndIf
          If NOT oStyle.FirstIsShared Then
            If isHeadingsInText(oStyle.HeaderTextFirst) Then
              result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inHeader&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName()  &amp; chr(10)
            EndIf            
          EndIf
        EndIf
        If oStyle.FooterIsOn Then
          If oStyle.FooterIsShared Then
            If isHeadingsInText(oStyle.FooterText) Then
              result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inFooter&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName()  &amp; chr(10)
            EndIf          
          Else
            If isHeadingsInText(oStyle.FooterTextLeft) Then
              result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inFooter&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName()  &amp; chr(10)
            EndIf    
            If isHeadingsInText(oStyle.FooterTextRight) Then
              result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inFooter&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName()  &amp; chr(10)
            EndIf       
          EndIf
          If NOT oStyle.FirstIsShared Then
            If isHeadingsInText(oStyle.FooterTextFirst) Then
              result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inFooter&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName()  &amp; chr(10)
            EndIf            
          EndIf
        EndIf
      EndIf
    Next i
	checkHeadingsInHeadersFooters = result
End Function

Function checkHeadingsInTextTables(oText As Object) As String
	Dim enum1Element As Object
	Dim enum1 As Object
	Dim enum2 As Object
	Dim thisPortion As Object
	Dim footnoteText As Object
	Dim label As String
	Dim labelNum As Integer
	Dim i As Integer
	Dim count As Integer
	Dim cell As Object
	Dim cellText As Object
	Dim firstCellName As String
	Dim result As String
	result = &quot;&quot;
	enum1 = ThisComponent.Text.createEnumeration
	While enum1.hasMoreElements
		enum1Element = enum1.nextElement
		If enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
			firstCellName = enum1Element.getCellByPosition(0,0).cellName
			cellNames = enum1Element.cellNames
			For i = LBound(cellNames) To Ubound(cellNames)
				cell = enum1Element.getCellByName(cellNames(i))
				cellText = cell.getText()
				If cellNames(i) = firstCellName Then 
				  If isHeadingNotFirstInText(cellText) Then
				    result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;table&quot;) &amp; &quot; &quot; &amp; enum1Element.TableName &amp; chr(10)
				  EndIf
				Else
				  If isHeadingsInText(cellText) Then
				    result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;table&quot;) &amp; &quot; &quot; &amp; enum1Element.TableName &amp; chr(10)
				  EndIf
				EndIf
		    Next i
		EndIf
	Wend 
	checkHeadingsInTextTables = result
End Function

Function isHeadingNotFirstInText(oText As Object) As Boolean
	Dim enum1Element As Object
	Dim enum1 As Object
	Dim enum2 As Object
	Dim thisPortion As Object
	Dim footnoteText As Object
	Dim label As String
	Dim labelNum As Integer
	Dim i As Integer
	Dim count As Integer
	Dim cell As Object
	Dim cellText As Object
	Dim first As Boolean
	first = true
	enum1 = oText.createEnumeration
	While enum1.hasMoreElements
		enum1Element = enum1.nextElement
		If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
			If Not first Then
			  If enum1Element.OutlineLevel &gt; 0 Then
			    isHeadingNotFirstInText = true
			    Exit Function
			  EndIf
			EndIf
		ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
			cellNames = enum1Element.cellNames
			For i = LBound(cellNames) To Ubound(cellNames)
				cell = enum1Element.getCellByName(cellNames(i))
				cellText = cell.getText()
				If isHeadingsInText(cellText) Then
				  isHeadingNotFirstInText = true
			      Exit Function
				EndIf
		    Next i
		EndIf
		first = false
	Wend 
	isHeadingNotFirstInText = false
End Function

Function isHeadingsInText(oText As Object) As Boolean
	Dim enum1Element As Object
	Dim enum1 As Object
	Dim enum2 As Object
	Dim thisPortion As Object
	Dim footnoteText As Object
	Dim label As String
	Dim labelNum As Integer
	Dim i As Integer
	Dim count As Integer
	Dim cell As Object
	Dim cellText As Object
	enum1 = oText.Text.createEnumeration
	While enum1.hasMoreElements
		enum1Element = enum1.nextElement
		If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
			If enum1Element.OutlineLevel &gt; 0 Then
			  isHeadingsInText = true
			  Exit Function
			EndIf
			
		ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
			cellNames = enum1Element.cellNames
			For i = LBound(cellNames) To Ubound(cellNames)
				cell = enum1Element.getCellByName(cellNames(i))
				cellText = cell.getText()
				If isHeadingsInText(cellText) Then
				  isHeadingsInText = true
			      Exit Function
				EndIf
		    Next i
		EndIf
	Wend 
	isHeadingsInText = false
End Function

Private Sub printNumberingSymbols(needExtendedInfo)
	Dim families As Object 
	Dim numStyles As Object
	Dim numStyle As Object
	Dim numRules As Object
	Dim numRule As Object
	Dim prop As Object
	Dim enum1 As Object
	Dim enum1Element As Object
	Dim fontProp As Object
	Dim fontName As String
	Dim result As String  
	Dim resultBad As String
    Dim excerpt As String
    Dim exLength As Integer
   	Dim report As String
    Dim k As Integer
	families = ThisComponent.StyleFamilies
	numStyles = families.getByName(&quot;NumberingStyles&quot;)
	result = &quot;&quot;
	resultBad = &quot;&quot;
	enum1 = ThisComponent.Text.createEnumeration
	Do While enum1.hasMoreElements
		enum1Element = enum1.nextElement
		If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then	  
		  If NOT IsMissing(enum1Element.NumberingRules) AND NOT IsEmpty(enum1Element.NumberingRules) Then
            numRules = enum1Element.NumberingRules
		    If numRules.hasElements Then
		  	  numRule = numRules.getByIndex(enum1Element.NumberingLevel)
		  	  fontName = &quot;&quot;
		  	  fontChar = &quot;&quot;
		  	  For k = 0 To Ubound(numRule)
			    prop = numRule(k)
			    If prop.Name = &quot;BulletFont&quot; Then
				  fontName = prop.Value.Name
			    EndIf
			    If prop.Name = &quot;BulletChar&quot; Then
			      fontChar = prop.Value
			    EndIf
			  Next k
			  exLength = 15
			  excerpt = enum1Element.String
			  If Len(excerpt) &lt; exLength Then
			  	exLength = Len(excerpt)
			  EndIf
			  If fontChar &lt;&gt; &quot;&quot; Then
				  tmp = getTranslation(&quot;validateNumberingLevel&quot;) &amp;&quot; &quot; &amp; (j + 1) &amp; &quot; &quot; &amp; getTranslation(&quot;validateNumberingFont&quot;) &amp; &quot; &quot; &amp; fontName &amp; &quot; &quot; &amp; getTranslation(&quot;validateNumberingSymbol&quot;) &amp; &quot; &quot; &amp; fontChar &amp; &quot; (&quot; &amp; Hex(Asc(fontChar)) &amp; &quot;) &quot;&amp; Left(excerpt,exLength) &amp; chr(10) 
				  If Asc(fontChar) &gt; 57344  AND Asc(fontChar) &lt; 63743 Then
				  	resultBad = resultBad &amp; tmp
				  ElseIf fontName &lt;&gt; &quot;IPH Astra Serif&quot; _
				     AND fontName &lt;&gt; &quot;OpenSymbol&quot; _
				     AND fontName &lt;&gt; &quot;IPH Lib Serif&quot; _
				     AND fontName &lt;&gt; &quot;IPH Lib Sans&quot; _
				     AND fontName &lt;&gt; &quot;Liberation Serif&quot; _
				     AND fontName &lt;&gt; &quot;Liberation Sans&quot; _
				     AND needExtendedInfo Then
				  	result = result &amp; tmp
				  EndIf
			  EndIf
		    EndIf
		  EndIf
		EndIf
	Loop

	report = &quot;&quot;
	If result = &quot;&quot; AND resultBad = &quot;&quot; Then
		Exit sub
	Else  
	    If resultBad &lt;&gt; &quot;&quot; Then
	    	report = getTranslation(&quot;validateNumberingsReportSymbols&quot;) &amp; chr(10) &amp; resultBad
	    EndIf
	    If result &lt;&gt; &quot;&quot; Then
			report = report &amp; getTranslation(&quot;validateNumberingsReportFonts&quot;) &amp; &quot; &quot;&amp; chr(10)&amp; result
		EndIf
	EndIf
	MsgBox report	
End Sub

Private Sub showTrackedChanges
	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dispatcher.executeDispatch(document, &quot;.uno:AcceptTrackedChanges&quot;, &quot;&quot;, 0, Array())
	dim args2(0) as new com.sun.star.beans.PropertyValue
	args2(0).Name = &quot;ShowTrackedChanges&quot;
	args2(0).Value = true
	dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 0, args2())

end Sub

Private Sub StartTracking
	Dim dispatcher As Object
	Dim document As Object
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	document   = ThisComponent.CurrentController.Frame
	dim trackProperties(0) as new com.sun.star.beans.PropertyValue
	trackProperties(0).Name = &quot;TrackChanges&quot;
	trackProperties(0).Value = true
	dispatcher.executeDispatch(document, &quot;.uno:TrackChanges&quot;, &quot;&quot;, 0, trackProperties())
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = &quot;ShowTrackedChanges&quot;
	args1(0).Value = true
	dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 0, args1())
End Sub

Private Sub StopTracking
	Dim dispatcher As Object
	Dim document As Object
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	document   = ThisComponent.CurrentController.Frame
	Dim trackProperties(0) as new com.sun.star.beans.PropertyValue
	trackProperties(0).Name = &quot;TrackChanges&quot;
	trackProperties(0).Value = false
	dispatcher.executeDispatch(document, &quot;.uno:TrackChanges&quot;, &quot;&quot;, 0, trackProperties())
	Dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = &quot;ShowTrackedChanges&quot;
	args1(0).Value = true
	dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 0, args1())
End Sub

</script:module>