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

1 回答

• 1

  看看cOOol . 您可以使用它而不是创建宏，或者从代码中借用一些概念 .

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

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

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

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

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

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

  EDIT ：

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

  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，此代码现在打开正确的编辑链接（只要在消息框中单击“是”） .

  回复于 2024-04-26T16:22:07+08:00