Parsing POST request with unexpected URL encoding - parsing

This question follows an earlier one.
Here is some code that reproduces the problem:
POST:
str = "accountRequest=<NewUser>" & vbLf & _
"Hello" & vbTab & "World" & vbLf & _
"</NewUser>"
Set objHTTP = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
objHTTP.open "POST", "service.asp", False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send str
response.Write(objHTTP.responseText)
Set objHTTP = Nothing
service.asp:
function w (str)
response.Write(str & "<br>")
end function
str = request.Form("accountRequest")
w(str)
w("Tabs: "& InStr(str,vbTab))
w("Lines: "& InStr(str,vbLf))
output:
HelloWorld
Tabs: 0
Lines: 0
Can anyone please help?

Try:
Replace(Request.Form("accountRequest"), vbLF, vbCRLF))
Or:
Replace(Request.Form("accountRequest"), vbLF, "<br>"))|
Depending on where you're displaying it, either should work.
Or possibly this:
Function URLDecode(sConvert)
Dim aSplit
Dim sOutput
Dim I
If IsNull(sConvert) Then
URLDecode = ""
Exit Function
End If
' convert all pluses to spaces
sOutput = REPLACE(sConvert, "+", " ")
' next convert %hexdigits to the character
aSplit = Split(sOutput, "%")
If IsArray(aSplit) Then
sOutput = aSplit(0)
For I = 0 to UBound(aSplit) - 1
sOutput = sOutput & _
Chr("&H" & Left(aSplit(i + 1), 2)) &_
Right(aSplit(i + 1), Len(aSplit(i + 1)) - 2)
Next
End If
URLDecode = sOutput
End Function
From here: http://www.aspnut.com/reference/encoding.asp
If they are coming across the wire as the actual "\" and "n" characters, you can do a replace on those characters with the appropriate vbCRLF and vbTAB constants.

Finally figured out that ASP Request.Form method doesn't preserve tabs if they're in the "\t" format (as opposed to URL encoded). However, PHP's $_POST does.

Related

Resolve URL in VBScript

Is there any function in VBScript that returns the absolute URL when we have domain and the relative URL.
Suppose I have the domain example.com/ and the relative path home/index.html. When the 2 values are passed to the function, the result returned should be example.com/home/index.html
For example in Java, there's a resolve method which does this job. And suppose we pass the values example.com/ and example.com/home/index.html to the method, the method returns example.com/home/index.html
If you mean a Decomposition of an URL adress ? here is an example in vbscript :
Option Explicit
Dim adress,result,Title
Title = "Decomposition of an URL"
'Some examples for testing
'adress = "http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre"
'adress = "ftp://ftp.microsoft.com/softlib/index.txt‎"
'adress = "http://www.google.com"
adress = InputBox( "Please input the http or the https address.", " What makes up a Url ?",_
"http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre")
result = Search(trim(adress))
MsgBox Title & " ( Uniform Resource Locator ) ==> URL : " & DblQuote(adress) & vbCrLf & vbCrLf & result,64,Title
'*******************************************************
Function Search(MyString)
Dim objet,correspondance,collection,pattern
pattern="^" & _
"(\w+):\/\/([^/:]+)" & _
"(:(\d+))?" & _
"(" & _
"\/" & _
"(" & _
"(" & _
"([^/]+)" & _
"\/" & _
")?" & _
"(" & _
"([^#]+)" & _
")?" & _
"(" & _
"(#(\w+)?)?" & _
")?" & _
")?" & _
")?" & _
"$"
Set objet = New RegExp
objet.Pattern = Pattern
objet.IgnoreCase = True
objet.Global = True
if objet.test(MyString) then
Set collection = objet.Execute(MyString)
Set correspondance = collection(0)
result = "Protocol = " & DblQuote(correspondance.SubMatches(0)) & VbCRLF & vbCrLf _
& "Domain = " & DblQuote(correspondance.SubMatches(1)) & VbCRLF & vbCrLf _
& "Port = " & DblQuote(correspondance.SubMatches(3)) & vbCrLf & vbCrLf _
& "Folder = " & DblQuote(correspondance.SubMatches(7)) & VbCRLF& vbCrLf _
& "File = " & DblQuote(correspondance.SubMatches(9)) & VbCRLF& vbCrLf _
& "Anchor = "& DblQuote(correspondance.SubMatches(12))
Search = result
else
Search = MsgBox("no match ===> no result found !",48,Title)
end if
End Function
'----------------------------------------------------------------
'Function to add double quotes into a variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'----------------------------------------------------------------
You can also use PowerShell to do this very easily.
$uri = "http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre"
[system.uri]$uri
And you can get as result like that :
AbsolutePath : /coursasp/sommaire.html
AbsoluteUri : http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre
LocalPath : /coursasp/sommaire.html
Authority : www.laltruiste.com:8080
HostNameType : Dns
IsDefaultPort : False
IsFile : False
IsLoopback : False
PathAndQuery : /coursasp/sommaire.html
Segments : {/, coursasp/, sommaire.html}
IsUnc : False
Host : www.laltruiste.com
Port : 8080
Query :
Fragment : #anchor
Scheme : http
OriginalString : http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre
DnsSafeHost : www.laltruiste.com
IsAbsoluteUri : True
UserEscaped : False
UserInfo :

How to replace spaces between words with another word?

I have a cell G which stores random words like "Hello, How are you"
I want to replace all the spaces with %20 to make it
"Hello%20,%20How%20%are%20you"
How can i replace spaces with %20?
Thanks
try like this:
=SUBSTITUTE(G1; " "; "%20")
Select the cells you wish to change and run this:
Sub SpaceChanger()
Dim rng As Range, r As Range
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
For Each r In rng
If r.Value <> "" Then
If InStr(r.Value, " ") <> 0 Then
r.Value = Replace(r.Value, " ", "%20")
End If
End If
Next r
End Sub
(using a macro will allow you to change the values "in place")

How do I check for broken internal links in Star Basic?

I am creating a Basic macro for LibreOffice Writer to check for broken internal links. In a nutshell:
generate a list of all anchors
loop through the document, finding internal hyperlinks
if the internal hyperlink is not on the anchor list, open it for editing (and stop)
My code has a few unsolved issues:
(within fnBuildAnchorList) 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
(within subInspectLink) How do we properly test a hyperlink to a heading? I notice that when I manually follow a link to a heading, it will succeed when the numbering is the same, but also when the text is the same. e.g. if there’s an internal link #1.My first heading|outline, it can be reached with the hyperlink #1.Previous header name|outline but also with the hyperlink #2.3.5.My first heading|outline
(within subInspectLink) How do we open a specific hyperlink for editing? Do we pass parameters to .uno:EditHyperlink? Do we move the cursor? (All moves I found were relative, e.g. .uno:GoRight) Do we use the text portion’s .Start and .End properties?
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 ***
You can check the first issue using any document with a heading – a MsgBox will pop up with all the anchors, and you’ll see the missing outline numbering.
The second issue needs a document with a bad internal link.
Check out cOOol. You could either use this
instead of creating a macro,
or else borrow some concepts from the code.
Testing the links (possibly with .uno:JumpToMark) does not seem like it would be helpful,
because internal links always go somewhere even if the target does not exist.
Instead, construct a list of valid targets as you suggested.
To hold the list of valid targets, the cOOol code uses a Python set.
If you want to use Basic, then data structures are more limited.
However it can be done either by declaring a new a
Collection object
or by using Basic arrays, perhaps with ReDim.
Also have a look at how the cOOol code defines the valid target strings. For example:
internal_targets.add('0.' * heading_level + data + '|outline')
To open the hyperlink dialog, select the hyperlinked text and then call:
dispatcher.executeDispatch(document, ".uno:EditHyperlink", "", 0, Array())
EDIT:
Ok, I worked on this for several hours and came up with the following code:
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 ***
It now checks for outline numbering. Maybe it's too strict -- perhaps it would be good to have an option to turn off outline number checking.
As far as issue 3, this code now opens the proper links for editing (as long as "Yes" is clicked in the message box).

Lua gsub second instance

I'm using
local mystring = 'Thats a really nice house.'
string.gsub(mystring,"% ", "/",1)
to replace the first white space character with an slash.
But how to replace only the second occurrence of the white space?
You can use a function as replacement value in string.gsub and count the matches yourself:
local mystring = "Thats a really nice house."
local cnt = 0
print( string.gsub( mystring, " ", function( m )
cnt = cnt + 1
if cnt == 2 then
return "/"
end
end ) )
Try string.gsub(mystring,"(.- .-) ", "%1/",1).
You can replace the first instance with something else (assuming the replacement is not present in the string itself, which you can check), then replace it back:
print(mystring:gsub("% ", "\1",1):gsub("% ", "/",1):gsub("\1","% ", 1))
This prints: Thats a/really nice house.. Also, you don't need to escape spaces with %.

How to read quoted field from CSV using VBScript

In a sample.csv file, which has fixed number of columns, I have to extract a particular field value and store it in a variable using VBScript.
sample.csv
100,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
100|SN| 435624| serkasg| 15.353|
100|SN| 437825| serkasg| 15.353|"," 0 2345"
101,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
100|SN| 435624| serkasg| 15.353|
100|SN| 437825| serkasg| 15.353|"," 0 2346"
I want to parse the last two fields which are within double quotes and store them in two different array variables for each row.
You could try using an ADO connection
Option Explicit
dim ado: set ado = CreateObject("ADODB.Connection")
ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\txtFilesFolder\;Extended Properties=""text;HDR=No;FMT=Delimited"";"
ado.open
dim recordSet: set recordSet = ado.Execute("SELECT * FROM [samples.csv]")
dim field3, field4
do until recordSet.EOF
field3 = recordSet.Fields(3).Value
field4 = recordSet.Fields(4).Value
' use your fields here
recordSet.MoveNext
loop
recordSet.close
ado.close
You may have an issue if those fields are greater than 255 characters in length - if they are, they may return truncated. You also may have better luck with ODBC or ACE connection strings instead of the Jet one I've used here.
Since CSV's are comma-separated, you can use the Split() function to separate the fields into an array:
' Read a line from the CSV...
strLine = myCSV.ReadLine()
' Split by comma into an array...
a = Split(strLine, ",")
Since you have a static number of columns (5), the last field will always be a(4) and the second-to-last field will be a(3).
Your CSV data seems to contain 2 embedded hard returns (CR, LF) per line. Then the first line ReadLine returns is:
100,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
The solution below unwraps these lines before extracting the required fields.
Option Explicit
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = 2 ' Opens the file using the system default.
Const TristateTrue = 1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Dim FSO, TextStream, Line, LineNo, Fields, Field4, Field5
ExtractFields "sample.csv"
Sub ExtractFields(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Line = ""
LineNo = 0
Set TextStream = FSO.OpenTextFile(FileName, ForReading, False, TristateFalse)
Do While Not TextStream.AtEndOfStream
Line = Line & TextStream.ReadLine()
LineNo = LineNo + 1
If LineNo mod 3 = 0 Then
Fields = Split(Line, ",")
Field4 = Fields(3)
Field5 = Fields(4)
MsgBox "Line " & LineNo / 3 & ": " & vbNewLine & vbNewLine _
& "Field4: " & Field4 & vbNewLine & vbNewLine _
& "Field5: " & Field5
Line = ""
End If
Loop
TextStream.Close()
Else
MsgBox "File " & FileName & " ... Not found"
End If
End Sub
Here is an alternative solution that allows for single or multiline CSV records. It uses a regular expression which simplifies the logic for handling multiline records. This solution does not remove CRLF characters embedded in a record; I've left that as an exercise for you :)
Option Explicit
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = 2 ' Opens the file using the system default.
Const TristateTrue = 1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Dim FSO, TextStream, Text, MyRegExp, MyMatches, MyMatch, Field4, Field5
ExtractFields "sample.csv"
Sub ExtractFields(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Set MyRegExp = New RegExp
MyRegExp.Multiline = True
MyRegExp.Global = True
MyRegExp.Pattern = """([^""]+)"",""([^""]+)"""
Set TextStream = FSO.OpenTextFile(FileName, ForReading, False, TristateFalse)
Text = TextStream.ReadAll
Set MyMatches = MyRegExp.Execute(Text)
For Each MyMatch in MyMatches
Field4 = SubMatches(0)
Field5 = SubMatches(1)
MsgBox "Field4: " & vbNewLine & Field4 & vbNewLine & vbNewLine _
& "Field5: " & vbNewLine & Field5, 0, "Found Match"
Next
Set MyMatches = Nothing
TextStream.Close()
Else
MsgBox "File " & FileName & " ... Not found"
End If
End Sub

Resources