Option Explicit wscript.echo "Spectral Automation Scripting v0620" & chr(10) ' ----------- ' Global Variables and Declairations ' ----------- CONST iNormalFocus = 1:CONST ForReading = 1:CONST ForWriting = 2 ' For (input) text file(s) handling DIM objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject") ' Object used to get command arguments, fetch working directory DIM WshShell: Set WshShell = WScript.CreateObject("WScript.Shell") ' These are to init the RC4 algorithm. They are global so that the 2 RC4 functions can ' share these arrays Dim sbox(255), key(255) DIM inputTxt, InputAccume DIM InputString, InputElements, StepSplitDelin, ElemSplitDelin, PromptDelin DIM InputStepSplit, InputElemSplit, PromptSplit 'become arrays after vbs Split? DIM StallMax, SuccessfulFocus, enctrig, i, j, StallCount, z DIM RunWhat, FocusTarget, DoWhatFirst, Intermission, DoWhatSecnd, PingForApp, GrindOnStart, WaitOnExit ' these are global so routines can get fncPathResolve outputs DIM strLeftOSlash DIM strRigtOSlash DIM strLeftOSpace DIM strRigtOSpace DIM strLeftArgSpace DIM strRigtArgSpace DIM LeftOSlash DIM RigtOSlash ' -------------- ' Init ' -------------- ' Command Line Arguments array DIM Args: Set Args = WScript.Arguments DIM NumArgs: NumArgs = Args.Count If NumArgs > 0 Then inputTxt = Args(0) Else wscript.echo "- no input was specified":wscript.quit WScript.Echo "Executed From: " & WshShell.CurrentDirectory WshShell.CurrentDirectory = fncHomePath 'HomePath is a function wscript.echo " Script Home: " & WshShell.CurrentDirectory wscript.echo "End Environment" & chr(10) PromptDelin = "!!" StepSplitDelin = vbCRLF ElemSplitDelin = "|" enctrig = "+" StallMax = 100 ' Number of times to try to focus an App before giving up '------------- ' Input File Read '------------- ' all input files are loaded into memory as arrays ' Read Input File InputString = GankFromFile(inputTxt) wscript.echo "Fetched Main Input" & chr(10) ' Look for additional (sub)input files that may be called by this input wscript.echo "Parsing Input for external Input Files to Fetch" PromptSplit = Split(InputString, PromptDelin) For z = LBound(PromptSplit) to UBound(PromptSplit) ' wscript.echo "Segment " & z & ":" & PromptSplit(z) If int(z / 2) = (z / 2) Then 'z is even InputAccume = InputAccume & PromptSplit(z) Else 'z is odd ' wscript.echo PromptDelin & " found" InputAccume = InputAccume & GankFromFile(PromptSplit(z)) End If Next InputStepSplit = Split(InputAccume, StepSplitDelin) InputAccume = "" wscript.echo "Prompt Pre-Processing Complete" & chr(10) ' -------- ' Assign values from arrays to the proper variables ' -------- For i = LBound(InputStepSplit) to UBound(InputStepSplit) wscript.Echo "Step " & i & ": " & InputStepSplit(i) InputElemSplit = Split(InputStepSplit(i), ElemSplitDelin) ' clear variables to remove prior steps potentially contaminating the current WaitOnExit = "" DoWhatSecnd = "" Intermission = "" DoWhatFirst = "" GrindOnStart = "" FocusTarget = "" PingForApp = "" RunWhat = "" ' load the current input step from array ' while it would be more efficent to use the array directly, it becomes a nightmare ' to debug if you decide to add/remove arguments or change their order DIM ei For ei = UBound(InputElemSplit) to LBound(InputElemSplit) Step -1 Select Case ei Case 7 WaitOnExit = InputElemSplit(ei) 'Have script wait x tics until app closes before next step Case 6 DoWhatSecnd = InputElemSplit(ei) 'more keystrokes if app needed time Case 5 Intermission = InputElemSplit(ei) 'pause to let app think if needed Case 4 DoWhatFirst = InputElemSplit(ei) 'keystrokes to send first Case 3 GrindOnStart = InputElemSplit(ei) 'pause to let app init Case 2 FocusTarget = InputElemSplit(ei) 'looking for this string in a window title Case 1 PingForApp = InputElemSplit(ei) 'how often look focus of that app by... Case 0 RunWhat = InputElemSplit(ei) 'path/filename of application to run End Select Next 'NOTE: be sure to handle missing or unspecified arguments PerformElements wscript.echo "Step " & i & " Completed" & chr(10) Next wscript.echo "Done" wscript.Quit ' ------------- ' Main ' ------------- Sub PerformElements DIM objShell: Set objShell = WScript.CreateObject("Wscript.Shell") SuccessfulFocus = False StallCount = StallMax If RunWhat = "" Then wscript.echo "No Run specified" Else PathResolve ' wscript.echo "Input :" & chr(10) & fncHomePath & strLeftOSpace 'check if Target exists to avoid non-existant file crash If objFSO.FileExists(fncHomePath & strLeftOSpace) Then ' wscript.echo "Target: " & chr(10) & fncHomePath & strLeftOSlash & strRigtOSlash ' wscript.echo "---" ' see if target is LNK, if yes return its target 'wscript.echo strLeftArgSpace & "><" & WshShell.CurrentDirectory & fncPathMasseuse(strRigtArgSpace,0) DIM LnkLook:LnkLook = fnIsLink(strLeftArgSpace,WshShell.CurrentDirectory & fncPathMasseuse(strRigtArgSpace,0)) '--------- ' Target Run '--------- ' launches targets ' targets that are windows shortcuts are a special case - the script will attempt to locate the ' intended target itself. The normal Run method will often fail with *.lnk's wshShell.CurrentDirectory = fncHomePath & strLeftOSlash 'wscript.echo "Run From: " & wshShell.CurrentDirectory If LnkLook = "" Then 'was not a lnk wscript.echo "NORRun: " & chr(34) & strLeftArgSpace & chr(34) & chr(34) & strRigtOSpace & chr(34) objShell.Run(chr(34) & strLeftArgSpace & chr(34) & chr(34) & strRigtOSpace & chr(34)),iNormalFocus,False 'Run file Else ' TODO: handle multiple command line arguments for lnks wscript.echo "LNKRun: " & chr(34) & LnkLook & chr(34) & " " & chr(34) & fncPathMasseuse(strRigtOSpace,4) & chr(34) objShell.Run(chr(34) & LnkLook & chr(34) & " " & fncPathMasseuse(strRigtOSpace,4)),iNormalFocus,False End If WshShell.CurrentDirectory = fncHomePath Else wscript.echo RunWhat & " NOT FOUND >FATAL< where are you sending keys ATM?" End If End If '------------------- ' SendKey Core '------------------- ' handles focusing a target window, and sending keys to them wscript.echo "---sendkeys---" If FocusTarget = "" Then wscript.echo "No focus specified" Else If PingForApp = "" Then PingForApp = 0 Do Until SuccessfulFocus = True SuccessfulFocus = objShell.AppActivate(FocusTarget) Wscript.Sleep PingForApp wscript.Echo "Attempt Focus of " & chr(34) & FocusTarget & chr(34) & " every " & PingForApp & " tics " & StallCount & " times." 'Avoid infinite loop of looking for a non-existant window title forever StallCount = StallCount - 1 If StallCount < 1 Then wscript.Echo "Could Not Focus " & chr(34) & FocusTarget & chr(34) & ". Tried " & StallMax & " Times Every " & PingForApp & " tics." wscript.Quit End If Loop End If If GrindOnStart = "" Then GrindOnStart = 0 If Intermission = "" Then Intermission = 0 wscript.echo "Waiting " & GrindOnStart & " tics for App init" Wscript.Sleep GrindOnStart wscript.echo "Sending First Sendkeys: " & DoWhatFirst objShell.Sendkeys DoWhatFirst wscript.echo "Waiting " & Intermission & " tics Intermission" Wscript.Sleep Intermission wscript.echo "Sending Secnd Sendkeys: " & DoWhatSecnd objShell.Sendkeys DoWhatSecnd If WaitOnExit = "" Then wscript.echo "No Wait Specified - Next Step" & chr(10) Else StallCount = WaitOnExit Do Until SuccessfulFocus = False SuccessfulFocus = objShell.AppActivate(FocusTarget) Wscript.Sleep PingForApp wscript.Echo "Will Wait on " & chr(34) & FocusTarget & chr(34) & " up to " & StallCount & " tics to close." 'Avoid infinite loop of looking for a non-existant window title forever StallCount = StallCount - 1 If StallCount < 1 Then wscript.Echo "Wait: " & chr(34) & FocusTarget & chr(34) & " took too long" wscript.Echo "Forcing Continue" & chr(10) SuccessfulFocus = False End If Loop End If End Sub '-------------------- ' Path Resolver '-------------------- ' A target and its path are a combination of the script's home directory and the path given ' from the input file. This allows running targets that are not in the current script's directory. ' Unfortunatly many functions do not like relative paths, and only accept the executable name. ' They will will only operate correctly if the target resides in the script's current directory. ' The workaround is to "spoof" the function. The script will temporarily change it's current ' directory to where the target resides before running the function. Then return back to the ' home directory. ' Path Resolver is how the script determines what current directory to change to. Additionally ' it has been (significantly rewritten) to allow passing command line arguments from input ' files - hopefully to eliminate the prior need to call a batch file just to pass arguments. '--- Sub PathResolve wscript.echo "---resolving path and arguments---" '---- ' Argument Space Resolution '---- ' When given a target, seperates path\program.ext from any arguments if present ' New "InchWorm" Algorithm 0406 ' It goes inch by inch, looking for what it seeks DIM LeftOSpace 'number of characters to the LEFT of the RIGHTMOST space DIM SFApointerA: SFApointerA = 1 'the start of the inch DIM Nextpointer: Nextpointer = InStr(Mid(RunWhat,SFApointerA,Len(RunWhat)-SFApointerA+1),".") 'how much to inch 'wscript.echo Len(RunWhat) 'wscript.echo Mid(RunWhat,SFApointerA,Len(RunWhat)-SFApointerA+1) & chr(10) Do Until Nextpointer < 1 ' if the next inch is off the leaf, don't Nextpointer = InStr(Mid(RunWhat,SFApointerA,Len(RunWhat)-SFApointerA+1),".") 'ignoring the current segment, what's next? SFApointerA = SFApointerA + Nextpointer 'the current end position is where the next range to check starts ' wscript.echo Nextpointer ' wscript.echo Mid(RunWhat,SFApointerA,Len(RunWhat)-SFApointerA+1) ' wscript.echo Mid(RunWhat,SFApointerA+3,1) If Mid(RunWhat,SFApointerA+3,1) = " " Then 'this is looking for file extentions in the pattern ".xxx " ' wscript.echo "Pattern Match" LeftOSpace = SFApointerA+2 Nextpointer = -1 End If ' wscript.echo SFApointerA Loop ' When the instr() functions doesn't find a match, it returns 0 ' for this script it means it reached the end of the path without finding a space ' thus implicitly everything is left of the "space" If LeftOSpace < 1 Then LeftOSpace = Len(RunWhat) DIM RigtOSpace: RigtOSpace = Len(RunWhat) - LeftOSpace 'number of characters to the RIGHT of the RIGHTMOST space '--- ' Path Slash Resolution '--- ' Seperates out the executable's and the path to it ' Is dependent on Space Resolution to be correct DIM RigtArgSpace: RigtArgSpace = InStrRev(Left(RunWhat,LeftOSpace), "\") 'number of characters to the LEFT of the RIGHTMOST SLASH - LEFT of the RIGHTMOST SPACE) DIM LeftArgSpace: LeftArgSpace = InStr(StrReverse(Left(RunWhat,LeftOSpace)), "\") 'number of characters to the RIGHT of the RIGHTMOST SLASH - LEFT of the RIGHTMOST SPACE) If LeftArgSpace < 1 Then LeftArgSpace = Len(Left(RunWhat,LeftOSpace)) Else LeftArgSpace = LeftArgSpace -1 ': wscript.echo "LeftArgSpace: -1" ' equivalants for older internal script code LeftOSlash = RigtArgSpace RigtOSlash = LeftArgSpace + RigtOSpace '---- ' Path Segment Strings '---- ' Outside routines should use these variables for their path needs strLeftOSlash = Left(RunWhat,LeftOSlash) strRigtOSlash = Right(RunWhat,RigtOSlash) strLeftOSpace = Left(RunWhat,LeftOSpace) strRigtOSpace = Right(Runwhat,RigtOSpace) strLeftArgSpace = Right(Left(RunWhat,LeftOSpace),LeftArgSpace) strRigtArgSpace = Left(Left(RunWhat,LeftOSpace),LeftOSpace - LeftArgSpace) wscript.echo "SP: " & fncHomePath & "[H]" & strLeftOSpace & "[" & LeftOSpace & "+" & RigtOSpace & "]" & strRigtOSpace wscript.echo "SL: " & fncHomePath & "[H]" & strLeftOSlash & "[" & LeftOSlash & "+" & RigtOSlash & "]" & strRigtOSlash wscript.echo "---" End Sub ' ------------------------ ' Determine Script Home Path ' ------------------------ Function fncHomePath DIM path: path = WScript.ScriptFullName ' Script filename fncHomePath = Left(path, InStrRev(path, "\")) End Function ' -------------- ' Fetches STEPS from an input text file ' -------------- Function GankFromFile(filespec) DIM enc ' toggle if file is encrypted or not If filespec = Replace(filespec,enctrig,"") Then enc = "" Else enc = fncHomePath & filespec 'wscript.echo enc DIM filespecGank: filespecGank = fncPathMasseuse(filespec,1) wscript.echo "Gank File: " & WshShell.CurrentDirectory & "[CD|FSG]" & filespecGank If objFSO.FileExists(filespecGank) Then wscript.echo filespec & " preexists - which is good" DIM objTextIn: set objTextIn = objFSO.OpenTextFile(filespecGank) DIM inpRead: inpRead = objTextIn.ReadAll objTextIn.Close Else wscript.echo filespec & " NOT FOUND - prompting user" inpRead = InputBox("An input text file was not found." & chr(13) & _ "You can attempt manually entering Sendkeys" & chr(13) & _ "to be used instead of " & filespec & chr(13) & _ "This is not error checked, so good luck." & chr(13) _ ,"Input File " & filespec & " Inaccessible") enc = "" wscript.echo inpRead & " was manually entered" End If If enc = "" Then ' GankFromFile = Replace(inpRead,vbCRLF,"") 'This would be needed if you DONT want a new line to be a new step GankFromFile = inpRead Else GankFromFile = EnDeCrypt(inpRead,enc) ' delete file to give illusion of security objFSO.DeleteFile(filespecGank), true End If End Function ' --------- ' Determine if a target is a LNK (a.k.a. shortcut) and returns that path if so ' based on code from ' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/folderitem/islink.asp ' --------- ' This is done since directly Running a windows shortcut often fails with the Run method ' it is nastily kludged from MSDN example code, sorry bout that function fnIsLink(toCheck,DirectoryWhereAt) 'wscript.echo "toCheck : " & toCheck 'wscript.echo "DirWhr@ : " & DirectoryWhereAt DIM bReturn: bReturn = "" DIM toCheckx : toCheckx = fncPathMasseuse(toCheck,2) DIM DirectoryWhereAtx : DirectoryWhereAtx = fncPathMasseuse(DirectoryWhereAt,3) 'wscript.echo "toCheckx : " & toCheckx 'wscript.echo "DirWhr@x : " & DirectoryWhereAtx dim objShell:set objShell = CreateObject("Shell.Application") if (not objShell is nothing) then dim objFolder2:set objFolder2 = objShell.NameSpace(DirectoryWhereAtx) if (not objFolder2 is nothing) then ' wscript.echo "objShell.NameSpace: " & objFolder2 dim objFolderItem:set objFolderItem = objFolder2.ParseName(toCheckx) if (not objFolderItem is nothing) then bReturn = objFolderItem.IsLink if bReturn = true then DIM objLink:set objLink = objFolderItem.GetLink bReturn = objLink.Path wscript.echo "target LNK to: " & bReturn fnIsLink = bReturn else wscript.echo "target not LNK" end if end if set objFolderItem = nothing end if set objFolder2 = nothing end if set objShell = nothing 'wscript.echo "bReturn: " & bReturn end function '------------ ' fncPathMasseuse ' (calls fncPassMassPerf as subFunction) '------------ ' This is an attempt to make a consistent but semi-elegant "path kludger" that ' is easy to modify. Execution wise it is horrible, but hopefully code wise ' it is easy for script maintainers to create custom path bending rules. ' Why? In the grand scheme of inconsistency, various VBScript functions expect ' functionally identical paths in symatically varying formats. In other words ' many VBScript functions are rather picky on how they want their paths. ' Things like leading spaces or slashes for relative paths - or the opposite ' where a path must NOT have a trailing slash or space. ' This function came about to try and centralize all of this "path hacking" ' throughout the script to one place to ease debugging. Function fncPathMasseuse(path,action) DIM pathFixed: pathFixed = path DIM perform DIM char Select Case action case 0 ' remove leading space, add leading "\" if not present pathFixed = fncPathMassPerf(pathFixed," ",4)' : wscript.echo pathFixed pathFixed = fncPathMassPerf(pathFixed,"\",0)' : wscript.echo pathFixed case 1 ' remove leading space, add leading ".\" if not present pathFixed = fncPathMassPerf(pathFixed," ",4)' : wscript.echo pathFixed pathFixed = fncPathMassPerf(pathFixed,"\",0)' : wscript.echo pathFixed pathFixed = fncPathMassPerf(pathFixed,".",0)' : wscript.echo pathFixed case 2 ' remove leading space, rem leading "\" if present pathFixed = fncPathMassPerf(pathFixed," ",4)' : wscript.echo pathFixed pathFixed = fncPathMassPerf(pathFixed,"\",4)' : wscript.echo pathFixed case 3 ' remove trailing "\" pathFixed = fncPathMassPerf(pathFixed,"\",6)' : wscript.echo pathFixed case 4 ' remove leading space pathFixed = fncPathMassPerf(pathFixed," ",4) case else ' wscript.echo "fncPathMasseuse: Unknown action " & action End Select 'wscript.echo "pathFixed: " & pathFixed fncPathMasseuse = pathFixed End Function '----- ' The Path Masseuse subFunction ' actually does the work '----- Function fncPathMassPerf(path,char,perform) DIM pathFixed: pathFixed = path Select Case perform case 0 ' add leading char if NOT present if NOT Left(pathFixed,1) = char Then pathFixed = char & pathFixed case 1 ' add leading char pathFixed = char & pathFixed case 2 ' add trailing char if NOT present if NOT Right(pathFixed,1) = char Then pathFixed = pathFixed & char case 3 ' add trailing char pathFixed = pathFixed & char case 4 ' delete leading char if present if Left(pathFixed,1) = char Then pathFixed = Right(pathFixed,len(pathFixed)-1) case 5 ' delete leading char pathFixed = Right(pathFixed,len(pathFixed)-1) case 6 ' delete trailing char if present if Right(pathFixed,1) = char Then pathFixed = Left(pathFixed,len(pathFixed)-1) case 7 ' delete trailing char pathFixed = Left(pathFixed,len(Fixed)-1) case else wscript.echo "fncPathMassPerf: Unknown perform " & perform End Select fncPathMassPerf = PathFixed End Function '------ ' End Masseuse '------ ' ------------------------- ' http://www.4guysfromrolla.com/webtech/code/rc4.inc.html ' This script performs 'RC4' Stream Encryption based on what is widely ' thought to be RSA's RC4 algorithm. It produces output streams that ' are identical to the commercial products ' ' This RC4 implementation is Copyright 1999 by Mike Shaffer ' ALL RIGHTS RESERVED WORLDWIDE Sub RC4Initialize(strPwd) ' This routine called by EnDeCrypt function. Initializes the ' sbox and the key array) dim intLength dim tempSwap dim a dim b intLength = len(strPwd) For a = 0 To 255 key(a) = asc(mid(strpwd, (a mod intLength)+1, 1)) sbox(a) = a Next b = 0 For a = 0 To 255 b = (b + sbox(a) + key(a)) Mod 256 tempSwap = sbox(a) sbox(a) = sbox(b) sbox(b) = tempSwap Next End Sub Function EnDeCrypt(plaintxt, psw) ' This routine does all the work. Call it both to ENcrypt ' and to DEcrypt your data. ' Dim sbox(255) ' Dim key(255) dim temp, a, i, j ,k dim cipherby, cipher i = 0 j = 0 RC4Initialize psw For a = 1 To Len(plaintxt) i = (i + 1) Mod 256 j = (j + sbox(i)) Mod 256 temp = sbox(i) sbox(i) = sbox(j) sbox(j) = temp k = sbox((sbox(i) + sbox(j)) Mod 256) cipherby = Asc(Mid(plaintxt, a, 1)) Xor k cipher = cipher & Chr(cipherby) Next EnDeCrypt = cipher End Function