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 markval2

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 badText As Boolean
	Dim badNumberings As Boolean
	Dim badFootnoteSigns As Boolean
	Dim badGraphics As Boolean
	Dim needExtendedInfo As Boolean
	badGraphics = false
	badText = false
	badFootnoteSigns = false
	badNumberings = false
	footnotesReport = checkAllFootnotes
	graphicsReport = checkGraphics
	If footnotesReport &lt;&gt; &quot;&quot; Then
		badFootnoteSigns = true
	EndIf
	If graphicsReport &lt;&gt; &quot;&quot; Then
		badGraphics = true
	EndIf
	If isInDoc(&quot;[\uE000-\uF8FF]&quot;) Then
		badText = true	
	EndIf
	If badFootnoteSigns Then
		MsgBox footnotesReport
	EndIf
	If badGraphics Then
		MsgBox graphicsReport
	EndIf
	Dim config As Object
 	config = initRedactionConfiguration()
	If config.getPropertyValue(&quot;complexity&quot;) = &quot;makerUp&quot; then
		needExtendedInfo = true
	Else
		needExtendedInfo = false
	EndIf
		printNumberingSymbols(needExtendedInfo)
	
	If badText OR badNumberings OR badFootnoteSigns OR badGraphics Then
		MsgBox &quot;Перед публикацией документа следует исправить все найденные замечания.&quot;		
		If badText Then
			MsgBox &quot;В тексте обнаружены неподходящие для публикции символы.&quot; &amp; chr(10) &amp; &quot; Далее будет представлен список отрывков текста с подобными символами.&quot;
			removeBadCharacters
		EndIf
	Else
      MsgBox &quot;Документ успешно прошел проверку. &quot; &amp; chr(10) &amp; &quot;Все изображения и символы корректны.&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;&quot;В документе найдены рисунки (&quot; &amp; drawingN &amp; &quot;), неподходящие для публикации.&quot; &amp; chr(10)
	EndIf
	If badFrame &lt;&gt; 0 Then
		result = result &amp;&quot;В документе найдены встроенные объекты (&quot; &amp; badFrame &amp; &quot;), неподходящие для публикации.&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 checkAllFootnotes() As String
	Dim footnotes 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
	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; &quot;Символ &quot;&amp; Chr(char) &amp;&quot; сноски &quot;&amp; i &amp;&quot; не подходит для публикации&quot;&amp; chr(10)
		  End If
		Next j
	Next i
	checkAllFootnotes = 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 = &quot;Уровень &quot; &amp; (j + 1) &amp; &quot; шрифт &quot; &amp; fontName &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 = &quot;В качестве маркера в следующих списках нумерации задан некорректный символ&quot;&amp; chr(10) &amp; resultBad
	    EndIf
	    If result &lt;&gt; &quot;&quot; Then
			report = report &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>