Search This Blog

How to convert IP address to country name


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
These are simple functions that will take a string of text as input and trim it to the ammount of characters desired. Instead of cutting the text at that length it will cut the text after the word has finished. This means that the function will show X ammount of character plus the ammount of character it takes to finish the word that is being cut. This is a function that can be useful for blogs, news sites or calendars where you want to show a list of items with a short description. You can use this function to create this short description based on the complete text of the item.

Triming text is very straightforward in ASP, you can use the ASP Left function like Left(strSomeText,20) which would cut the strSomeText variable to a length of 20 characters. These functions go beyond that by not cutting at 20 characters which could be in the middle of a word, but instead these functions will look for the end of the word and than cut off the text.

CODE:


<%
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
%>
 

CODE 2:


<%
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
%> 

Source: http://flyinglowlander.com/ASP/trim_text_function/
Simple ASP RSS XML Data Feed Importer and Reader

This is an easy and simple ASP script that will import, read and display RSS data feeds. It uses Microsoft.XMLDOM to import and process the code. The way this code works, there is no need to use an external XSL style sheet since all the formatting is done right within the script.
You can plug this script into any of your .asp pages for it to work.

Source: http://www.sorenwinslow.com/RSSAspCode.asp

Here is the code for the easy RSS/XML feed reader:

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