cleanandvalidate/IPHRedaction/Validation.xba

185 lines
6.5 KiB
Text
Raw Normal View History

2019-10-16 15:42:48 +03:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
2019-10-21 13:25:47 +03:00
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Validation" script:language="StarBasic">Sub markZZZX
2019-10-16 15:42:48 +03:00
End Sub
2019-10-17 18:48:22 +03:00
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
2019-10-16 16:17:28 +03:00
Sub validateButton
2019-10-17 18:48:22 +03:00
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
2019-10-18 18:56:22 +03:00
MsgBox &quot;Перед публикацией документа следует исправить все найденные замечания.&quot;
2019-10-17 18:48:22 +03:00
If badText Then
MsgBox &quot;В тексте обнаружены неподходящие для публикции символы.&quot; &amp; chr(10) &amp; &quot; Далее будет представлен список отрывков текста с подобными символами.&quot;
removeBadCharacters
EndIf
Else
2019-10-28 10:59:10 +03:00
MsgBox &quot;Документ успешно прошел проверку. &quot; &amp; chr(10) &amp; &quot;Все изображения и символы корректны.&quot;
2019-10-17 18:48:22 +03:00
EndIf
2019-10-17 00:31:08 +03:00
End Sub
2019-10-17 18:48:22 +03:00
Sub testcheckGraphics
checkGraphics
End Sub
Private Function checkGraphics
Dim drawPages As Object
Dim count as Integer
Dim draw As Object
Dim result As String
2019-10-18 18:56:22 +03:00
result = &quot;&quot;
2019-10-17 18:48:22 +03:00
Dim shapeType As String
2019-10-18 18:56:22 +03:00
Dim embeededObject As Object
Dim badFrame As Long
badFrame = 0
2019-10-17 18:48:22 +03:00
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
2019-10-18 18:56:22 +03:00
If InStr(shapeType,&quot;FrameShape&quot;) = 1 Then
2019-10-21 13:25:47 +03:00
&apos; Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
&apos; MRI draw
If draw.supportsService(&quot;com.sun.star.text.TextEmbeddedObject&quot;) Then
embeededObject = draw.getEmbeddedObject()
If Not embeededObject.supportsService(&quot;com.sun.star.formula.FormulaProperties&quot;) Then
badFrame = badFrame + 1
Else
&apos;Formula
EndIf
2019-10-18 18:56:22 +03:00
EndIf
EndIf
2019-10-17 18:48:22 +03:00
Next i
If drawingN &lt;&gt; 0 Then
2019-10-18 18:56:22 +03:00
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)
2019-10-17 18:48:22 +03:00
EndIf
checkGraphics = result
End Function
2019-10-17 00:31:08 +03:00
Private Sub removeBadCharacters
StartTracking
AskAndReplace(&quot;[\uE000-\uF8FF]+&quot;,&quot;&quot;)
2019-10-17 18:48:22 +03:00
2019-10-17 00:31:08 +03:00
StopTracking
showTrackedChanges
End Sub
2019-10-17 18:48:22 +03:00
Private Function checkAllFootnotes()
2019-10-17 00:31:08 +03:00
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
2019-10-17 18:48:22 +03:00
result = result &amp; &quot;Символ &quot;&amp; Chr(char) &amp;&quot; сноски &quot;&amp; i &amp;&quot; не подходит для публикации&quot;&amp; chr(10)
2019-10-17 00:31:08 +03:00
End If
Next j
Next i
2019-10-17 18:48:22 +03:00
checkAllFootnotes = result
End Function
2019-10-16 15:42:48 +03:00
2019-10-17 00:31:08 +03:00
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
2019-10-28 10:59:10 +03:00
</script:module>