Question

我正在为LibreOffice Writer创建一个Basic宏来检查内部链接是否损坏。简而言之：

生成所有锚点的列表
遍历文档，查找内部超链接
如果内部超链接不在锚列表中，请将其打开以进行编辑（并停止）

我的代码有一些未解决的问题：

（fnBuildAnchorList内）我们如何获得每个标题的编号？例如，如果第一个1级标题文本为“简介”，则正确的锚点为#1.Introduction|outline，我们正在录制Introduction|outline
（subInspectLink内）我们如何正确测试标题的超链接？我注意到当我手动跟踪到标题的链接时，它会在编号相同时成功，但是当文本相同时。例如
如果有内部链接#1.My first heading|outline，则可以使用超链接#1.Previous header name|outline 来访问它，还可以使用超链接#2.3.5.My first heading|outline 来访问
（在subInspectLink内）我们如何打开特定的超链接进行编辑？我们是否将参数传递给.uno:EditHyperlink？我们移动光标吗？（我发现的所有动作都是相对的，例如.uno:GoRight）我们是否使用文本部分的.Start和.End属性？

REM  *****  BASIC  *****
Option Explicit


' PrintArray displays a MsgBox with the whole array
' for DEBUG purposes only
Sub subPrintArray(sTitle as String, theArray() as String)
    Dim sArray
    sArray = sTitle & ":" & Chr(13) & Join(theArray,Chr(13))
    MsgBox(sArray, 64, "***DEBUG")
End sub

' auxiliary sub for BuildAnchorList
Sub subAddItemToAnchorList (oAnchors() as String, sTheAnchor as String, sType as String)
    Dim sAnchor
    Select Case sType
        Case "Heading":
            sAnchor = sTheAnchor + "|outline"
        Case "Table":
            sAnchor = sTheAnchor + "|table"
        Case "Text Frame":
            sAnchor = sTheAnchor + "|frame"
        Case "Image":
            sAnchor = sTheAnchor + "|graphic"
        Case "Object":
            sAnchor = sTheAnchor + "|ole"
        Case "Section":
            sAnchor = sTheAnchor + "|region"
        Case "Bookmark":
            sAnchor = sTheAnchor
    End Select
    ReDim Preserve oAnchors(UBound(oAnchors)+1) as String
    oAnchors(UBound(oAnchors)) = sAnchor
End Sub

' auxiliary sub for BuildAnchorList
Sub subAddArrayToAnchorList (oAnchors() as String, oNewAnchors() as String, sType as String)
    Dim i, iStart, iStop
    iStart = LBound(oNewAnchors)
    iStop = UBound(oNewAnchors)
    If iStop < iStart then Exit Sub ' empty array, nothing to do
    For i = iStart to iStop
        subAddItemToAnchorList (oAnchors, oNewAnchors(i), sType)
    Next
End Sub

Function fnBuildAnchorList()
    Dim oDoc as Object, oAnchors() as String
    oDoc = ThisComponent

    ' get the whole document outline
    Dim oParagraphs, thisPara, oTextPortions, thisPortion
    oParagraphs = oDoc.Text.createEnumeration ' all the paragraphs
    Do While oParagraphs.hasMoreElements
        thisPara = oParagraphs.nextElement
        If thisPara.ImplementationName = "SwXParagraph" then ' is a paragraph
            If thisPara.OutlineLevel>0 Then ' is a heading
                ' ***
                ' *** TO DO: How do we get the numbering for each heading?
                ' For example, if the first level 1 heading text is “Introduction”,
                ' the correct anchor is `#1.Introduction|outline`
                ' and we are recording `Introduction|outline`
                ' ***
                subAddItemToAnchorList (oAnchors, thisPara.String, "Heading")
            End if
        End if
    Loop
    ' text tables, text frames, images, objects, bookmarks and text sections
    subAddArrayToAnchorList(oAnchors, oDoc.getTextTables().ElementNames, "Table")
    subAddArrayToAnchorList(oAnchors, oDoc.getTextFrames().ElementNames, "Text Frame")
    subAddArrayToAnchorList(oAnchors, oDoc.getGraphicObjects().ElementNames, "Image")
    subAddArrayToAnchorList(oAnchors, oDoc.getEmbeddedObjects().ElementNames, "Object")
    subAddArrayToAnchorList(oAnchors, oDoc.Bookmarks.ElementNames, "Bookmark")
    subAddArrayToAnchorList(oAnchors, oDoc.getTextSections().ElementNames, "Section")

    fnBuildAnchorList = oAnchors
End Function

Function fnIsInArray( theString as String, theArray() as String )
    Dim i as Integer, iStart as Integer, iStop as Integer
    iStart = LBound(theArray)
    iStop = UBound(theArray)
    If iStart<=iStop then
        For i = iStart to iStop
            If theString = theArray(i) then
                fnIsInArray = True
                Exit function
            End if
        Next
    End if
    fnIsInArray = False
End function

Function fnIsOutlineInArray ( theString as String, theArray() as String )
    Dim i as Integer
    For i = LBound(theArray) to UBound(theArray)
        If theArray(i) = Right(theString,Len(theArray(i))) then
            fnIsOutlineInArray = True
            Exit function
        End if
    Next
    fnIsOutlineInArray = False
End function

' auxiliary function to FindBrokenInternalLinks
' inspects any links inside the current document fragment
' used to have an enumeration inside an enumeration, per OOo examples,
' but tables don't have .createEnumeration
Sub subInspectLinks( oAnchors as Object, oFragment as Object, iFragments as Integer, iLinks as Integer )
    Dim sMsg, sImplementation, thisPortion
    sImplementation = oFragment.implementationName
    Select Case sImplementation

        Case "SwXParagraph":
            ' paragraphs can be enumerated
            Dim oParaPortions, sLink, notFound
            oParaPortions = oFragment.createEnumeration
            ' go through all the text portions in current paragraph
            While oParaPortions.hasMoreElements
                thisPortion = oParaPortions.nextElement
                iFragments = iFragments + 1
                If Left(thisPortion.HyperLinkURL, 1) = "#" then
                    ' internal link found: get it all except initial # character
                    iLinks = iLinks + 1
                    sLink = right(thisPortion.HyperLinkURL, Len(thisPortion.HyperLinkURL)-1)
                    If Left(sLink,14) = "__RefHeading__" then
                        ' link inside a table of contents, no need to check
                        notFound = False
                    Elseif Right(sLink,8) = "|outline" then
                        ' special case for outline: since we don't know how to get the
                        ' outline numbering, we have to match the right most part of the
                        ' link only
                        notFound = not fnIsOutlineInArray(sLink, oAnchors)
                    Else
                        notFound = not fnIsInArray(sLink, oAnchors)
                    End if
                    If notFound then
                        ' anchor not found
                        ' *** DEBUG: code below up to MsgBox
                        sMsg = "Fragment #" & iFragments & ", internal link #" & iLinks & Chr(13) _
                            & "Bad link: [" & thisPortion.String & "] -> [" _
                            & thisPortion.HyperLinkURL & "] " & Chr(13) _
                            & "Paragraph:" & Chr(13) & oFragment.String & Chr(13) _
                            & "OK to continue, Cancel to stop"
                        Dim iChoice as Integer
                        iChoice = MsgBox (sMsg, 48+1, "Find broken internal link")
                        If iChoice = 2 Then End
                        ' ***
                        ' *** TO DO: How do we open a _specific_ hyperlink for editing?
                        ' Do we pass parameters to `.uno:EditHyperlink`?
                        ' Do we move the cursor? (Except all moves I found were relative,
                        ' e.g. `.uno:GoRight`)
                        ' Do we use the text portion’s `.Start` and `.End` properties?
                        ' ***
                    End If
                End if
            Wend
            ' *** END paragraph

        Case "SwXTextTable":
            ' text tables have cells
            Dim i, eCells, thisCell, oCellPortions
            eCells = oFragment.getCellNames()
            For i = LBound(eCells) to UBound(eCells)
                thisCell = oFragment.getCellByName(eCells(i))
                oCellPortions = thisCell.createEnumeration
                    While oCellPortions.hasMoreElements
                        thisPortion = oCellPortions.nextElement
                        iFragments = iFragments + 1
                        ' a table cell may contain a paragraph or another table,
                        ' so call recursively
                        subInspectLinks (oAnchors, thisPortion, iFragments, iLinks)
                    Wend
'               xray thisPortion
                'SwXCell has .String
            Next
            ' *** END text table

        Case Else
            sMsg = "Implementation method '" & sImplementation & "' not covered by regular code." _
                & "OK to continue, Cancel to stop"
            If 2 = MsgBox(sMsg, 48+1) then End
            ' uses xray for element inspection; if not available, comment the two following lines
            BasicLibraries.loadLibrary("XrayTool")
            xray oFragment
            ' *** END unknown case

    End Select
End sub

Sub FindBrokenInternalLinks
    ' Find the next broken internal link
    '
    ' Pseudocode:
    '
    ' * generate link of anchors - *** TO DO: prefix the outline numbering for headings
    ' * loop, searching for internal links
    '     - is the internal link in the anchor list?
    '         * Yes: continue to next link
    '         * No: (broken link found)
    '             - select that link text - *** TO DO: cannot select it
    '             - open link editor so user can fix this
    '             - stop
    ' * end loop
    ' * display message "No bad internal links found"

    Dim oDoc as Object, oFragments as Object, thisFragment as Object
    Dim iFragments as Integer, iLinks as Integer, sMsg as String
    Dim oAnchors() as String ' list of all anchors in the document
'   Dim sMsg ' for MsgBox

    oDoc = ThisComponent

    ' get all document anchors
    oAnchors = fnBuildAnchorList()
'   subPrintArray("Anchor list", oAnchors) ' *** DEBUG ***
'   MsgBox( UBound(oAnchors)-LBound(oAnchors)+1 & " anchors found – stand by for checking")

    ' find links    
    iFragments = 0 ' fragment counter
    iLinks = 0     ' internal link counter
    oFragments = oDoc.Text.createEnumeration ' has all the paragraphs
    While oFragments.hasMoreElements
        thisFragment = oFragments.nextElement
        iFragments = iFragments + 1
        subInspectLinks (oAnchors, thisFragment, iFragments, iLinks)
    Wend
    If iLinks then
        sMsg = iLinks & " internal links found, all good"
    Else
        sMsg = "This document has no internal links"
    End if
    MsgBox (sMsg, 64, "Find broken internal link")

End Sub

' *** END FindBrokenInternalLinks ***

您可以使用带有标题的任何文档检查第一个问题 - 将弹出一个包含所有锚点的MsgBox，您将看到缺少的大纲编号。

第二个问题需要一个内部链接不良的文档。

Answer 1

结帐cOOol。你可以使用它而不是创建一个宏，或者从代码中借用一些概念。

测试链接（可能使用.uno:JumpToMark）似乎不太有用，因为即使目标不存在，内部链接也总是某处。相反，按照您的建议构建一个有效目标列表。

要保存有效目标列表，cOOol代码使用Python集。如果要使用Basic，则数据结构更受限制。但是，它可以通过声明一个新的a来完成 Collection对象或者使用基本数组，也许使用ReDim。

另请参阅cOOol代码如何定义有效的目标字符串。例如：

internal_targets.add('0.' * heading_level + data + '|outline')

要打开超链接对话框，请选择超链接文本，然后调用：

dispatcher.executeDispatch(document, ".uno:EditHyperlink", "", 0, Array())

修改：

好的，我在这方面工作了几个小时，并提出了以下代码：

REM ***** BASIC ***** Option Explicit ' PrintArray displays a MsgBox with the whole array ' for DEBUG purposes only Sub subPrintArray(sTitle as String, theArray() as String) Dim sArray sArray = sTitle & ":" & Chr(13) & Join(theArray,Chr(13)) MsgBox(sArray, 64, "***DEBUG") End sub ' auxiliary sub for BuildAnchorList Sub subAddItemToAnchorList (oAnchors() as String, sTheAnchor as String, sType as String) Dim sAnchor Select Case sType Case "Heading": sAnchor = sTheAnchor + "|outline" Case "Table": sAnchor = sTheAnchor + "|table" Case "Text Frame": sAnchor = sTheAnchor + "|frame" Case "Image": sAnchor = sTheAnchor + "|graphic" Case "Object": sAnchor = sTheAnchor + "|ole" Case "Section": sAnchor = sTheAnchor + "|region" Case "Bookmark": sAnchor = sTheAnchor End Select ReDim Preserve oAnchors(UBound(oAnchors)+1) as String oAnchors(UBound(oAnchors)) = sAnchor End Sub ' auxiliary sub for BuildAnchorList Sub subAddArrayToAnchorList (oAnchors() as String, oNewAnchors() as String, sType as String) Dim i, iStart, iStop iStart = LBound(oNewAnchors) iStop = UBound(oNewAnchors) If iStop < iStart then Exit Sub ' empty array, nothing to do For i = iStart to iStop subAddItemToAnchorList (oAnchors, oNewAnchors(i), sType) Next End Sub ' Updates outlineLevels for the current level. ' Returns a string like "1.2.3" Function fnGetOutlinePrefix(outlineLevel as Integer, outlineLevels() as Integer) Dim level as Integer, prefix as String outlineLevels(outlineLevel) = outlineLevels(outlineLevel) + 1 For level = outlineLevel + 1 to 9 ' Reset all lower levels. outlineLevels(level) = 0 Next prefix = "" For level = 0 To outlineLevel prefix = prefix & outlineLevels(level) & "." Next fnGetOutlinePrefix = prefix End Function Function fnBuildAnchorList() Dim oDoc as Object, oAnchors() as String, anchorName as String Dim level as Integer, levelCounter as Integer Dim outlineLevels(10) as Integer For level = 0 to 9 outlineLevels(level) = 0 Next oDoc = ThisComponent ' get the whole document outline Dim oParagraphs, thisPara, oTextPortions, thisPortion oParagraphs = oDoc.Text.createEnumeration ' all the paragraphs Do While oParagraphs.hasMoreElements thisPara = oParagraphs.nextElement If thisPara.ImplementationName = "SwXParagraph" then ' is a paragraph If thisPara.OutlineLevel>0 Then ' is a heading level = thisPara.OutlineLevel - 1 anchorName = fnGetOutlinePrefix(level, outlineLevels) & thisPara.String subAddItemToAnchorList (oAnchors, anchorName, "Heading") End if End if Loop ' text tables, text frames, images, objects, bookmarks and text sections subAddArrayToAnchorList(oAnchors, oDoc.getTextTables().ElementNames, "Table") subAddArrayToAnchorList(oAnchors, oDoc.getTextFrames().ElementNames, "Text Frame") subAddArrayToAnchorList(oAnchors, oDoc.getGraphicObjects().ElementNames, "Image") subAddArrayToAnchorList(oAnchors, oDoc.getEmbeddedObjects().ElementNames, "Object") subAddArrayToAnchorList(oAnchors, oDoc.Bookmarks.ElementNames, "Bookmark") subAddArrayToAnchorList(oAnchors, oDoc.getTextSections().ElementNames, "Section") fnBuildAnchorList = oAnchors End Function Function fnIsInArray( theString as String, theArray() as String ) Dim i as Integer For i = LBound(theArray()) To UBound(theArray()) If theString = theArray(i) Then fnIsInArray = True Exit function End if Next fnIsInArray = False End function ' Open a _specific_ hyperlink for editing. Sub subEditHyperlink(textRange as Object) Dim document As Object Dim dispatcher As Object Dim oVC As Object oVC = ThisComponent.getCurrentController().getViewCursor() oVC.gotoRange(textRange.getStart(), False) document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:EditHyperlink", "", 0, Array()) End Sub ' auxiliary function to FindBrokenInternalLinks ' inspects any links inside the current document fragment ' used to have an enumeration inside an enumeration, per OOo examples, ' but tables don't have .createEnumeration Sub subInspectLinks(oAnchors() as String, oFragment as Object, iFragments as Integer, iLinks as Integer, iBadLinks as Integer) Dim sMsg, sImplementation, thisPortion sImplementation = oFragment.implementationName Select Case sImplementation Case "SwXParagraph": ' paragraphs can be enumerated Dim oParaPortions, sLink, notFound oParaPortions = oFragment.createEnumeration ' go through all the text portions in current paragraph While oParaPortions.hasMoreElements thisPortion = oParaPortions.nextElement iFragments = iFragments + 1 If Left(thisPortion.HyperLinkURL, 1) = "#" then ' internal link found: get it all except initial # character iLinks = iLinks + 1 sLink = right(thisPortion.HyperLinkURL, Len(thisPortion.HyperLinkURL)-1) If Left(sLink,14) = "__RefHeading__" then ' link inside a table of contents, no need to check notFound = False Else notFound = not fnIsInArray(sLink, oAnchors) End if If notFound then ' anchor not found ' *** DEBUG: code below up to MsgBox iBadLinks = iBadLinks + 1 sMsg = "Fragment #" & iFragments & ", internal link #" & iLinks & Chr(13) _ & "Bad link: [" & thisPortion.String & "] -> [" _ & thisPortion.HyperLinkURL & "] " & Chr(13) _ & "Paragraph:" & Chr(13) & oFragment.String & Chr(13) _ & "Yes to edit link, No to continue, Cancel to stop" Dim iChoice as Integer iChoice = MsgBox (sMsg, MB_YESNOCANCEL + MB_ICONEXCLAMATION, _ "Find broken internal link") If iChoice = IDCANCEL Then End ElseIf iChoice = IDYES Then subEditHyperlink(thisPortion) End If End If End if Wend ' *** END paragraph Case "SwXTextTable": ' text tables have cells Dim i, eCells, thisCell, oCellPortions eCells = oFragment.getCellNames() For i = LBound(eCells) to UBound(eCells) thisCell = oFragment.getCellByName(eCells(i)) oCellPortions = thisCell.createEnumeration While oCellPortions.hasMoreElements thisPortion = oCellPortions.nextElement iFragments = iFragments + 1 ' a table cell may contain a paragraph or another table, ' so call recursively subInspectLinks (oAnchors, thisPortion, iFragments, iLinks) Wend ' xray thisPortion 'SwXCell has .String Next ' *** END text table Case Else sMsg = "Implementation method '" & sImplementation & "' not covered by regular code." _ & "OK to continue, Cancel to stop" If 2 = MsgBox(sMsg, 48+1) then End ' uses xray for element inspection; if not available, comment the two following lines BasicLibraries.loadLibrary("XrayTool") xray oFragment ' *** END unknown case End Select End sub Sub FindBrokenInternalLinks ' Find the next broken internal link ' ' Pseudocode: ' ' * generate link of anchors - *** TO DO: prefix the outline numbering ' * for headings loop, searching for internal links ' - is the internal link in the anchor list? ' * Yes: continue to next link ' * No: (broken link found) ' - select that link text - *** TO DO: cannot select it ' - open link editor so user can fix this ' - stop ' * end loop ' * display message "No bad internal links found" Dim oDoc as Object, oFragments as Object, thisFragment as Object Dim iFragments as Integer, iLinks as Integer, iBadLinks as Integer, sMsg as String Dim oAnchors() as String ' list of all anchors in the document oDoc = ThisComponent ' get all document anchors oAnchors = fnBuildAnchorList() ' subPrintArray("Anchor list", oAnchors) ' *** DEBUG *** ' MsgBox( UBound(oAnchors)-LBound(oAnchors)+1 & " anchors found – stand by for checking") ' find links iFragments = 0 ' fragment counter iLinks = 0 ' internal link counter iBadLinks = 0 oFragments = oDoc.Text.createEnumeration ' has all the paragraphs While oFragments.hasMoreElements thisFragment = oFragments.nextElement iFragments = iFragments + 1 subInspectLinks (oAnchors, thisFragment, iFragments, iLinks, iBadLinks) Wend If iBadLinks > 0 Then sMsg = iBadLinks & " bad link(s), " & iLinks - iBadLinks & " good link(s)" ElseIf iLinks Then sMsg = iLinks & " internal link(s) found, all good" Else sMsg = "This document has no internal links" End if MsgBox (sMsg, 64, "Find broken internal link") End Sub ' *** END FindBrokenInternalLinks ***

现在检查大纲编号。也许它太严格了 - 或许可以选择关闭大纲编号检查。

就问题3而言，此代码现在打开正确的编辑链接（只要在消息框中单击＆＃34;是＆＃34;）。

如何在Star Basic中检查内部链接是否损坏？

1 个答案: