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 markval4

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 outlineInNotesReport 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
	outlineInNotesReport = checkNotesOutline()
	If outlineInNotesReport &lt;&gt; &quot;&quot; Then
		MsgBox outlineInNotesReport
	EndIf
	If footnotesReport &lt;&gt; &quot;&quot; Then
		MsgBox footnotesReport
	EndIf	
	If graphicsReport &lt;&gt; &quot;&quot; Then
		MsgBox graphicsReport
	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; 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 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.footNotes
	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

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>