Jump to content

JoeBubbles

Members
  • Posts

    2
  • Joined

  • Last visited

Everything posted by JoeBubbles

  1. Edugeek's attachment upload function seems to be broken. Here's the content of the attachment I tried to upload: '=============================================================================== ' ' Program : Slideshow.vbs ' Version : 1.0 ' Created : 7-Apr-2010 ' Author/s : Joe Bubbles ' ' Purpose : Drag and drop a PowerPoint slideshow onto this program icon, it ' will then launch the slideshow and emulate a keystroke at ' predetermined intervals to avoid the screensaver activating, thus ' by-passing the screensaver password protection (if enabled). ' '=============================================================================== Option Explicit Const Keypress_Interval = 10 '(seconds) CheckHost KeepBusy Slideshow '_______________________________________________________________________________ Function KeepBusy(Presentation) Dim objSHL, objEXE Const CommandLine = "cmd /C start ""Slideshow"" /realtime /wait " Set objSHL = CreateObject("WScript.Shell") Set objEXE = objSHL.Exec(CommandLine & """" & Presentation & """") DisplayHelp Do While objEXE.Status = 0 '(Still Running) objSHL.SendKeys "+" '(SHIFT, harmless during presentations) Wscript.Sleep Keypress_Interval * 1000 Loop End Function 'KeepBusy '_______________________________________________________________________________ Function Slideshow() Dim objArgs, t t = "" Set objArgs = WScript.Arguments If (objArgs.Count > 0) Then t = objArgs(0) Else WScript.Quit End If Slideshow = t End Function 'Slideshow '_______________________________________________________________________________ Sub CheckHost() Dim objSHL Const Q = """" Set objSHL = CreateObject("Wscript.Shell") If Not WScript.FullName = WScript.Path & "\cscript.exe" Then objSHL.Run "cmd /c " & WScript.Path & "\cscript.exe //NOLOGO " & _ Q & WScript.scriptFullName & Q & " " & Q & Slideshow & Q, _ 1, False WScript.Quit 0 End If End Sub 'CheckHost '_______________________________________________________________________________ Sub DisplayHelp() Dim t t = Slideshow t = Right(t, Len(t) - InStrRev(t, "\")) With WScript .Echo .Echo " This window will automatically close within " & _ Keypress_Interval & " seconds " .Echo " after you close """ & t & """." .Echo End With 'WScript End Sub 'DisplayHelp '_______________________________________________________________________________
  2. Download the attachment and rename it to *.vbs. I created a shortcut to this script on my desktop and named it "Slideshow Stay Awake". Simply drag-and-drop your presentation or slide show onto the shortcut, the script will do the rest. (It won't touch your screensaver or GPO settings at all.)
×
×
  • Create New...