Mikron Coin Generator

'-------------------------------------------------------------------------------------------
'___  ____ _                      _                   _                   _
'|  \/  (_) |                    (_)                 (_)                 (_)
'| .  . |_| | ___ __ ___  _ __    _  ___     ___ ___  _ _ __    _ __ ___  _ _ __   ___ _ __
'| |\/| | | |/ / '__/ _ \| '_ \  | |/ _ \   / __/ _ \| | '_ \  | '_ ` _ \| | '_ \ / _ \ '__|
'| |  | | |   <| | | (_) | | | |_| | (_) | | (_| (_) | | | | | | | | | | | | | | |  __/ |
'\_|  |_/_|_|\_\_|  \___/|_| |_(_)_|\___/   \___\___/|_|_| |_| |_| |_| |_|_|_| |_|\___|_|
'-------------------------------------------------------------------------------------------
' This is an example program how to use the internet explorer from vbscript
' Never use it, only read and learn
' Without gui
'-------------------------------------------------------------------------------------------
'Fill with your mikron address
Address = ""
'-------------------------------------------------------------------------------------------

Accounts = Array("Username1", "Username2", "Username3")
Password = "" ' Use this password for all accounts

Username = ""
ArticlesToRate = 100 'How many articles to rate in one session?
DelayBetweenArticles = 1000 'Seconds to delay between two articles
ShowBrowser = True 'You can hide it, if not needed...
'------------------------------------------------------------------
' Change if needed
RateArticles = True
LikeButtonClass = "lbg-style3"
LogoutUrl="https://kriptoakademia.com/kilepes"
LoginURL = "https://kriptoakademia.com/belepes"

SiteMapUrl = "Sitemap.xml"


'if Address = "" Then Address = InputBox( "Enter Your mikron address:" )
'if Address = "" Then WScript.Quit

Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists("Sitemap.xml")) Then
    SiteMapUrl = "Sitemap.xml"
Else
  dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
  dim bStrm: Set bStrm = createobject("Adodb.Stream")
  xHttp.Open "GET", "https://kriptoakademia.com/sitemap.xml", False
  xHttp.Send
  with bStrm
      .type = 1
      .open
      .write xHttp.responseBody
      .savetofile "Sitemap.xml", 2
  end with
  SiteMapUrl = "Sitemap.xml"
End If


UserNameField = "username-247"
PasswordField = "user_password-247"
SubmitButton = "um-submit-btn"

articles=0
ok = False


Set WshShell = CreateObject("WScript.Shell")
WshShell.run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8"
WshShell.run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2"
WshShell.run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1"

Set xmlDoc = createobject("Microsoft.XMLDOM")
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = ShowBrowser
IE.navigate LogoutURL

myKey = "HKCU\Software\Mikron\progress"

progress = ReadFromRegistry( myKey, 1)
xmltag = "loc"
xmlDoc.async = "false"
xmlDoc.load (SiteMapUrl)

While IE.Busy
  WScript.Sleep 50
Wend

While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend

For Each account In accounts

  IE.navigate LogoutURL

  While IE.Busy
    WScript.Sleep 50
  Wend

  While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend

  IE.navigate LoginURL
  While IE.Busy
    WScript.Sleep 50
  Wend

  While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend

  Set ipf = IE.document.GetElementById(UserNameField)
  ipf.Value = account
  Set ipf = IE.document.GetElementById(PasswordField)
  ipf.Value = Password
  Set ipf = IE.document.GetElementById(SubmitButton)
  WScript.Sleep 1000
  ipf.Click

  While IE.Busy
    WScript.Sleep 50
  Wend

  While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend

  IE.navigate "https://kriptoakademia.com/mikron"
  While IE.Busy
    WScript.Sleep 50
  Wend
  While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend


  Set xmlCol = xmldoc.getElementsByTagName(xmltag)
  ok = True

  For Each Elem In xmlCol
    If ok Then
      While IE.Busy
        WScript.Sleep 50
      Wend
      max = xmlCol.length-1
      min = 1
      o = 0
      while o=0:
        progress = progress + 1
        ind = progress
        if InStr(xmlCol(ind).firstChild.nodeValue, "2018") Then
            o=1
            IE.navigate(xmlCol(ind).firstChild.nodeValue)
        Else
            if InStr(xmlCol(ind).firstChild.nodeValue, "2017") Then
                o=1
                IE.navigate(xmlCol(ind).firstChild.nodeValue)
            End if
        End if
      Wend
      While IE.Busy
        WScript.Sleep 50
      Wend
      While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend
      If RateArticles Then
          On Error Resume Next
          Set links = IE.Document.QuerySelector("a." & LikeButtonClass)
          if Err.number=0 Then
            links.Click
            WScript.Sleep 1000
            While IE.Busy
              WScript.Sleep 50
            Wend
            While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend
            articles = articles + 1
            WScript.Sleep DelayBetweenArticles
          else
          Err.clear
        end if
        On Error Goto 0
      End If
      WshShell.RegWrite myKey, progress, "REG_DWORD"
      If articles > ArticlesToRate Then
        Exit For
      End If
    End If
  Next
  if Address<>"" Then
    IE.navigate "https://kriptoakademia.com/mikron"
    While IE.Busy
      WScript.Sleep 50
    Wend
    While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend

    Set elems = IE.document.QuerySelector( "div.mikron-details-value" )
    mkr = elems.innerText
    Set ipf = IE.document.GetElementById("address")
    ipf.Value = Address
    Set ipf = IE.document.GetElementById("amount")
    ipf.Value = mkr
    Set elems = IE.document.QuerySelector( "button[type='submit'].btn-primary" )
    elems.Click
    While IE.Busy
      WScript.Sleep 50
    Wend
    While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend
    WScript.Sleep 5000
  End If
  IE.Quit
  Set IE = Nothing
  WshShell.run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8"
  WshShell.run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2"
  WshShell.run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1"
  Set IE = CreateObject("InternetExplorer.Application")
  IE.Visible = ShowBrowser
  articles = 0

Next

IE.Quit
Set WshShell = Nothing
Set IE = Nothing
Set xmlCol = Nothing
Set xmlDoc = Nothing

Function RandomString( ByVal strLen )
    Dim str, min, max

    Const LETTERS = "abcdefghijklmnopqrstuvwxyz0123456789"
    min = 1
    max = Len(LETTERS)

    Randomize
    For i = 1 to strLen
        str = str & Mid( LETTERS, Int((max-min+1)*Rnd+min), 1 )
    Next
    RandomString = str
End Function

Function ReadFromRegistry (strRegistryKey, strDefault )
    Dim WSHShell, value
    On Error Resume Next
    Set WSHShell = CreateObject("WScript.Shell")
    value = WSHShell.RegRead( strRegistryKey )
    if err.number <> 0 then
        readFromRegistry= strDefault
    else
        readFromRegistry=value
    end if
    Set WSHShell = nothing
End Function