cleanandvalidate/IPHRedaction/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 markZZZ

End Sub

Private Function isInDoc(searchString As String)
	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
	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
	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


Sub testcheckGraphics
	checkGraphics
End Sub

Private Function checkGraphics
	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
&apos;	Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
&apos;	MRI ThisComponent
	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
			embeededObject = draw.getEmbeddedObject()
			If Not embeededObject.supportsService(&quot;com.sun.star.formula.FormulaProperties&quot;) Then
				badFrame = badFrame + 1 
			Else
				&apos;Formula
			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()
	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
	For i = 0 to count-1
		footnote = footnotes.getByIndex(i)
&apos;		Mri footnote
		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 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
	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
	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>