ForceCScript True

'Constants
Const HKEY_LOCAL_MACHINE	= &H80000002
Const ForReading			= 1
Const ForWriting			= 2
Const ForAppending			= 8
Const RESUME_ON_ERROR		= True

'Variables
Script					= WScript.ScriptFullName
Script_Path				= Left(Script, InstrRev(Script, "\"))
CurrentDate				= Now
CurrentDay				= Date()
INPUT_FILE				= Script_Path & "automatePMT.txt"
MyDate					= FixedLength(Day(CurrentDay), 2, "0") & MonthName(Month(CurrentDay), True) & Year(CurrentDay)
PrintMigrator			= CHR(34) & Script_Path & "printmig.exe"
PMTOutput				= "C:\Documents and Settings\Lisa\My Documents\@SCRIPTING\automatePMT\"
Set oShell				= CreateObject("WScript.Shell")
'Debug values are:
'0=None
'1=Errors Only
'2=Successes Only
'3=Errors and Successes
'4=CompletescrDEBUG Information
'All other values treated as 0
scrDEBUG				= 3

'strSep is used to mark the beginning and end of a job's ouput
strSep					= String(50,"=")

If RESUME_ON_ERROR Then
	On Error Resume Next
End If

Set oWSH = CreateObject("WScript.Shell")
Set oWSHEnv = oWSH.Environment("PROCESS")
Set objFSO=CreateObject("Scripting.FileSystemObject")

LogFile = ExecutingFrom & "AutomatedDSC.Log"

If Err <> 0 Then
	LogBuffer Err.Number & ": " & Err.Description & " creating log. LogFile name = " & LogFile, scrDEBUG
	Err.Clear
End If

LogBuffer "Results will be logged to " & LogFile, scrDEBUG
LogBuffer "Debug is currently set to " & scrDEBUG, scrDEBUG

LogBuffer strSep,scrDEBUG
LogBuffer "Job Started:" & Now, scrDEBUG
LogBuffer strSep,scrDEBUG

LogAction "Processing Computer List ..."

ComputerList = Text2Array(INPUT_FILE)

ComputerCount = Ubound(ComputerList)

LogAction "Processed " & FixedLength(ComputerCount +1, 3, "0") & " entries..."

For each Computer in ComputerList

	 TheCommand = CHR(34) & PrintMigrator & CHR(34) & " -b " & CHR(34) & PMTOutput & Computer & "_" & MyDate & ".cab" & CHR(34) & " \\" & Computer
	 '~ printmig -b "\\filesrv\store\print server 2.cab" \\prt-srvr2

	 LogAction "Now Processing computer :" & Computer

	 Result = Run(TheCommand)

	 If Not Result = "" then
		  LogAction "	" & Result
	 End If

Next

LogBuffer strSep, scrDEBUG
LogBuffer "Job Completed:" & Now, scrDEBUG
LogBuffer strSep, scrDEBUG

PrintMsg "Completed", "Completed"

'>>>>>>>>>>>>>>>>>>>>>>>>>>>End Script

Function Run(sCmd)

   Const OpenAsDefault		= -2
   Const FailIfNotExist		=  0
   Const ForReading			=  1

   Set oShell = CreateObject("WScript.Shell")
   Set oFSO = CreateObject("Scripting.FileSystemObject")
   sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName

   oShell.Run "%comspec% /c " & sCmd & " >" & sTempFile & " 2>&1", 0, True

   If oFSO.GetFile(sTempFile).Size > 0 Then
	Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, _
		  FailIfNotExist, OpenAsDefault)

	Run = fFile.ReadAll
	fFile.Close
	oFSO.DeleteFile(sTempFile)
   Else
	Run = ""
   End If

End Function

Sub PrintMsg(byval strMessage, strTitle)
	'MsgBox ("Hello World!", 65, "MsgBox Example")
	Const vbOKOnly = 0
	MsgBox strMessage, vbOKOnly, strTitle
End Sub

Function EnumerateError(strCode, strDesc)

	strCode = "(0x" & Right(String(8,"0") & Hex(Err.Number),8) & ")"
	strDesc = Err.Description
	EnumerateError = strCode & " : " & strDesc
	Err.Clear

End Function

Function Text2Array(FileName)

	Const ForReading = 1

	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If Not objFSO.FileExists( FileName ) Then
		LogAction "File does not exist."
		DorkBox "File does not exist."
		WScript.Quit
	End If

	Set objTextFile = objFSO.OpenTextFile( FileName, ForReading )

	LineCount = 0
	' Check length of file, the old fashioned way
	Do Until objTextFile.AtEndOfStream
		strTemp = objTextFile.Readline
		LineCount = LineCount + 1
	Loop

	objTextFile.Close

	' Dimension arrays based on length of file
	' Can't dim an array using a const, so they must be ReDim
	Redim TempArray(LineCount-1)

	LineCount = 0

	' Read file and store result
	Set objTextFile = objFSO.OpenTextFile(FileName, ForReading)

	Do While Not objTextFile.AtEndOfStream
		strNextLine = objTextFile.Readline
		TempArray(LineCount) = strNextLine
		LineCount = LineCount + 1
	Loop

	Text2Array = TempArray

End Function

Sub ForceCScript(bForceRelance)

	If (right(UCase(Wscript.FullName),11)="WSCRIPT.EXE") and bForceRelance Then
		Dim WshShell,args,objArgs,I
		Set WshShell = CreateObject("WScript.Shell")
		args=""
	If WScript.Arguments.Count > 0 Then
		Set objArgs = WScript.Arguments
		For I = 0 To objArgs.Count - 1
		args = args & " " & objArgs(I)
		Next
	End If
		WshShell.Run WshShell.ExpandEnvironmentStrings("%COMSPEC%") & " /C CScript.exe """ & WScript.ScriptFullName & """" & args,1,False
		Set WshShell = Nothing
		Wscript.Quit
	End If

End Sub

Sub LogAction (strEntry)

	Dim strErrMsg, f

	On Error Resume Next

	wscript.echo strEntry

	set f = objFSO.OpenTextFile(LogFile, ForAppending, True, -2)
	f.WriteLine "[ " & Now & " ] - " & strEntry
	f.close

	On Error Goto 0

End Sub

Sub LogBuffer(strLogEntry,strPriority)

	Select Case scrDEBUG
		Case 1
			If strPriority=1 Then
			LogAction strLogEntry
		End If
		Case 2
			If strPriority=2 Then
			LogAction strLogEntry
		End If
		Case 3
			If (strPriority >= 1) AND (strPriority <= 3) Then
			LogAction strLogEntry
		End If
		Case 4
			If (strPriority>=1) AND (strPriority<=4) Then
			LogAction strLogEntry
		End If
		Case Else
	End Select

End Sub

Function ExecutingFrom()

	Dim strScriptPath

	LogBuffer "Entering Function 'ExecutingFrom'", 4

	strScriptPath=Left(wscript.scriptfullname, _
	Len(wscript.scriptfullname)-Len(wscript.scriptname))

	If Right(strScriptPath,1) <> "\" Then
		strScriptPath=strScriptPath & "\"
	End If

	ExecutingFrom=strScriptPath

	LogBuffer  "ExecutingFrom =" & ExecutingFrom, 4

	LogBuffer "Leaving Function 'ExecutingFrom'.", 4

End Function

Function WriteOut(Text)

	Set StdOut = WScript.StdOut
	StdOut.WriteLine Text

End Function

Function FixedLength(strName, numStrLength, strFillChar)

	strActualLength = Len(strName)

	if strActualLength < numStrLength then

		strLengthDiff = numStrLength - strActualLength

		tmpString = String(strLengthDiff, strFillChar) & strName

	Else

		tmpString = Mid(strName, 1, numStrLength)

	End If

	FixedLength = tmpString

End Function

Function DorkBox(Text)

	Title = "DorkBox - Remove after T/S"
	MsgBox Text, vbInformation + vbOKOnly, Title

End Functiontion