Archived

This topic is now archived and is closed to further replies.

AltTab

Control uTorrent by torrent "status" conditions in VBScript

Recommended Posts

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

Share this post


Link to post
Share on other sites