Introduction
We create a connection to the websites FIND-IP-ADDRESS.ORG (stores
individual location data) and WUNDERGROUND.COM (stores weather forecasting data ) which automatically
obtains our IP at connect-time.
With our IP they gather more information about us and store them on their websites. We download the
source codes of these great websites into our application. They are in HTML
format. We split and substring these codes. In the end only the data we need
should remain.
I added a new function which determines the country phone prefix, the data is saved
in My.Settings, with data almost of 200 countries. To access this data physically, go to mySolution/Properties/Settings in
the Visual Studio application.
If you want you can advance your project with more features. You need to navigate with your favourite
web browser to one of these websites and click the right mouse button, and you
will see "View Page Source" (I'm using Firefox) and you can play around with the extractSubject
function which refers to three values ('DataBuffer', 'position from where the info starts', 'position where the info ends');.
Example
Dim dataBuffer As String = "I am 23 years old"
Now to get the age extracted from the string, you use the extractSubject function like this:
Dim myAge As String = extractSubject(dataBuffer, "I am ", " years old")
Returns 23 but
extractSubject(dataBuffer, "am ", " years")
Returns 23 also.
So no need to write bunches of strings, as long as they don't conflict with another identical string, you can do so. But HTML contains everywhere strings like </span> or <div> or whatever, so in this case you must tell the
extractSubject function more precisely what you want. If there are identical lines, then
the extractSubject function alone doesn't help you out, you also need the
Split() function or other functions from System.Text.
In the worst case you may have to use a For statement to loop line
by line to the approximate line.
You must pay attention to the Sub weatherInfo, the first instance of connection to the path wunderground.com doesn't return the
preferred data, it only returns data for Now-Weather.
Someone may ask, why don't
you directly navigate to the path which returns more data about the weather?
The answer is
I cannot. Because when you navigate manually from your web browser to Wunderground.com,
it will first offer less info about the weather, but when we click a link inside it, we will be redirected to an extended unknown page and when
I look above at the search bar I see "http://www.wunderground.com/global/stations/13588.html" which is only for Skopje and not overall by default. So we first navigate to only "Wunderground.com", then we split the returned source code to retrieve the link to the extended page. And finally we create the second connection which brings us to the right
source.
It may be very difficult to understand the logic of these functions
for some of you but with a basic understanding of VB.NET, you will very quickly find out what the hell is going on here.
Using the code
Imports System.IO
Imports System.Net
Imports System.Text
Imports System.Text.RegularExpressions
Public Class IPLocator
Private Sub IPLocator_Load(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MyBase.Load
ipInfos()
weatherInfo()
End Sub
Public Function downloadData(ByVal ur As Uri) As String
Dim result As String = Nothing
Try
Dim req As HttpWebRequest = HttpWebRequest.Create(ur)
Dim res As HttpWebResponse = req.GetResponse()
If (res.StatusCode = HttpStatusCode.OK) Then
Dim receiveStream As Stream = res.GetResponseStream()
Dim readStream As StreamReader = Nothing
If (res.CharacterSet = Nothing) Then
readStream = New StreamReader(receiveStream)
Else
readStream = New StreamReader(receiveStream, Encoding.GetEncoding(res.CharacterSet))
Dim data As String = readStream.ReadToEnd()
res.Close()
readStream.Close()
result = data
End If
End If
Catch
End Try
Return result
End Function
Public Function extractSubject(ByVal data As String, ByVal left As String, ByVal right As String)
Try
Dim indexLeft As Integer = data.IndexOf(left)
Dim indexRight As Integer = data.IndexOf(right)
Return data.Substring(indexLeft + left.Length, indexRight - indexLeft - left.Length)
Catch
Return "Not Resolved!"
End Try
End Function
Public Function downloadPicture(ByVal webPath As String) As Image
Try
Dim myWebClient As New WebClient()
Return Image.FromStream(New MemoryStream(myWebClient.DownloadData(webPath)))
Catch : End Try
End Function
Dim ipLookup As String
Dim flagLocation As String
Private Sub ipInfos()
Dim ur As New Uri("http://www.find-ip-address.org/")
Dim IPdata As String = downloadData(ur)
If Not IPdata Is Nothing Then
ipLookup = extractSubject(IPdata, "My IP Country Name:", "IP Address Lookup Location")
flagLocation = extractSubject(ipLookup, _
"</font> <img src='", "'><br><strong>My IP Country Continent<")
lbCountry.Text = country()
pictureBoxFlag.BackgroundImage = downloadPicture(ur.ToString & flagLocation)
pictureBoxFlag.SizeMode = PictureBoxSizeMode.StretchImage
tbPublicIP.Text = publicIP()
tbLocalIP.Text = localIP()
tbCity.Text = city()
tbRegion.Text = region()
tbContinent.Text = continent()
tbISP.Text = isp()
tbBroadband.Text = netBroadband()
tbTelPrefix.Text = phonePrefix(countryCode)
tbLatitude.Text = latitude() & "° N"
tbLongtitude.Text = longtitude() & "° E"
End If
End Sub
Dim weatherLookup As String
Private Sub weatherInfo()
Dim ur As New Uri("http://www.wunderground.com/")
Dim Weatherdata As String = downloadData(ur)
If Not Weatherdata Is Nothing Then
Dim lines() As String = Weatherdata.Split(vbNewLine.ToCharArray, _
StringSplitOptions.RemoveEmptyEntries)
Dim extendedSourcelocation As String
For Each line In lines
If line.Contains("/global/stations/") Then
extendedSourcelocation = line.Split("""")(1)
Exit For
End If
Next
ur = New Uri(ur.ToString & extendedSourcelocation)
Weatherdata = downloadData(ur)
If Not Weatherdata Is Nothing Then
weatherLookup = Weatherdata
lbStation.Text = stationLocation() & "," & vbNewLine & _
"at " & stationElevation() & " metres!"
lbSunrise.Text = "Sunrise: " & sunRise()
lbSunset.Text = "Sunset: " & sunSet()
pbNowSky.BackgroundImage = downloadPicture(nowSkyViewPicLocation)
pbNowSky.BackgroundImageLayout = ImageLayout.Stretch
lbNowSky.Text = "Sky: " & nowSky()
lbWind.Text = "Wind: " & nowWind()
lbNowDegree.Text = nowTemperature() & "° Degree"
pbTonight.BackgroundImage = downloadPicture(tonightSkyViewPicLocation)
pbTonight.BackgroundImageLayout = ImageLayout.Stretch
lbTonightDegree.Text = tonightTemperature() & "° Degree"
lbTonightSky.Text = "Sky: " & tonightSky()
End If
End If
End Sub
#Region "IP-Informations"
Function continent() As String
Dim result As String = extractSubject(ipLookup, "Country Continent", "Country Latitude")
result = (result.Split(">")(2) & result.Split(">")(4)).Replace("</font", "")
Return result.Insert(result.Length - 4, " ")
End Function
Function netBroadband() As String
Dim result As String = extractSubject(ipLookup, "show IP which belongs to", "Time zone")
Return (result.Split(">")(1)).Split("<")(0)
End Function
Function phonePrefix(ByVal ISOCode As String) As String
Dim countries() As String = My.Settings.prefixes.Split(vbNewLine.ToCharArray, _
StringSplitOptions.RemoveEmptyEntries)
Try
For Each country As String In countries
Dim parts() As String = country.Split("|")
If parts(0) = countryCode() Then Return parts(2)
Next
Catch : End Try
End Function
Function publicIP() As String
Return extractSubject(ipLookup, ">My IP Address lookup</strong> for <b>", "</b> show IP which")
End Function
Function localIP() As String
Try
Dim iphostentry As Net.IPHostEntry = Net.Dns.GetHostByName(Net.Dns.GetHostName)
Return CType(iphostentry.AddressList.GetValue(0), IPAddress).ToString
Catch : End Try
End Function
Function latitude() As String
Return extractSubject(ipLookup, "My IP Address Latitude</b>: ", "<br><b>My IP Address Longtitude")
End Function
Function longtitude() As String
Return extractSubject(ipLookup, "My IP Address Longtitude</b>: ", "<br><br><strong>My ISP")
End Function
Function city() As String
Return extractSubject(ipLookup, "City</b>: <font color='#980000'>", _
"</font><br><b>My IP Address Latitude</b>")
End Function
Shadows Function region() As String
Return extractSubject(ipLookup, _
")<br><br><strong>My IP Address Region</strong>: <font color='#980000'>", _
"</font><br><b>").Split("<")(0)
End Function
Function country() As String
Return extractSubject(ipLookup, ": <font color='#980000'> ", _
"</font> <img src='") _
& "(" + flagLocation.Split("/")(2).Remove(2).ToUpper + ")"
End Function
Function isp() As String
Return extractSubject(ipLookup, "Provider)</strong>: <font color='#980000'> ", "</font><br /")
End Function
Private Function countryCode() As String
Try : Return flagLocation.Split("/")(2).Remove(2).ToUpper : Catch : End Try
End Function
#End Region
#Region "Weather-Informations"
Function stationLocation() As String
Return extractSubject(weatherLookup, "/DailyHistory.html"">", _
"<div id=""stationElevation"">").Split("<")(0)
End Function
Function stationElevation() As String
Dim result As String = extractSubject(weatherLookup, "Weather Station</div>", "Report Station")
Return extractSubject(result, """nobr""><span class=""b"">", "</span> m</")
End Function
Function sunRise() As String
Dim result As String
result = extractSubject(weatherLookup, _
"<div id=""sRise""><span class=""b"">", _
"<div id=""sSet""><span class=""b"">")
Return (result.Split("<")(0) & result.Split("<")(1)).Replace("/span>", "")
End Function
Function sunSet() As String
Dim result As String = extractSubject(weatherLookup, _
"<div id=""sSet""><span class=""b"">", "<div id=""nowMoon""")
Return (result.Split("<")(0) & result.Split("<")(1)).Replace("/span>", "")
End Function
Function nowWind() As String
Return extractSubject(weatherLookup, _
"=""windspeedmph"" english="""" metric="""">", _
"<div id=""nowSuns"">").Split("<")(0)
End Function
Function nowSky() As String
Return (extractSubject(weatherLookup, "og:title", _
"Refresh").ToString.Split("|")(2).Split("""")(0)).Remove(0, 1)
End Function
Function nowTemperature() As String
Return (extractSubject(weatherLookup, "og:title", _
"Refresh").ToString.Split("|")(1).Split("&")(0)).Remove(0, 1)
End Function
Function nowSkyViewPicLocation() As String
Dim result As String = extractSubject(weatherLookup, "curIcon", "<div id=""curCond"">")
Return extractSubject(result, "<img src=""", """ width")
End Function
Function tonightSky() As String
Dim result As String = extractSubject(weatherLookup, "<div class=""titleSubtle"">Tonight</div>", _
"<div class=""titleSubtle"">Tomorrow</div>")
Return extractSubject(result, """foreCondition"">", """foreGlance""").ToString.Split("<")(0)
End Function
Function tonightTemperature() As String
Dim result As String = extractSubject(weatherLookup, "<div class=""titleSubtle"">Tonight</div>", _
"<div class=""titleSubtle"">Tomorrow</div>")
result = extractSubject(result, "/></a>", "°")
Return Regex.Replace(result, "[^0-9]", "")
End Function
Function tonightSkyViewPicLocation() As String
Dim result As String = extractSubject(weatherLookup, "<div class=""titleSubtle"">Tonight</div>", _
"<div class=""titleSubtle"">Tomorrow</div>")
Return extractSubject(result, "img src=""", """ alt=")
End Function
#End Region
End Class
PS: Declaring the quotes (")
- (HTML): </span>
"hallo"</span>
- (VBNET): Dim str As String =
"</span>""hallo""</span>"
As you can see 1 " (quote) must be declared as "" (2 quotes), 2 quotes as 4 quotes.
Update
- 14 December, 2012: Added internal (local) IP function.
- 20 February, 2013: Added international phone prefixes.
- 10 March, 2013: Added weather forecast function.
