Results 1 to 3 of 3

Thread: [vb.net] Money Tree Items Extraction

Threaded View

  1. #1

    Joined
    Jun 2012
    Posts
    1,699
    Thanks
    876
    Thanked
    2,881/1,142
    DL/UL
    44/1
    Mentioned
    562 times
    Time Online
    118d 6h 45m
    Avg. Time Online
    40m

    [vb.net] Money Tree Items Extraction

    In a class:

    PHP Code:

    Public Class moneytree


        
    Public Sub RefreshItemList(ByVal sourestr As StringByVal extracttolist As List(Of MoneyTreeItems))
            
    'Extracts the take donation urls and item name in 1 swoop
            Dim Temp As Long, temp1 As Long, temp2 As Long, temp3 As Long, temp4 As Long, temp5 As Long, temp6 As Long, temp7 As Long '
    Trash vars

            temp1 
    'Add a default start position
            sourestr = Replace(sourestr, Chr(34), "'") 'Remove Quotes from source code and switch them to commas

            If InStr(sourestr, "
    takedonation_new") < 1 Then 'Does the phrase takedonation_new appear in the source , if not there no items so we might aswell save ticks an quit
                Exit Sub
            End If


            Do While InStr(temp1, sourestr, "
    </A><BR><B>", vbTextCompare) <> 0 'Only search while there is new items available after the last searched item
                Dim tempitem As New MoneyTreeItems 'A single holder for the current item
                tempitem.itemname = ""
                tempitem.takeurl = ""
                tempitem.isneopoints = False
                Temp = InStr(temp1, sourestr, "
    </A><BR><B>", vbTextCompare) + Len("</A><BR><B>") 'Search the current html dot the position of "</A><BR><B>" , with a start location of temp1 (last found item)
                temp2 = InStr(Temp, sourestr, "
    </B><BR>(", vbTextCompare) 'position of end string using location found in above line of code as a start position
                temp3 = temp2 - Temp 'Start position of the string to be extracted
                temp1 = temp2 + 1 'End position of the string to be extracted
                Dim currentitemname As String = Mid$(sourestr, Temp, temp3) 'Current item name extracted
                temp4 = InStrRev(sourestr, "
    takedonation_new.phtml?donation_id=", Temp) 'Search backwards from the last beggining position
                temp5 = InStr(temp4, sourestr, "'>", vbTextCompare)
                temp6 = temp5 - temp4 '
    End position of the string to be extracted
                Dim currentitemurl 
    As String Mid$(sourestrtemp4temp6'Current item name extracted


                Dim itemnamelen As Integer = Len(currentitemname) '
    Get length of the current items name
                Dim tempstr 
    As String Mid(currentitemnameitemnamelen 23'Extract the last 3 letter of the current items name
                If tempstr <> " NP" Then '
    If this item is a "neopoints item" the last 3 letters will be " NP" 

                    
    tempitem.isneopoints True
                  
                
    Else
                    
    tempitem.isneopoints False

                End 
    If
                
    tempitem.takeurl "http://www.neopets.com/" currentitemurl

                tempitem
    .itemname currentitemname 'Create new item
                extracttolist.Add(tempitem) '
    Add item to our list

        

            
    Loop





        End Sub

    End 
    Class

    Public Class 
    MoneyTreeItems

        
    Public itemname As String
        
    Public takeurl As String
        
    Public isneopoints As Boolean

    End 
    Class 



    now in a button..
    PHP Code:
     Dim strhtml As String
          
            strhtml 
    mywrapper.Request("GET""http://www.neopets.com/donations.phtml"mywrapper.LastPage)
            
    Dim moneytreeitems As New List(Of MoneyTreeItems'Create a new list of money tree items
            MoneyTreehandler.RefreshItemList(strhtml, moneytreeitems) '
    Refresh the list based on strhtmls source

            
    For As Integer 0 To moneytreeitems.Count 'Loop every item currently found on the money tree
                MsgBox("Name = " & moneytreeitems(y).itemname & "Url= " & moneytreeitems(y).takeurl )
            Next y 
    Last edited by DarkByte; 07-01-2012 at 08:22 AM.

  2. The Following User Says Thank You to DarkByte For This Useful Post:

    mathbg (05-20-2013)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •