' ******************************************************************************
' **
' ** Yahoo Finance Managed
' ** Written by Marius Häusler 2010
' ** It would be pleasant, if you contact me when you are using this code.
' ** Contact: YahooFinanceManaged@gmail.com
' ** Project Home: http://code.google.com/p/yahoo-finance-managed/
' **
' ******************************************************************************
' **
' ** Copyright 2010 Marius Häusler
' **
' ** Licensed under the Apache License, Version 2.0 (the "License");
' ** you may not use this file except in compliance with the License.
' ** You may obtain a copy of the License at
' **
' ** http://www.apache.org/licenses/LICENSE-2.0
' **
' ** Unless required by applicable law or agreed to in writing, software
' ** distributed under the License is distributed on an "AS IS" BASIS,
' ** WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
' ** See the License for the specific language governing permissions and
' ** limitations under the License.
' **
' ******************************************************************************
Imports System.Text.RegularExpressions
Namespace Finance.NonAPI
''' <summary>
''' Class for searching for Yahoo IDs
''' </summary>
''' <remarks></remarks>
Public Class IDSearchDownload
Inherits Base.StringDownload
''' <summary>
''' Raises if an asynchronous search completes
''' </summary>
''' <param name="sender">The event raising object</param>
''' <param name="ea">The event args of the asynchronous download</param>
''' <remarks></remarks>
Public Event AsyncDownloadCompleted(ByVal sender As Base.Download, ByVal ea As IDSearchDownloadCompletedEventArgs)
''' <summary>
''' Raises if an asynchronous search changed in progress
''' </summary>
''' <param name="sender">The event raising object</param>
''' <param name="ea">The event args of the asynchronous download</param>
''' <remarks></remarks>
Public Event AsyncDownloadChanged(ByVal sender As Base.Download, ByVal ea As IDSearchDownloadChangedEventArgs)
Private mOptions As New IDSearchOptions
Private mFinished As Boolean = False
Public Property Options() As IDSearchOptions
Get
Return mOptions
End Get
Set(ByVal value As IDSearchOptions)
mOptions = value
End Set
End Property
''' <summary>
''' Starts an asynchronous search for Yahoo IDs by keyword and other options
''' </summary>
''' <param name="text">The used search text</param>
''' <param name="userArgs">Individual user argument</param>
''' <remarks></remarks>
Public Overloads Sub DownloadAsync(ByVal text As String, Optional ByVal userArgs As Object = Nothing)
If text.Trim = String.Empty Then Throw New ArgumentNullException("text", "The text is empty.")
mFinished = False
Me.DownloadAsyncRecursive(New AsyncDownloadRecursiveArgs(userArgs) With {.Text = text.Trim, .Options = New IDSearchOptions(mOptions)})
End Sub
Private Sub DownloadAsyncRecursive(ByVal dlArgs As AsyncDownloadRecursiveArgs)
dlArgs.PagesStarted += 1
Dim url As String = Me.DownloadURL(dlArgs.Text, dlArgs.Options, dlArgs.PagesStarted)
MyBase.DownloadAsync(url, dlArgs)
End Sub
''' <summary>
''' Default constructor
''' </summary>
''' <remarks></remarks>
Public Sub New()
End Sub
Private Sub DownloadAsync_Completed(ByVal sender As Base.Download, ByVal ba As Base.StringDownloadCompletedEventArgs) Handles MyBase.AsyncStringDownloadCompleted
If ba IsNot Nothing AndAlso ba.UserArgs IsNot Nothing AndAlso TypeOf ba.UserArgs Is AsyncDownloadRecursiveArgs Then
Dim searchArgs = DirectCast(ba.UserArgs, AsyncDownloadRecursiveArgs)
If ba.Response.Connection.State = Base.ConnectionState.Success Then
Dim resultsPerPage As Integer = 20
If searchArgs.Options.ISINIncluded Then resultsPerPage = 50
If searchArgs.IsFirst Then
searchArgs.MaxResults = Me.ToMaxResults(ba.Response.Result, searchArgs.Options) - searchArgs.Options.Start
End If
Dim maximum As Integer = searchArgs.MaxResults
If searchArgs.Options.Count > 0 AndAlso searchArgs.Options.Count <= searchArgs.MaxResults Then
maximum = searchArgs.Options.Count
End If
Dim addedItems As Boolean = False
Dim responseResults() As IDSearchResult = Me.ToSearchResults(ba.Response.Result, searchArgs.Options.ISINIncluded)
If searchArgs.Results.Count + responseResults.Length <= maximum Then
searchArgs.Results.AddRange(responseResults)
addedItems = True
Else
For Each result As IDSearchResult In responseResults
If searchArgs.Results.Count >= maximum Then
Exit For
Else
searchArgs.Results.Add(result)
addedItems = True
End If
Next
End If
If addedItems Then Me.RaiseChanged(searchArgs, ba.Response.Connection, responseResults, maximum)
If searchArgs.IsFirst Then
searchArgs.IsFirst = False
Dim pages As Integer = CInt(Math.Truncate(maximum / resultsPerPage))
Dim number As Integer = 0
If pages >= 4 Then
number = 4
Else
number = pages
End If
If number > 1 Then
For i As Integer = 1 To number
Me.DownloadAsyncRecursive(searchArgs)
Next
Else
Me.RaiseCompleted(searchArgs, ba.Response.Connection, responseResults, maximum)
End If
Else
If searchArgs.Results.Count >= maximum Then
Me.RaiseCompleted(searchArgs, ba.Response.Connection, responseResults, maximum)
Else
Dim m As Integer = (maximum Mod resultsPerPage)
If m > 0 Then m = m * -1 + resultsPerPage
'Debug.WriteLine((((searchArgs.PagesStarted + 1) * resultsPerPage) - m).ToString & " < " & maximum.ToString & " = " & (((searchArgs.PagesStarted * resultsPerPage) - m) < maximum).ToString)
If (((searchArgs.PagesStarted + 1) * resultsPerPage) - m) < maximum Then
Me.DownloadAsyncRecursive(searchArgs)
End If
End If
End If
Else
If Not searchArgs.IsFirst Then
Dim resultsPerPage As Integer = 20
If searchArgs.Options.ISINIncluded Then resultsPerPage = 50
If Not ba.Response.Connection.State = Base.ConnectionState.Canceled Then
searchArgs.MaxResults -= resultsPerPage
Else
searchArgs.MaxResults = searchArgs.Results.Count
End If
End If
If searchArgs.Results.Count >= searchArgs.MaxResults Then
Me.RaiseCompleted(searchArgs, ba.Response.Connection, New IDSearchResult() {}, -1)
End If
End If
End If
End Sub
Private Function DownloadURL(ByVal text As String, ByVal options As IDSearchOptions, ByVal siteZeroBasedIndex As Integer) As String
If options.ISINIncluded Then : Return DownloadURLGer(text, options, siteZeroBasedIndex)
Else : Return DownloadURLUSA(text, options, siteZeroBasedIndex)
End If
End Function
Private Function DownloadURLUSA(ByVal text As String, ByVal options As IDSearchOptions, ByVal siteZeroIndex As Integer) As String
Dim url As New Text.StringBuilder
url.Append("http://finance.yahoo.com/lookup/")
Select Case options.Type
Case FinancialSecurityType.Any : url.Append("all")
Case FinancialSecurityType.ETF : url.Append("etfs")
Case FinancialSecurityType.Fund : url.Append("funds")
Case FinancialSecurityType.Future : url.Append("futures")
Case FinancialSecurityType.Index : url.Append("indices")
Case FinancialSecurityType.Stock : url.Append("stocks")
End Select
url.Append("?s=")
url.Append(Uri.EscapeDataString(text))
url.Append("&t=")
If options.Type = FinancialSecurityType.Fund Then : url.Append("M"c)
Else : url.Append(Char.ToUpper(options.Type.ToString()(0)))
End If
url.Append("&m=")
If options.Markets = FinancialMarket.UsAndCanada Then : url.Append("US")
Else : url.Append("ALL")
End If
url.Append("&r=")
Dim rankNumber As Integer = 1
Select Case options.RankedBy
Case FinancialProperty.ID : rankNumber = 1
Case FinancialProperty.Name : rankNumber = 3
Case FinancialProperty.Category : rankNumber = 5
Case FinancialProperty.Exchange : rankNumber = 7
End Select
If options.RankingDirection = ListSortDirection.Descending Then rankNumber += 1
url.Append(rankNumber.ToString)
url.Append("&b=")
url.Append((siteZeroIndex * 20) + options.Start)
Return url.ToString
End Function
Private Function DownloadURLGer(ByVal text As String, ByVal options As IDSearchOptions, ByVal siteZeroBasedIndex As Integer) As String
Dim url As New Text.StringBuilder
url.Append("http://de.finsearch.yahoo.com/de/index.php?s=de_sort&nm=")
url.Append(Uri.EscapeDataString(text))
url.Append("&tp=*&r=*")
url.Append("&offset=")
url.Append(siteZeroBasedIndex * 50 + 1)
url.Append("&np=")
url.Append(siteZeroBasedIndex + 1)
Return url.ToString
End Function
Private Function ToSearchResults(ByVal html As String, ByVal isinIncluded As Boolean) As IDSearchResult()
Dim lst As New List(Of IDSearchResult)
Dim pattern As String = String.Empty
If isinIncluded Then
pattern = "<tr><td nowrap class=""yfnc_(tabledata1|h)"">.*?</td></tr>"
Else
pattern = "<tr class=""yui-dt-(even|odd)"">.*?</tr>"
End If
Dim matches As MatchCollection = Regex.Matches(html.Replace(Chr(10), ""), pattern)
If matches.Count > 0 Then
Dim tdReg As New Regex("<td.*?>.*?</td>")
Dim tdStartReg As New Regex("<td.*?>")
Dim urlReg As New Regex("<a.*?>")
For Each row As Match In matches
Dim tdMatches As MatchCollection = tdReg.Matches(row.Value.Replace("nowrap", ""))
If tdMatches.Count >= 6 Then
Dim isValid As Boolean = True
Dim name As String = String.Empty
Dim id As String = String.Empty
Dim category As String = String.Empty
Dim exchange As String = String.Empty
Dim type As String = String.Empty
Dim isin As String = String.Empty
Dim wkn As String = String.Empty
For i As Integer = 0 To 5
If tdMatches(i).Value.IndexOf("td") > -1 Then
Select Case i
Case 0
If isinIncluded Then : name = urlReg.Replace(tdStartReg.Replace(tdMatches(i).Value, ""), "").Replace("</a>", "").Replace("</td>", "").Trim
Else : id = urlReg.Replace(tdStartReg.Replace(tdMatches(i).Value, ""), "").Replace("</a>", "").Replace("</td>", "").Trim
End If
Case 1
If isinIncluded Then : id = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
Else : name = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
End If
Case 2
If isinIncluded Then isin = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
Case 3
If isinIncluded Then : wkn = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
Else : type = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
End If
Case 4
If isinIncluded Then : exchange = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
Else : category = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
End If
Case 5
If isinIncluded Then : type = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
Else : exchange = tdStartReg.Replace(tdMatches(i).Value, "").Replace("</a>", "").Replace("</td>", "").Trim
End If
End Select
Else
isValid = False
Exit For
End If
Next
If isValid Then
lst.Add(New IDSearchResult(name, id, type, exchange, category, isin, wkn))
End If
End If
Next
End If
Return lst.ToArray
End Function
Private Function ToMaxResults(ByVal html As String, ByVal options As IDSearchOptions) As Integer
If options.ISINIncluded Then
Dim m As Match = Regex.Match(html.Replace(Chr(10), ""), "<TD><B>.*?</B>.*?</TD>")
If m.Success Then
Dim beginNew As Boolean = True
Dim digit As New List(Of Char)
For i As Integer = 0 To m.Value.Length - 1
If Char.IsDigit(m.Value(i)) Then
If beginNew Then
digit.Clear()
beginNew = False
End If
digit.Add(m.Value(i))
Else
beginNew = True
End If
Next
Dim ds As Integer = -1
Integer.TryParse(mHelper.CharEnumToString(digit), ds)
Return ds
End If
Else
Dim match As Match = Regex.Match(html.Replace(Chr(10), ""), "<ul class=""yui-nav""><li.*?>.*?</li></ul>")
If match.Success Then
Dim links As MatchCollection = Regex.Matches(match.Value, "<a href="".*?</a>")
If links.Count = 6 Then
Dim matchValue As String = String.Empty
Select Case options.Type
Case FinancialSecurityType.Stock
matchValue = links(1).Value
Case FinancialSecurityType.Fund
matchValue = links(2).Value
Case FinancialSecurityType.ETF
matchValue = links(3).Value
Case FinancialSecurityType.Index
matchValue = links(4).Value
Case FinancialSecurityType.Future
matchValue = links(5).Value
Case Else
matchValue = links(0).Value
End Select
Dim result As Match = Regex.Match(matchValue, "<em>.*?</em>")
If result.Success Then
Dim i As Integer = -1
If Integer.TryParse(result.Value.Replace("<em>" & Me.FinancialTypeToString(options.Type), "").Replace("(", "").Replace(")</em>", "").Trim, i) Then
Return i
End If
End If
End If
End If
End If
Return -1
End Function
Private Function FinancialTypeToString(ByVal type As FinancialSecurityType) As String
Select Case type
Case FinancialSecurityType.Stock : Return "Stocks"
Case FinancialSecurityType.Fund : Return "Mutual Funds"
Case FinancialSecurityType.ETF : Return "ETFs"
Case FinancialSecurityType.Index : Return "Indices"
Case FinancialSecurityType.Future : Return "Futures"
Case Else : Return "All"
End Select
End Function
Private Sub RaiseCompleted(ByVal searchArgs As AsyncDownloadRecursiveArgs, ByVal conn As Base.ConnectionInfo, ByVal lastNewResults() As IDSearchResult, ByVal maxAvailable As Integer)
If Not searchArgs.CompletedEventAlreadyRaised Then
mFinished = True
searchArgs.CompletedEventAlreadyRaised = True
RaiseEvent AsyncDownloadCompleted(Me, New IDSearchDownloadCompletedEventArgs(searchArgs.UserArgs, New API.IDSearchResponse(conn, searchArgs.Results.ToArray), searchArgs.Options, maxAvailable + searchArgs.Options.Start))
End If
End Sub
Private Sub RaiseChanged(ByVal searchArgs As AsyncDownloadRecursiveArgs, ByVal conn As Base.ConnectionInfo, ByVal lastResults() As IDSearchResult, ByVal max As Integer)
If Not mFinished Then RaiseEvent AsyncDownloadChanged(Me, New IDSearchDownloadChangedEventArgs(searchArgs.UserArgs, New API.IDSearchResponse(conn, searchArgs.Results.ToArray), lastResults, max, searchArgs.Results.Count, searchArgs.Options, searchArgs.MaxResults + searchArgs.Options.Start))
End Sub
Private Class AsyncDownloadRecursiveArgs
Inherits Base.DownloadEventArgs
Public Text As String = String.Empty
Public IsFirst As Boolean = True
Public MaxResults As Integer = 0
Public Results As New List(Of IDSearchResult)
Public PagesStarted As Integer = -1
Public Options As New IDSearchOptions
Public CompletedEventAlreadyRaised As Boolean = False
Public Sub New(ByVal userArgs As Object)
MyBase.New(userArgs)
End Sub
End Class
End Class
''' <summary>
''' Stores the complete result of an asynchronous ID search
''' </summary>
''' <remarks></remarks>
Public Class IDSearchDownloadCompletedEventArgs
Inherits Base.DownloadCompletedEventArgs
Private mOptions As IDSearchOptions
Private mMaximumResultsAvailable As Integer = 0
Public ReadOnly Property MaximumResultsAvailable() As Integer
Get
Return mMaximumResultsAvailable
End Get
End Property
''' <summary>
''' The used search options
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public ReadOnly Property Options() As IDSearchOptions
Get
Return mOptions
End Get
End Property
''' <summary>
''' Gets the response with ID search results.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Overloads ReadOnly Property Response() As API.IDSearchResponse
Get
Return DirectCast(MyBase.Response, API.IDSearchResponse)
End Get
End Property
Friend Sub New(ByVal userArgs As Object, ByVal resp As API.IDSearchResponse, ByVal opt As IDSearchOptions, ByVal maxAvailable As Integer)
MyBase.New(userArgs, resp)
mOptions = opt
mMaximumResultsAvailable = maxAvailable
End Sub
End Class
''' <summary>
''' Stores the latest downloaded results of an asynchronous ID search since start or last event raised
''' </summary>
''' <remarks></remarks>
Public Class IDSearchDownloadChangedEventArgs
Inherits Base.DownloadChangedEventArgs
Private mMaximumResultsAvailable As Integer = 0
Private mNewResults() As IDSearchResult
Private mOptions As IDSearchOptions
''' <summary>
''' The used search options
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public ReadOnly Property Options() As IDSearchOptions
Get
Return mOptions
End Get
End Property
Public ReadOnly Property MaximumresultsAvailable() As Integer
Get
Return mMaximumResultsAvailable
End Get
End Property
Public ReadOnly Property NewResults() As IDSearchResult()
Get
Return mNewResults
End Get
End Property
''' <summary>
''' The received list of ID search results.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Overloads ReadOnly Property Response() As API.IDSearchResponse
Get
Return DirectCast(MyBase.Response, API.IDSearchResponse)
End Get
End Property
Friend Sub New(ByVal userArgs As Object, ByVal resp As API.IDSearchResponse, ByVal newResults() As IDSearchResult, ByVal max As Integer, ByVal down As Integer, ByVal opt As IDSearchOptions, ByVal maxAvailable As Integer)
MyBase.New(userArgs, resp, max, down)
mOptions = opt
mNewResults = newResults
mMaximumResultsAvailable = maxAvailable
End Sub
End Class
''' <summary>
''' Stores settings for Yahoo ID search
''' </summary>
''' <remarks></remarks>
Public Class IDSearchOptions
Inherits ResultCountOptions
Private mType As FinancialSecurityType = FinancialSecurityType.Any
Private mMarkets As FinancialMarket = FinancialMarket.AllMarkets
Private mRankedBy As FinancialProperty = FinancialProperty.Name
Private mRankingDirection As System.ComponentModel.ListSortDirection = System.ComponentModel.ListSortDirection.Ascending
Private mISINIncluded As Boolean = False
''' <summary>
''' The search will be limited to a special type or all
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Type() As FinancialSecurityType
Get
Return mType
End Get
Set(ByVal value As FinancialSecurityType)
mType = value
Me.OnPropertyChanged("Type")
End Set
End Property
''' <summary>
''' The search will be limited to a special market or all
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Markets() As FinancialMarket
Get
Return mMarkets
End Get
Set(ByVal value As FinancialMarket)
mMarkets = value
Me.OnPropertyChanged("Markets")
End Set
End Property
''' <summary>
''' The ranking property of the result list
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks>Will be ignored if "GermanServer" is True</remarks>
Public Property RankedBy() As FinancialProperty
Get
Return mRankedBy
End Get
Set(ByVal value As FinancialProperty)
mRankedBy = value
Me.OnPropertyChanged("RankedBy")
End Set
End Property
''' <summary>
''' The ranking direction of the result list
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks>Will be ignored if "GermanServer" is True</remarks>
Public Property RankingDirection() As System.ComponentModel.ListSortDirection
Get
Return mRankingDirection
End Get
Set(ByVal value As System.ComponentModel.ListSortDirection)
mRankingDirection = value
Me.OnPropertyChanged("RankingDirection")
End Set
End Property
''' <summary>
''' If True the search results can contain ISIN and WKN values. Type, Market and Rank properties will be ignored.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks>Use the german/european server for alternative search.</remarks>
Public Property ISINIncluded() As Boolean
Get
Return mISINIncluded
End Get
Set(ByVal value As Boolean)
mISINIncluded = value
Me.OnPropertyChanged("ISINIncluded")
End Set
End Property
''' <summary>
''' Default constructor
''' </summary>
''' <remarks></remarks>
Public Sub New()
Me.Count = 20
End Sub
Friend Sub New(ByVal original As IDSearchOptions)
MyBase.new(original)
If original IsNot Nothing Then
With original
mType = .Type
mMarkets = .Markets
mRankedBy = .RankedBy
mRankingDirection = .RankingDirection
mISINIncluded = .ISINIncluded
End With
End If
End Sub
End Class
End Namespace