http://mohamadrozman.blogspot.com
Ta!
where memories recorded, ideas written, photos taken, heart stolen, milestone defined
Away to sort this by the length of the strings in it (without having to write lots of code)? Showing longest strings first, for example.
SELECT StringColumn, len(StringColumn) AS LengthFROM YourTableORDER BY len(StringColumn) DESC
Public Function Dotted2LongIP(DottedIP As String) As Variant
' errors will result in a zero value
On Error Resume Next
Dim i As Byte, pos As Integer
Dim PrevPos As Integer, num As Integer
' string cruncher
For i = 1 To 4
' Parse the position of the dot
pos = InStr(PrevPos + 1, DottedIP, ".", 1)
' If its past the 4th dot then set pos to the last
'position + 1
If i = 4 Then pos = Len(DottedIP) + 1
' Parse the number from between the dots
num = Int(Mid(DottedIP, PrevPos + 1, pos - PrevPos - 1))
' Set the previous dot position
PrevPos = pos
' No dot value should ever be larger than 255
' Technically it is allowed to be over 255 -it just
' rolls over e.g.
'256 => 0 -note the (4 - i) that's the
'proper exponent for this calculation
Dotted2LongIP = ((num Mod 256) * (256 ^ (4 - i))) + _
Dotted2LongIP
Next
End Function
' convert long IP to dotted notation
Public Function LongIP2Dotted(ByVal LongIP As Variant) As String
On Error GoTo ExitFun
If LongIP = "" Or LongIP < 0 Then Err.Raise vbObjectError + 1
Dim i As Integer, num As Currency
' big number cruncher
For i = 1 To 4
' break off individual dot values - math out the wazoo
num = Int(LongIP / 256 ^ (4 - i))
' sets up the value for the next calculation
LongIP = LongIP - (num * 256 ^ (4 - i))
' a generic error to flag the exception handler -
'no dot value should ever be larger than 255
' technically it is allowed to be over 255
' but it's not possible from this calculation so
'raise an error
If num > 255 Then Err.Raise vbObjectError + 1
' string builder
If i = 1 Then
' 1st dot value has no leading dot
LongIP2Dotted = num
Else
' other dot values have a leading dot
LongIP2Dotted = LongIP2Dotted & "." & num
End If
Next
Exit Function
ExitFun:
LongIP2Dotted = "0.0.0.0" '"Invalid Input" ' whatever
End Function
<%
Function fncTrimText(strText,intCharacters,blnMore)
' The function uses the following variables
' strText is used to pass the text to be trimmed
' intCharacters is used to indicate at what ammount of characters the text should be trimmed
' blnMore 0 for no and 1 for yes is used to add 3 dots after the trimmed text if the original text is longer
' Declare the variables required
Dim blnDone : blnDone = 0
Dim strTextTrimmed
' First trim the text to the desired ammount of characters
strTextTrimmed = Left(strText,intCharacters)
' Then add the remaining characters of the word if a word was cut with the trimming
If cInt(Len(strText)) > cInt(intCharacters) Then
intCharacters = intCharacters + 1
Do While (blnDone < 1)
If Mid(strText,intCharacters,1) = " " Then
blnDone = 1
Else
strTextTrimmed = strTextTrimmed & Mid(strText,intCharacters,1)
End If
If cInt(Len(strText)) <= cInt(intCharacters) Then
blnDone = 1
End If
intCharacters = intCharacters + 1
Loop
' Now add the ... after the trimmed text
If blnMore = 1 Then
strTextTrimmed = strTextTrimmed & " ... "
End If
End If
fncTrimText = strTextTrimmed
End Function
%>
<% Function fncTrimText(strText,intCharacters) ' The function uses the following variables ' strText is used to pass the text to be trimmed ' intCharacters is used to indicate at what ammount of characters the text should be trimmed If Len(strText) > intCharacters Then If inStr(100,strText," ") > intCharacters Then strText = Left(strText,inStr(intCharacters,strText," ")) & "..." ElseIf inStr(intCharacters,strText," ") = intCharacters Then strText = Left(strText,intCharacters) & "..." End If End If fncTrimText = strText End Function %>
TheFeed = "http://www.amadirectlink.com/amadirectlink.xml"
Set objXML = Server.CreateObject("Microsoft.XMLDOM")
objXML.Async = False
objXML.SetProperty "ServerHTTPRequest", True
objXML.ResolveExternals = True
objXML.ValidateOnParse = True
objXML.Load(TheFeed)
CellCount = 0
If (objXML.parseError.errorCode = 0) Then
Set objRoot = objXML.documentElement
If IsObject(objRoot) = False Then
Response.Write "There was an error retrieving the news feed"
Else
Set objItems = objRoot.getElementsByTagName("item")
If IsObject(objItems) = True Then
For Each objItem in objItems
On Error Resume Next
TheTitle = objItem.selectSingleNode("title").Text
TheLink = objItem.selectSingleNode("link").Text
TheDesc = objItem.selectSingleNode("description").Text
TheDate = objItem.selectSingleNode("pubDate").Text
Response.Write "" & _
"" & TheTitle & "" & _
"" & _
"
"
Response.Write TheDesc & _
"
"
Response.Write TheDate & _
"
"
Next
End If
Set objItems = Nothing
End If
Else
Response.Write "There was an error retrieving the news feed"
End If
Set objXML = Nothing