Once installed, when you start playing a track you will get confirmation in a progress bar to say that the current monitor timeout has been set to "never". When playback stops (for any reason, including shutdown) the previous value will be restored, which is also confirmed in a progress bar (no confirmation on shutdown).
As always, the installation package is available to download from my website. The code is also available here...
Code: Select all
'
' MediaMonkey Script
'
' NAME: PowerConfig 1.2
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 19/08/2010
'
' INSTALL: Copy to Scripts\Auto directory
'
' FIXES: Fixed script can run twice concurrently
' Fixed script not compatible with Windows XP
'
Option Explicit
Dim PlayTimeout : PlayTimeout = 3000
Dim ProgTimeout : ProgTimeout = 6000
Sub OnStartUp()
If SDB.IniFile.StringValue("PowerConfig","MonitorTimeoutAC") = "" Then
SDB.IniFile.IntValue("PowerConfig","MonitorTimeoutAC") = -1
End If
Call Script.RegisterEvent(SDB,"OnPlay","Play")
Call Script.RegisterEvent(SDB,"OnPlaybackEnd","PlaybackEnd")
Call Script.RegisterEvent(SDB,"OnShutdown","Shutdown")
If SDB.Player.isPlaying Then
Call Play()
End If
End Sub
Sub Play()
Dim prog : Set prog = SDB.Objects("PowerConfigProg")
If Not (prog Is Nothing) Then
Exit Sub
End If
Set SDB.Objects("PowerConfig") = Nothing
If SDB.IniFile.IntValue("PowerConfig","MonitorTimeoutAC") = -1 Then
Set prog = SDB.Progress
prog.Text = "PowerConfig: Initialising..."
Set SDB.Objects("PowerConfigProg") = prog
SDB.ProcessMessages
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim dat : dat = Replace(SDB.TemporaryFolder&"\PowerConfig.tmp","\\","\")
If fso.FileExists(dat) Then
Call fso.DeleteFile(dat)
End If
Dim cmd : cmd = "%comspec% /c powercfg -getactivescheme >"&dat
Call wsh.Run(cmd,0,True)
SDB.ProcessMessages
If fso.FileExists(dat) Then
Dim fil : Set fil = fso.OpenTextFile(dat,1,True)
If fil.AtEndOfStream Then
Call fil.Close()
Call DoXP()
Else
Dim str : str = fil.ReadAll
Call fil.Close()
Call DoVista(str)
End If
Else
prog.Text = "PowerConfig: Error - active plan query failed"
SDB.ProcessMessages
End If
Dim Tmr : Set Tmr = SDB.CreateTimer(ProgTimeout)
If Not (Tmr Is Nothing) Then
Call Script.RegisterEvent(Tmr,"OnTimer","HideProgress")
End If
End If
End Sub
Sub DoXP()
SDB.IniFile.StringValue("PowerConfig","Windows") = "XP"
Dim prog : Set prog = SDB.Objects("PowerConfigProg")
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim dat : dat = Replace(SDB.TemporaryFolder&"\PowerConfig.tmp","\\","\")
If fso.FileExists(dat) Then
Call fso.DeleteFile(dat)
End If
Dim cmd : cmd = "%comspec% /c powercfg -query >"&dat
Call wsh.Run(cmd,0,True)
SDB.ProcessMessages
MsgBox "1"
If fso.FileExists(dat) Then
Dim fil : Set fil = fso.OpenTextFile(dat,1,True)
Dim str : str = fil.ReadAll
Call fil.Close()
Dim arr : arr = Split(str,VbCrLf)
If (Left(arr(2),5) = "Name ") And (Left(arr(4),22) = "Turn off monitor (AC) ") Then
Dim nam : nam = Trim(Mid(arr(2),5))
prog.Text = "PowerConfig: Active plan is "&nam&"..."
SDB.ProcessMessages
SDB.IniFile.StringValue("PowerConfig","Name") = nam
str = Trim(Mid(arr(4),22))
Dim mins : mins = 0
If Not (str = "Never") Then
str = Replace(Replace(str,"After",""),"mins","")
mins = Int(Trim(str))
End If
SDB.IniFile.IntValue("PowerConfig","MonitorTimeoutAC") = mins
If mins = 0 Then
prog.Text = "PowerConfig: Active plan is "&nam&"... Monitor timeout already set to Never"
Else
cmd = "%comspec% /c powercfg -change "&Chr(34)&nam&Chr(34)&" -monitor-timeout-ac 0" 'Never
Call wsh.Run(cmd,0,False)
If mins > 1 Then
prog.Text = "PowerConfig: Active plan is "&nam&"... Changed monitor timeout from "&mins&" minutes to Never"
Else
prog.Text = "PowerConfig: Active plan is "&nam&"... Changed monitor timeout from 1 minute to Never"
End If
End If
Else
prog.Text = "PowerConfig: Error - current monitor timeout setting not found"
End If
Call fso.DeleteFile(dat)
Else
prog.Text = "PowerConfig: Error - current monitor settings query failed"
End If
SDB.ProcessMessages
End Sub
Sub DoVista(str)
SDB.IniFile.StringValue("PowerConfig","Windows") = "Vista"
Dim prog : Set prog = SDB.Objects("PowerConfigProg")
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim dat : dat = Replace(SDB.TemporaryFolder&"\PowerConfig.tmp","\\","\")
Dim arr : arr = Split(Replace(str," "," ")," ")
Dim nam : nam = Replace(Replace(arr(UBound(arr)),"(",""),")","")
prog.Text = "PowerConfig: Active plan is "&nam&"..."
SDB.ProcessMessages
SDB.IniFile.StringValue("PowerConfig","Name") = nam
If fso.FileExists(dat) Then
Call fso.DeleteFile(dat)
End If
Dim cmd : cmd = "%comspec% /c powercfg -query "&arr(3)&" 7516b95f-f776-4464-8c53-06167f40cc99 >"&dat 'Display
Call wsh.Run(cmd,0,True)
SDB.ProcessMessages
If fso.FileExists(dat) Then
Dim fil : Set fil = fso.OpenTextFile(dat,1,True)
str = fil.ReadAll
Call fil.Close()
Dim pos : pos = InStr(str,"3c0bc021-c8a8-4e07-a973-6b14cbcb2b7e") 'Turn off display after
pos = InStr(pos,str,"Current AC Power Setting Index:")
If pos > 0 Then
str = Mid(str,pos+34,8)
Dim mins : mins = Int(HexToDec(str)/60)
SDB.IniFile.IntValue("PowerConfig","MonitorTimeoutAC") = mins
If mins = 0 Then
prog.Text = "PowerConfig: Active plan is "&nam&"... Monitor timeout already set to Never"
Else
cmd = "%comspec% /c powercfg -change -monitor-timeout-ac 0" 'Never
Call wsh.Run(cmd,0,False)
If mins > 1 Then
prog.Text = "PowerConfig: Active plan is "&nam&"... Changed monitor timeout from "&mins&" minutes to Never"
Else
prog.Text = "PowerConfig: Active plan is "&nam&"... Changed monitor timeout from 1 minute to Never"
End If
End If
Else
prog.Text = "PowerConfig: Error - current monitor timeout setting not found"
End If
Call fso.DeleteFile(dat)
Else
prog.Text = "PowerConfig: Error - current monitor settings query failed"
End If
SDB.ProcessMessages
End Sub
Sub PlaybackEnd()
If SDB.isRunning Then
Dim Tmr : Set Tmr = SDB.CreateTimer(PlayTimeout)
If Not (Tmr Is Nothing) Then
Call Script.RegisterEvent(Tmr,"OnTimer","ResetValue")
Set SDB.Objects("PowerConfig") = SDB.NewSongData
End If
End If
End Sub
Sub Shutdown()
Dim mins : mins = SDB.IniFile.IntValue("PowerConfig","MonitorTimeoutAC")
If mins > -1 Then
SDB.IniFile.IntValue("PowerConfig","MonitorTimeoutAC") = -1
If mins > 0 Then
Call ResetCommand(mins)
End If
End If
End Sub
Sub ResetValue(Tmr)
Call Script.UnregisterEvents(Tmr)
If Not (SDB.Objects("PowerConfig") Is Nothing) Then
Dim mins : mins = SDB.IniFile.IntValue("PowerConfig","MonitorTimeoutAC")
If mins > -1 Then
SDB.IniFile.IntValue("PowerConfig","MonitorTimeoutAC") = -1
If mins > 0 Then
Call ResetCommand(mins)
Dim prog : Set prog = SDB.Progress
If mins > 1 Then
prog.Text = "PowerConfig: Restored monitor timeout to "&mins&" minutes"
Else
prog.Text = "PowerConfig: Restored monitor timeout to 1 minute"
End If
Set SDB.Objects("PowerConfigProg") = prog
SDB.ProcessMessages
Dim Tmr2 : Set Tmr2 = SDB.CreateTimer(ProgTimeout)
If Not (Tmr2 Is Nothing) Then
Call Script.RegisterEvent(Tmr2,"OnTimer","HideProgress")
End If
End If
End If
End If
End Sub
Sub ResetCommand(mins)
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim cmd : cmd = ""
If SDB.IniFile.StringValue("PowerConfig","Windows") = "XP" Then
Dim nam : nam = SDB.IniFile.StringValue("PowerConfig","Name")
cmd = "%comspec% /c powercfg -change "&Chr(34)&nam&Chr(34)&" -monitor-timeout-ac "&mins
Else
cmd = "%comspec% /c powercfg -change -monitor-timeout-ac "&mins
End If
Call wsh.Run(cmd,0,False)
End Sub
Sub HideProgress(Tmr)
Call Script.UnregisterEvents(Tmr)
Dim prog : Set prog = SDB.Objects("PowerConfigProg")
If Not (SDB.Objects("PowerConfigProg") Is Nothing) Then
Set SDB.Objects("PowerConfigProg") = Nothing
End If
End Sub
Function HexToDec(h)
HexToDec = 0
Dim i : i = 0
For i = Len(h) To 1 Step -1
Dim d : d = Mid(h,i,1)
d = Instr("0123456789ABCDEF",UCase(d))-1
If d >= 0 Then
HexToDec = HexToDec+(d*(16^(Len(h)-i)))
Else
HexToDec = 0
Exit For
End If
Next
End Function