Clipped URL's? - Posted (6885 Views)
Senior Member
sr_erick
Posts: 1318
1318
I've done some searching and came up with nothing. Has anyone made any mods to clip the URL in the format string functions?
Like if there is a super long URL like this:

http://www.nohrsc.nws.gov/interactive/html/map.html?var=ssm_depth&dy=2005&dm=3&dd=9&dh=18&snap=1&o9=1&o12=1&o13=1&lbl=m&min_x=-77.650416666659&min_y=37.446667353307&max_x=-62.150416666659&max_y=52.946667353307&coord_x=-70.18&coord_y=44.54&metric=0&bgvar=dem&width=512&height=512&nw=512&nh=512&type=3&js=1&uc=0&mode=zoomin&submit1=0&ql=station&zf=4.0

It will turn it into this:

http://www.nohrsc.nws.gov/intera....tion&zf=4.0

And still link to the same place<
 Sort direction, for dates DESC means newest first  
 Page size 
Posted
Retired Support Moderator
MarcelG
Posts: 2625
2625
I've wrapped up the changes I made as a 'mod' : See here for instructions.<
Posted
Junior Member
RArch
Posts: 103
103
Thanks for that MarcelG works a treat with SHN beta v9 too. <
Posted
Starting Member
Eric Coleman
Posts: 10
10
In the file inc_func_common.asp, find the function FormatStr,

paste the following code immediately ABOVE the bottom 3 lines of the function, the bottom 3 lines I'm talking about are

FormatStr = fString
on Error goto 0
end function


Here is the code to paste,
Code:

	   Dim c, n, m, j, k, i, fString2

c = 60 'max text length to display for a URL
n = 0
m = 0
i = 0
Do
i = m + 1
n = InStr(n + 1, fstring, "<a", 1)
If n = 0 Then Exit Do
m = InStr(n + 1, fstring, "</a", 1)
If m = 0 Then Exit Do
j = InStrRev(fstring, ">", m, 1)
If j > n Then
j = j + 1
k = Mid(fstring, j, m - j)
If Len(k) > c Then
fstring2 = fstring2 & Mid(fstring, i, j - i) & Left(k, c - 3) & "..."
m = m - 1
Else
fstring2 = fstring2 & Mid(fstring, i, m - i)
m = m - 1
End If
Else
fstring2 = fstring2 & Mid(fstring, i, m - i)
m = m - 1
End If
Loop
If i > 0 Then
fstring2 = fstring2 & Mid(fstring, i, Len(fstring) - i + 1)
End If
fString = fString2


How does this work?
The forum doesn't convert the URL bb tags to html untill it's displayed for the user, generally through topic.asp. This section of code parses the HTML after the forum converts the "URL" tags to "A" tags.
If you want to test this code before going live with it, simply surround the code with an
Code:
If mlev = 4 Then

End If
block, so that only administrators can see the results. I've tested this with lots of broken HTML to find bugs, but please test it for yourself.<
Posted
Retired Support Moderator
MarcelG
Posts: 2625
2625
Eric,

You're doing this for all instances of <a and </a ? What about urls like these ? <a href="http://www.whatversite.com/image.jpg"><img src="http://www.whatversite.com/thumb.jpg"></a> ? You don't want to shorten those....<
Posted
Starting Member
Eric Coleman
Posts: 10
10
You're right. I forgot to check for stuff like that since I generally don't allow images to be posted on my forum. here is an updated version. There is currently only 1 bug that I'm aware of. The addition of the "..." doesn't cross html boundaries. For example, if clipping to 10 characters, the following would happen, "123456789<i>0</i>abcd" gets converted to "1234567...<i></i>" instead of "1234567..<i>.</i>" This really isn't that important since text is being stripped away and the original formatting, if any, will be messed up.
As before,
In the file inc_func_common.asp, find the function FormatStr,

paste the following code immediately ABOVE the bottom 3 lines of the function, the bottom 3 lines I'm talking about are

FormatStr = fString
on Error goto 0
end function

Code:

    Dim c
c = 60 'max text length to display for a URL

Dim n, m, j, k, i, x, y, z, w, v
Dim oReg, oMatches, oMatch
Set oReg = New regExp
n = 0
m = 0
i = 0
'fstring2 = fstring
c = c - 3
if c < 0 then c = 3
Do
i = m + 1
n = InStr(n + 1, fstring, "<a", 1)
If n = 0 Then Exit Do
m = InStr(n + 1, fstring, "</a", 1)
If m = 0 Then Exit Do
'j = InStrRev(fstring, ">", m, 1)
j = InStr(n + 1, fstring, ">", 1)
If j > n And j < m Then
j = j + 1
k = Mid(fstring, j, m - j)
If Len(k) > c Then
'k is a string that needs to be replaced. oReg.Pattern = "<[^>]*>"
oReg.Global = True
oReg.MultiLine = True
Set oMatches = oReg.Execute(k)
x = 1
w = 0
z = ""
y = ""
v = False
For Each oMatch In oMatches
y = Mid(k, x, (oMatch.FirstIndex + 1) - x)
x = oMatch.FirstIndex + 1 + oMatch.Length
w = w + Len(y)
If v = False Then
If w <= c Then
z = z & y & oMatch.Value
Else 'w > c
y = Left(y, c - (w - Len(y))) & "..."
z = z & y & oMatch.Value
v = True
End If
Else
z = z & oMatch.Value
End If
Next
If v = False Then
y = Mid(k, x, Len(k) + 1 - x)
w = w + Len(y)
If w > c Then
y = Left(y, c - (w - Len(y))) & "..."
End If
z = z & y
End If

'fstring2 = fstring2 & Mid(fstring, i, j - i) & Left(k, c - 3) & "..."
fstring2 = fstring2 & Mid(fstring, i, j - i) & z
m = m - 1
Else
fstring2 = fstring2 & Mid(fstring, i, m - i)
m = m - 1
End If
Else
fstring2 = fstring2 & Mid(fstring, i, m - i)
m = m - 1
End If
'<a </a
Loop
If i > 0 Then
fstring2 = fstring2 & Mid(fstring, i, Len(fstring) - i + 1)
End If
fstring = fstring2
<
Posted
Average Member
SiSL
Posts: 671
671
Now reviving that one...
Any new brainstorming?
I tried vB style, yet ofcourse, VBscript does not allow conditional regEx statements to shortcut this.<
Posted
Retired Support Moderator
MarcelG
Posts: 2625
2625
SiSL, please refresh my memory ; what needs to be done in this thread/mod? I'm using the clipped URL's mod for years already, and I cannot say I'm missing something....? clown<
Posted
Average Member
SiSL
Posts: 671
671
You Must enter a message