Results 1 to 1 of 1

Thread: [VB6]Subeta Wizard Quester

Hybrid View

  1. #1
    Reemer's Avatar
    Joined
    Dec 2011
    Posts
    639
    Userbars
    8
    Thanks
    364
    Thanked
    446/256
    DL/UL
    39/0
    Mentioned
    203 times
    Time Online
    4d 13h 47m
    Avg. Time Online
    1m

    [VB6]Subeta Wizard Quester

    This was made when I was pretty noobish at coding, so it's not very pretty. I don't have much time to do programs anymore, so here's this source.

    Code:
    Dim stritem1 As String
    Dim stritem1buy As String
    Dim stritem2 As String
    Dim strshopid As String
    Dim strCV As String
    Dim strvercode As String
    Dim stritemID As String
    Dim strwin1 As String
    Dim strwin2 As String
    Dim strshop As String
    Dim intdone As Integer
    Dim strdone As String
    Dim strprice As String
    Dim intprice As Integer
    Dim strshopname As String
    Dim strmaxquests As String
    Dim intmaxquests As String
    
    
    
    
    Dim aitem As Boolean
    aitem = True
    
    StopProgram = False
    Command2.Enabled = False
    Command3.Enabled = True
    lblstatus.Caption = "Starting quests."
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    Call Wrapper1.Request(strHTML, "GET", "http://subeta.net/explore/wizard_quests.php")
    If InStr(strHTML, "Plays: ") Then
    intdone = GetStringBetween(strHTML, "Plays: ", "/")
    intmaxquests = GetStringBetween(strHTML, "Plays: " & intdone & "/", ")</center></form>")
    intdone = Val(intmaxquests) - Val(intdone)
    txtgames.Text = intdone
    End If
    If InStr(1, strHTML, "You must be logged in to view this page!") Then
    StopProgram = True
    End If
    
    Do Until StopProgram = True
    twoitems = False
    threeitems = False
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    Call Wrapper1.Request(strHTML, "POST", "http://subeta.net/explore/wizard_quests.php?act=startquest", Wrapper1.LastPage)
    Call Wrapper1.Request(strHTML, "GET", "http://subeta.net/explore/wizard_quests.php")
    Buy_start:
    strHTML = Replace(strHTML, "<br />", "<br/>")
    stritem1 = GBA(strHTML, "</a></span><br/>", "</center></td>", lstAdd)
    For i = 0 To lstAdd.ListCount - 1
    strshop = lstAdd.List(i)
    If strshop = "" Then
    aitem = False
    MsgBox ("Item not available")
    End If
    If aitem = True Then
    lblstatus.Caption = "Buying " & strshop & "."
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    stritem1buy = Replace(strshop, " ", "+")
    Call Wrapper1.Request(strHTML, "GET", "http://subeta.net/ushop.php?act=dosearch&itemname=" & stritem1buy & "&type=shops", Wrapper1.LastPage)
    strshopid = GetStringBetween(strHTML, "/ushop.php?shopid=", "&act=buy")
    strshopname = GetStringBetween(strHTML, strshopid & ">", "</a></td>")
    strprice = GetStringBetween(strHTML, "Are you sure you wish to purchase", "sP?'")
    strprice = Replace(strprice, ",", "")
    strprice = GetStringBetween(strprice, strshopname & " for ", " sP")
    strprice = Replace(strprice, " ", "")
    lblcost.Caption = Val(lblcost.Caption) + Val(strprice)
    
    If Val(strprice) > Val(txtprice.Text) And StopProgram = False Then
    lblcost.Caption = 0
    lststatus.AddItem ("Item too expensive. Skipping quest.")
    lblstatus.Caption = "Starting another quest."
    Call Wrapper1.Request(strHTML, "POST", "http://subeta.net/explore/wizard_quests.php?act=quitquest", Wrapper1.LastPage)
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    Call Wrapper1.Request(strHTML, "POST", "http://subeta.net/explore/wizard_quests.php?act=startquest", Wrapper1.LastPage)
    GoTo Buy_start
    End If
    
    If Val(strprice) <= Val(txtprice.Text) And StopProgram = False Then
    strshopid = GetStringBetween(strHTML, "/ushop.php?shopid=", "&act=buy")
    
    strshopname = GetStringBetween(strHTML, strshopid & ">", "</a></td>")
    
    strvercode = GetStringBetween(strHTML, """vercode"" value=""", """")
    strCV = GetStringBetween(strHTML, """cv"" value=""", """")
    stritemID = GetStringBetween(strHTML, """itemid"" value=""", """")
    
    strvercode = Replace(strvercode, "=", "%3D")
    Call Wrapper1.Request(strHTML, "GET", "http://subeta.net/ushop.php?shopid=" & strshopid & "&act=buy&itemid=" & stritemID & "&cv=" & strCV & "&vercode=" & strvercode, Wrapper1.LastPage)
    
    
    Call Wrapper1.Request(strHTML, "GET", "http://subeta.net/ushop.php?shopid=" & strshopid, Wrapper1.LastPage)
    
    If InStr(1, strHTML, "Purchase failed.") Then
    StopProgram = True
    lblstatus.Caption = "Failed to buy item. Stopping."
    End If
    End If
    End If
    Next i
    
    
    
    Call Wrapper1.Request(strHTML, "POST", "http://subeta.net/explore/wizard_quests.php?act=finishquest", "http://subeta.net/explore/wizard_quests.php")
    lblcost.Caption = 0
    If InStr(1, strHTML, "You completed this quest in ") Then
    stritemwin1 = GetStringBetween(strHTML, "</a></span><br>", "<br><br>")
    stritemwin2 = GetStringBetween(strHTML, "<br><br>AND<BR><br>", "<br><a href=wizard_quests.php>")
    lststatus.AddItem ("Won " & stritemwin1 & " and " & stritemwin2 & ".")
    lblstatus.Caption = "Completed quest. Starting another."
    If InStr(1, strHTML, "You don't have all of the items!") Then
    lststatus.AddItem ("Don't have all the items. Stopping.")
    StopProgram = True
    End If
    End If
    lblgames.Caption = lblgames.Caption + 1
    If lblgames.Caption = txtgames.Text Then
    StopProgram = True
    lststatus.AddItem ("Reached max amount of quests done.")
    lblstatus.Caption = "Stopped."
    End If
    Loop
    
    End Sub
    lmk questions. Might post the entire project here.

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

    Frank12 (09-01-2012)

Posting Permissions

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