http://mohamadrozman.blogspot.com
Ta!
where memories recorded, ideas written, photos taken, heart stolen, milestone defined
A
way 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