Control uTorrent by torrent "status" conditions in VBScript

AltTab · November 27, 2013

This was somewhat of a request I am fulfilling and something i needed for myself. I have found a solution where I wouldn't need a script to fix torrents that are stopped with "Error: The network path was not found." Because i changed my default download folder to my Local D drive instead of having it on a network share drive and to move the finished downloads to my BitTorrentPost folder on the network share drive only when torrents are in the default folder. If other people are unable to setup anything local then this VBScript could be useful.

For using i would have this vbscript on a scheduled task. As it continues to runs it will be building more status in the INI file "uTorrent-errorHandle.ini" in the same location as the vbs file.

here are 2 examples of changes i made to the INI file

["Error: Files missing from job. Please recheck."]
ProblemCat=Exec
NoOfCommands=1
WaitTimeBetweenCommand=0
StrCommand1=&action=recheck&hash=

["Stopped"]
ProblemCat=Exec
NoOfCommands=1
WaitTimeBetweenCommand=0
StrCommand1=&action=start&hash=

If the command you want to use does require the torrent HASH then the command must end with &hash=

This is the actual script

'on error resume next
'on error goto 0
'EDIT THESE VARIABLES
uTorrentIP="192.168.1.2"    'THIS MUST BE CHANGED TO MATCH YOUR uTORRENT CLIENT/NAS...WHATEVER IT IS!!!!
uTorrentPort="23177"
uTorrentServerID="admin"
uTorrentServerPW="admin"

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ReadIni( myFilePath, mySection, myKey )
    ' This function returns a value read from an INI file
    '
    ' Arguments:
    ' myFilePath  [string]  the (path and) file name of the INI file
    ' mySection   [string]  the section in the INI file to be searched
    ' myKey       [string]  the key whose value is to be returned
    '
    ' Returns:
    ' the [string] value for the specified key in the specified section
    '
    ' CAVEAT:     Will return a space if key exists but value is blank
    '
    ' Written by Keith Lacelle
    ' Modified by Denis St-Pierre and Rob van der Woude

    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

    Dim intEqualPos
    Dim objFSO, objIniFile
    Dim strFilePath, strKey, strLeftString, strLine, strSection

    Set objFSO = CreateObject( "Scripting.FileSystemObject" )

    ReadIni     = ""
    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )

    If objFSO.FileExists( strFilePath ) Then
        Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
        Do While objIniFile.AtEndOfStream = False
            strLine = Trim( objIniFile.ReadLine )

            ' Check if section is found in the current line
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                strLine = Trim( objIniFile.ReadLine )

                ' Parse lines until the next section is reached
                Do While Left( strLine, 1 ) <> "["
                    ' Find position of equal sign in the line
                    intEqualPos = InStr( 1, strLine, "=", 1 )
                    If intEqualPos > 0 Then
                        strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                        ' Check if item is found in the current line
                        If LCase( strLeftString ) = LCase( strKey ) Then
                            ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
                            ' In case the item exists but value is blank
                            If ReadIni = "" Then
                                ReadIni = " "
                            End If
                            ' Abort loop when item is found
                            Exit Do
                        End If
                    End If

                    ' Abort if the end of the INI file is reached
                    If objIniFile.AtEndOfStream Then Exit Do

                    ' Continue with next line
                    strLine = Trim( objIniFile.ReadLine )
                Loop
            Exit Do
            End If
        Loop
        objIniFile.Close
    Else
        WScript.Echo strFilePath & " doesn't exists. Exiting..."
        Wscript.Quit 1
    End If
End Function

Sub WriteIni( myFilePath, mySection, myKey, myValue )
    ' This subroutine writes a value to an INI file
    '
    ' Arguments:
    ' myFilePath  [string]  the (path and) file name of the INI file
    ' mySection   [string]  the section in the INI file to be searched
    ' myKey       [string]  the key whose value is to be written
    ' myValue     [string]  the value to be written (myKey will be
    '                       deleted if myValue is <DELETE_THIS_VALUE>)
    '
    ' Returns:
    ' N/A
    '
    ' CAVEAT:     WriteIni function needs ReadIni function to run
    '
    ' Written by Keith Lacelle
    ' Modified by Denis St-Pierre, Johan Pol and Rob van der Woude

    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

    Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
    Dim intEqualPos
    Dim objFSO, objNewIni, objOrgIni, wshShell
    Dim strFilePath, strFolderPath, strKey, strLeftString
    Dim strLine, strSection, strTempDir, strTempFile, strValue

    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )
    strValue    = Trim( myValue )

    Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
    Set wshShell = CreateObject( "WScript.Shell" )

    strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
    strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )

    Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
    Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )

    blnInSection     = False
    blnSectionExists = False
    ' Check if the specified key already exists
    blnKeyExists     = ( ReadIni( strFilePath, strSection, strKey ) <> "" )
    blnWritten       = False

    ' Check if path to INI file exists, quit if not
    strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
    If Not objFSO.FolderExists ( strFolderPath ) Then
        WScript.Echo "Error: WriteIni failed, folder path (" _
                   & strFolderPath & ") to ini file " _
                   & strFilePath & " not found!"
        Set objOrgIni = Nothing
        Set objNewIni = Nothing
        Set objFSO    = Nothing
        WScript.Quit 1
    End If

    While objOrgIni.AtEndOfStream = False
        strLine = Trim( objOrgIni.ReadLine )
        If blnWritten = False Then
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                blnSectionExists = True
                blnInSection = True
            ElseIf InStr( strLine, "[" ) = 1 Then
                blnInSection = False
            End If
        End If

        If blnInSection Then
            If blnKeyExists Then
                intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
                If intEqualPos > 0 Then
                    strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                    If LCase( strLeftString ) = LCase( strKey ) Then
                        ' Only write the key if the value isn't empty
                        ' Modification by Johan Pol
                        If strValue <> "<DELETE_THIS_VALUE>" Then
                            objNewIni.WriteLine strKey & "=" & strValue
                        End If
                        blnWritten   = True
                        blnInSection = False
                    End If
                End If
                If Not blnWritten Then
                    objNewIni.WriteLine strLine
                End If
            Else
                objNewIni.WriteLine strLine
                    ' Only write the key if the value isn't empty
                    ' Modification by Johan Pol
                    If strValue <> "<DELETE_THIS_VALUE>" Then
                        objNewIni.WriteLine strKey & "=" & strValue
                    End If
                blnWritten   = True
                blnInSection = False
            End If
        Else
            objNewIni.WriteLine strLine
        End If
    Wend

    If blnSectionExists = False Then ' section doesn't exist
        objNewIni.WriteLine
        objNewIni.WriteLine "[" & strSection & "]"
            ' Only write the key if the value isn't empty
            ' Modification by Johan Pol
            If strValue <> "<DELETE_THIS_VALUE>" Then
                objNewIni.WriteLine strKey & "=" & strValue
            End If
    End If

    objOrgIni.Close
    objNewIni.Close

    ' Delete old INI file
    objFSO.DeleteFile strFilePath, True
    ' Rename new INI file
    objFSO.MoveFile strTempFile, strFilePath

    Set objOrgIni = Nothing
    Set objNewIni = Nothing
    Set objFSO    = Nothing
    Set wshShell  = Nothing
End Sub

scriptpath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Dim MyConnection, TheURL
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OpenAsASCII = 0
Const OverwriteIfExist = -1
Const ForAppending = 8

sFile = scriptpath & "uTorrent-errorHandle.ini"

If Not objFSO.FileExists( sFile ) Then
	Set fFile = objFSO.CreateTextFile(sFile, OverwriteIfExist, OpenAsASCII)
	fFile.WriteLine(";Instructions of use")
	fFile.WriteLine(";Each status provided by uTorrent can have an action performed by API commands")
	fFile.WriteLine(";Change ProblemCat to something other than Ignore will trigger the commands to perform")
	fFile.WriteLine(";Multiple Commands can be set with NoOfCommands=")
	fFile.WriteLine(";WaitTimeBetweenCommand will be in milliseconds (1000) is 1 second")
	fFile.WriteLine(";StrCommand2 is only valid if NoOfCommands is 2 or greater")
	fFile.WriteLine(";commands are available here http://forum.utorrent.com/viewtopic.php?id=25661#p318056 but not limited to those actions")
	fFile.WriteLine(";example StrCommand1=&action=start&hash=")
	fFile.Close
	set fFile = nothing
End If

    TOKEN = getTOKEN

    TheURL="HTTP://"&uTorrentIP&":"&uTorrentPort&"/gui/?token="&TOKEN&"&list=1"
    Set Http = CreateObject("MSXML2.XMLHTTP")
    Http.Open "GET",TheURL,false
    Http.Send
    uTorrentStatus = Http.responseText
	'msgbox uTorrentStatus


    a=Split(uTorrentStatus,chr(10))
	for each x in a 
		If instr(x,chr(34)&"label"&chr(34)&": [") > 0 Then Exit For
		If Len(x) > 30 Then
			b=Split(x,",")
			If Trim(ReadIni(sFile,b(21),"ProblemCat")) = "" Then
				WriteIni sFile,b(21),"WaitTimeBetweenCommand","0"
				WriteIni sFile,b(21),"NoOfCommands","0"
				WriteIni sFile,b(21),"ProblemCat","Ignore"
			Else
				If Not Trim(ReadIni(sFile,b(21),"ProblemCat")) = "Ignore" Then
					commandcount = CInt(Trim(ReadIni(sFile,b(21),"NoOfCommands")))
					waittime = Trim(ReadIni(sFile,b(21),"WaitTimeBetweenCommand"))
					HASH = Mid(b(0),3,cInt(Len(b(0))-3))
					if commandcount > 0 Then
						For i = 1 To commandcount
							StrCommand = "StrCommand" & cStr(i)
							COMMAND = Trim(ReadIni(sFile,b(21),StrCommand))
							uAPICommand COMMAND, HASH, waittime
						Next
					End If
				End If
			End If
		End If
	next

Sub uAPICommand(uCOMMAND,uHASH,uSLEEP)
	TOKEN = getTOKEN
	If instr(1,uCOMMAND,"&hash=",1) > 0 Then uCOMMAND = uCOMMAND & uHASH
	TheURL="HTTP://"&uTorrentIP&":"&uTorrentPort&"/gui/?token="&TOKEN&uCOMMAND
	Set Http = CreateObject("MSXML2.XMLHTTP")
	Http.Open "GET",TheURL,false
	Http.Send
	uTorrentResponse = Http.responseText
	Set Http = Nothing
	wscript.Sleep(uSLEEP)
	'msgbox uTorrentResponse
End Sub	

Sub uLimit(dlrate,ulrate)
	TOKEN = getTOKEN
	TheURL="HTTP://"&uTorrentIP&":"&uTorrentPort&"/gui/?token="&TOKEN&"&action=setsetting&s=max_dl_rate&v="&dlrate&"&s=max_ul_rate&v="&ulrate
	Set Http = CreateObject("MSXML2.XMLHTTP")
	Http.Open "GET",TheURL,false
	Http.Send
	uTorrentResponse = Http.responseText
	Set Http = Nothing
	'msgbox uTorrentResponse
End Sub

Function getTOKEN
    'GO FETCH AND PARSE THE A TOKEN FROM uTorrent
    'TokenURL="HTTP://"&uTorrentServerID&":"&uTorrentServerPW&"@"&uTorrentIP&":"&uTorrentPort&"/gui/token.html"
    TokenURL="HTTP://"&uTorrentIP&":"&uTorrentPort&"/gui/token.html"
    Set xml = CreateObject("Microsoft.XMLHTTP")
    'xml.Open "GET", TokenURL, False
    xml.Open "GET", TokenURL, False, uTorrentServerID, uTorrentServerPW
    xml.SEND
    TokenPage = xml.responseText

    StartTag="<div id='token' style='display:none;'>"
    EndTag="</div>"
    getTOKEN = ""
    lArray = Split(TokenPage, StartTag)

    If IsArray(lArray) Then
        Extract = lArray(1)
        lArray = Split(Extract, EndTag)
        If IsArray(lArray) Then
			getTOKEN = lArray(0)
        Else
            getTOKEN = ""
        End If
    End If
    Set xml = Nothing

End Function

Sign In

Control uTorrent by torrent "status" conditions in VBScript

Recommended Posts

AltTab

Link to comment

Share on other sites

Archived

Browse

Activity