Option Explicit

Public dAmt, dAmt2 As Double
Public IE, IE2, sMainHtml, sHtml, sSubHtml, sDataCheck1, sDataCheck2, sHome, sAway, sUrl, sKeyword, ft, sLink
Public iPlace, iRow, iRow2, iCol, iCol2, iStart, iEnd, i, P, iCount As Integer
Public dStart, dEnd, dRow, dRow2, dRow3, dHome, dDraw, dAway, dCheck, dWin As Double
Public OptionArray(1000), DataArray(1000, 20)
Public sThisbook, sTitle, sMsg As String
Public objForms, objForm, objInputElement, objInputElement2
Public dStarttime, dChecktime As Date
Public bisitfast As Boolean

Sub StartPosting()

dAmt = Range("d8")
dStarttime = TimeValue(Now() + TimeValue("00:00:01"))
Call GetHtml("www.nashprojects.com")
dAmt2 = 0
Do Until dAmt = dAmt2
tryagain:
    'http://www.xtremetop100.com/in.php?site=1132297863'
    IE.navigate ("http://www.xtremetop100.com/in.php?site=1132297863")
    Application.Wait (Now() + TimeValue("00:00:05"))
        If InStr(1, UCase(IE.document.body.innerhtml), "CANNOT BE FOUND", 0) > 0 Then
            IE.navigate ("http://www.xtremetop100.com/in.php?site=1132297863")
            Application.Wait (Now() + TimeValue("00:00:05"))
        End If

    Call WaitTillFinished
    If bisitfast = False Then GoTo tryagain
    Application.Wait (Now() + TimeValue("00:00:04"))

    If IE.locationurl <> "http://www.xtremetop100.com/in.php?site=1132297863" Then
        GoTo tryagain
    End If

    sHtml = IE.document.body.innerhtml
    'Range("a1") = sHtml
    If InStr(1, UCase(sHtml), "YOU DON'T HAVE PERMISSION", 0) > 0 Then GoTo tryagain
    If InStr(1, UCase(sHtml), "CANNOT DISPLAY", 0) > 0 Then GoTo tryagain
    If InStr(1, UCase(sHtml), "CANNOT BE FOUND", 0) > 0 Then GoTo tryagain
    If InStr(1, UCase(sHtml), UCase("Generated"), 0) > 0 Then GoTo tryagain
    'Generated
    iPlace = InStr(1, IE.document.body.innerhtml, "DISPLAY: block", 0)
    Do Until Mid(IE.document.body.innerhtml, iPlace, 3) = "src"
        iPlace = iPlace + 1
    Loop
    iPlace = iPlace + 5
    iStart = iPlace
    iPlace = iPlace + 2
    Do Until Mid(IE.document.body.innerhtml, iPlace, 1) = Chr(34)
        iPlace = iPlace + 1
    Loop

    Call NPDelete_File(ActiveWorkbook.Path & ".\Captcha.jpg")
    Call SaveWebFile(Mid(IE.document.body.innerhtml, iStart, iPlace - iStart), ActiveWorkbook.Path & ".\Captcha.jpg")
    Call SolveCaptcha("ggn25f8yup8a33frzgsw3r5i7f3iovuedgf76e", Application.Path & ".\Captcha.jpg")

    'call wait
    If InStr(1, UCase(IE2.document.body.innerhtml), "YOU DON'T HAVE PERMISSION", 0) > 0 Or InStr(1, UCase(IE2.document.body.innerhtml), "CANNOT DISPLAY", 0) > 0 Then
        IE2.Quit
        GoTo tryagain
    End If
    If InStr(1, UCase(IE2.document.body.innerhtml), "CANNOT BE FOUND", 0) > 0 Or InStr(1, UCase(IE2.document.body.innerhtml), "WEBSITE DECLINED", 0) > 0 Then
        IE2.Quit
        GoTo tryagain
    End If

    sKeyword = Trim(Mid(IE2.document.body.innerhtml, InStr(1, IE2.document.body.innerhtml, "<TD>", 0) + 4, InStr(1, IE2.document.body.innerhtml, "</TD>", 0) - InStr(1, IE2.document.body.innerhtml, "<TD>", 0) - 4))
    IE2.Quit
    Application.Wait (Now() + TimeValue("00:00:06"))
    Do Until TimeValue(Now()) > TimeValue(dStarttime)
        Application.Wait (Now() + TimeValue("00:00:02"))
        Application.StatusBar = "Waiting until " & TimeValue(dStarttime)
    Loop
    Application.StatusBar = False

    Set objForms = IE.document.forms
    'Test to see if there are forms before proceding
    Set objForm = objForms(0)
    i = 1
    For Each objInputElement In objForm
'        MsgBox objInputElement.Name
        If i = 3 Then
            objInputElement.Focus
            objInputElement.Value = sKeyword
            'Exit For
        ElseIf UCase(objInputElement.Name) = UCase("Submit") Then
            objInputElement.Focus
            objInputElement.Click
            Exit For
        End If
        i = i + 1
    Next
    Call WaitTillFinished
    'MsgBox sKeyword
    dAmt2 = dAmt2 + 1
    dStarttime = TimeValue(Now() + TimeValue("00:02:01"))
Loop

MsgBox dAmt & " posted"

End Sub

Sub GetHtml(sUrl)

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True 'if you want to see the browser window, but not necessary
IE.navigate sUrl 'place your desired URL here

End Sub

Sub GetSecondIe()

Set IE2 = CreateObject("InternetExplorer.Application")
IE2.Visible = True 'if you want to see the browser window, but not necessary
IE2.navigate sUrl 'place your desired URL here

End Sub

Sub SolveCaptcha(sKey, sFile)

    Call GetSecondIe
StartAgain:
    IE2.navigate "http://www.beatcaptchas.com/captcha.php"
    While IE2.Busy
        DoEvents
    Wend
NavigateWait:
    Application.Wait (Now() + TimeValue("00:00:03"))
    If IsError(IE2.document.body.innerhtml) = True Then GoTo NavigateWait
    sSubHtml = IE2.document.body.innerhtml
    Do Until InStr(1, UCase(sSubHtml), UCase("Submit"), 0) > 0
        sSubHtml = IE2.document.body.innerhtml
    Loop
    Application.Wait (Now() + TimeValue("00:00:02"))

    On Error GoTo StartAgain
    Set objForms = IE2.document.forms
    dRow = 2
    If objForms.Length <> 0 Then
        Set objForm = objForms(0)
        i = 1
        For Each objInputElement In objForm
            If UCase(objInputElement.Type) = "FILE" Then
                Application.Wait (Now() + TimeValue("00:00:01"))
                objInputElement.Focus
                Application.Wait (Now() + TimeValue("00:00:01"))
                'objInputElement.Click
                'Application.Wait (Now() + TimeValue("00:00:03"))
                SendKeys sFile
            ElseIf UCase(objInputElement.Name) = UCase("KEY") Then
                objInputElement.Value = sKey
            ElseIf UCase(objInputElement.Name) = UCase("SUBMIT") Then
                Application.Wait (Now() + TimeValue("00:00:01"))
                objInputElement.Focus
                Application.Wait (Now() + TimeValue("00:00:01"))
                objInputElement.Click
                objInputElement.Click
                objInputElement.Click
            End If
        Next
    End If

    While IE2.Busy
        DoEvents
    Wend

NavigateWait2:
    Application.Wait (Now() + TimeValue("00:00:03"))
    If IsError(IE2.document.body.innerhtml) = True Then GoTo NavigateWait2
    Application.Wait (Now() + TimeValue("00:00:04"))

    sSubHtml = IE2.document.body.innerhtml
    If InStr(1, UCase(sSubHtml), "ERROR IF YOU HAVE JUST PURCHASED", 0) > 0 Then
        MsgBox ("There is an error, the Captchas cannot be retrieved as yet")
    End If


End Sub

Sub WaitTillFinished()

    dChecktime = TimeValue(Now())
    bisitfast = True
    While IE.Busy
        Application.Wait (Now() + TimeValue("00:00:01"))
        If Format(TimeValue(Format(Now(), "hh:mm:ss")) - TimeValue(Format(dStarttime, "hh:mm:ss")), "hh:mm:ss") > Format(TimeValue("00:01:30"), "HH:MM:SS") Then
            bisitfast = False
            Exit Sub
        End If
    Wend

End Sub

Sub NPDelete_File(sfilename)

'MsgBox sfilename
On Error GoTo FileNotFound
Set ft = CreateObject("Scripting.FileSystemObject")
ft.DeleteFile sfilename, True

'Application.StatusBar = "File deleted successfully"

ExitIT:

Exit Sub

FileNotFound:
'Application.StatusBar = "File not found"
Application.Wait (Now() + TimeValue("00:00:01"))
Resume ExitIT

End Sub
Function SaveWebFile(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean

    Dim oXMLHTTP As Object, vFF As Long, oResp() As Byte
     'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    oXMLHTTP.Open "GET", vWebFile, False 'Open socket to get the website
    oXMLHTTP.send 'send request

     'Wait for request to finish
    Do While oXMLHTTP.readyState <> 4
        DoEvents
    Loop

    oResp = oXMLHTTP.responseBody 'Returns the results as a byte array

     'Create local file and save results to it
    vFF = FreeFile
    If Dir(vLocalFile) <> "" Then Kill vLocalFile
    Open vLocalFile For Binary As #vFF
    Put #vFF, , oResp
    Close #vFF

     'Clear memory
    Set oXMLHTTP = Nothing
End Function