The Forum has been Updated
The code has been upgraded to the latest .NET core version. Please check instructions in the Community Announcements about migrating your account.
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<
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<
Posted
Thanks for that MarcelG works a treat with SHN beta v9 too.
<
Posted
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,
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
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.<
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
Posted
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....<
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....<
portfolio - linkshrinker - oxle - twitter
Posted
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
<
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
Now reviving that one...
Any new brainstorming?
I tried vB style, yet ofcourse, VBscript does not allow conditional regEx statements to shortcut this.<
Any new brainstorming?
I tried vB style, yet ofcourse, VBscript does not allow conditional regEx statements to shortcut this.<
Last edited by SiSL on 22 December 2008, 01:48
Posted
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....?
<
portfolio - linkshrinker - oxle - twitter
Last edited by MarcelG on 22 December 2008, 03:21
Posted
If I remember... There was something to solve with forums url handling... Multi linking?<
Last edited by SiSL on 22 December 2008, 07:53
Email Member
Message Member
Post Moderation
FileUpload
If you're having problems uploading, try choosing a smaller image.
Preview post
Send Topic
Loading...