Visual Basic

(Updated: 2019-09-06)

Option Explicit
Const ADS_SCOPE_SUBTREE = 2
Dim strLogFile, LOG_FILE_NAME
'Will log progresion of the script against computers.
LOG_FILE_NAME = GetScriptPath() & "results.Log"
'Nothing is needed in LogItem sub to initialize this variable.
Set strLogFile = Nothing

RenameLAdmin
Function RenameLAdmin()
  
  Dim objShell, arrComputer, intI, intPC
  Dim strPwdFile, strCurrentMonth, strMsg, strPCType, strDomain, strList
  Dim strNewPassword, strTotalCMD, strCmdStart, strCmdEnd, strLDAP

  strMsg = "Type a complexe password using 3 of 4 characters type." & VbCrLf _
       & "Your password must not contain a part of remote " & VbCrLf _
       & "PC name or word admin, administrator or any variant " & VbCrLf _
       & "of these two words. Must not contain part of user " & VbCrLf _
       & "currently logged on to the remote PC."
       
  LogItem "Starting change Local Administrator Passwords today on " & Now()
  LogItem "-----------------------------------------------------------------"
  LogItem "Text file hosting password is " & strPwdFile
  
  strPwdFile = GetScriptPath() & "Password.pwd"
  LogItem "Retrieve domain name"
  strDomain = GetDomainDN()
  LogItem "Text file hosting progress log of this script is " & LOG_FILE_NAME
  strCurrentMonth = MonthName(Month(Date), False)
  LogItem "Current month name is " & strCurrentMonth
  'Read password from a file based on current month.
  ''strNewPassword = ReadPwdFile(strPwdFile, strCurrentMonth)
  'Ask user to choose a complexe password via inputbox.
  strNewPassword = InputBox(strMsg, "Enter a complexe password", "D@/$th_m0%l")
  LogItem "New password for all local admin will be this month " & strNewPassword
  'Parameters for RenameAdmin are case sensitive. Ex: --(C)omputer. C of 
  'Computer is uppercase as well as P of Pwd, E of Encrypted, NL of NoLog
  'and Q of Quiet.
  strCmdStart = GetScriptPath() & "RenameAdmin.exe --Computer "
  strCmdEnd = " --Pwd " & strNewPassword & " --Encrypted --NoLog --Quiet"
  LogItem "Retrieving list of online computer through Netview2 function"
  arrComputer = Split(GetOnLinePCList(), ",")
  
  strPCType = "On which PC Roles do you want to change local admin password?" & VbCrLf & VbCrLf _
        & " 1 = All" & VbCrLf _
        & " 2 = DCs" & VbCrLf _
        & " 3 = Servers" & VbCrLf _
        & " 4 = Workstations" & VbCrLf _
        & " 5 = One specific PC"
        
  intPC = InputBox(strPCType, "Which type of PC to run this script", "4")
  
  LogItem "Build the LDAP query based on user choice."
  Select Case intPC
    Case "1"
      'Will take all content in arrComputer.
    Case "2"
      'Build the LDAP string to retrieve only DCs.
      strLDAP ="<LDAP://CN=Configuration," & strDomain & ">;(objectCategory=nTDSDSA);name,distinguishedName;subtree"      
      strList = ExtractPCType(strLDAP)
    Case "3"
      'Build the LDAP string to retrieve only servers.
      strLDAP = "<LDAP://" & strDomain & ">;(&(objectCategory=computer)(operatingSystem=*Server*));name,distinguishedName;subtree"
      strList = ExtractPCType(strLDAP)
    Case "4"
      'Build the LDAP string to retrieve only workstations.
      strLDAP = "<LDAP://" & strDomain & ">;(&(objectCategory=computer)(operatingSystem=*Professionnal*));name,distinguishedName;subtree"
      strList = ExtractPCType(strLDAP)
    Case "5"
      strList = InputBox("Type the PC name you want to change local administrator password", "One PC Name", "PC0001")
  End Select
  
  Set objShell = CreateObject("WScript.Shell")
  'Run the utility RenameAdmin with parameters against each online PC.
  For intI = 0 To UBound(arrComputer)
    'Verify if online computer is in strList based on choice user.
    If InStr(UCase(strList), UCase(arrComputer(intI))) Then
      strTotalCMD = strCmdStart & arrComputer(intI) & strCmdEnd
      objShell.Run "%comspec% /c " & strTotalCMD
      LogItem "Local Administrator Password has been change on computer " & arrComputer(intI)
    End If
  Next
  LogItem "-----------------------------------------------------------------"
  LogItem "Finished to change password for all local admin at " & Now()
  WScript.Quit
End Function

Function GetOnLinePCList()
On Error Resume Next
  Dim objFSO, objShell, objNetView, strNetView
  Dim intI, strPCName, strTempFile
  
  intI = 0
  strTempFile = GetScriptPath & "netview.tmp"
  LogItem "Working temporary file is " & strTempFile
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objShell = CreateObject("WScript.Shell")
  
  If objFSO.FileExists(strTempFile) Then
    objFSO.DeleteFile strTempFile
    LogItem "Deleting previous temporary working file"
  End If
  objShell.Run "%comspec% /c net view > " & Chr(34) & strTempFile & Chr(34)
  LogItem "Running Net View command and store list of online pc in " & strTempFile
  'Make script wait few seconds to let time opening the temp file.
  WScript.Sleep 5000
  If Err.Number = 0 Then
      Set objNetView = objFSO.OpenTextFile(strTempFile, 1)
    LogItem "Opening temporary working file " & strTempFile
    Do Until objNetView.AtEndOfStream
      strPCName = objNetView.ReadLine
      'Look to find line with two backslash. Each line starting
      'with \\ contain a pc name.
      If InStr(strPCName, "\\") Then
        strPCName = Trim(Replace(strPCName, "\\", ""))
        If intI = 0 Then
          strNetView = strPCName
        Else
          strNetView = strNetView & "," & strPCName
        End If
        LogItem "Found PC name " & strPCName
      End If
      intI = intI + 1
    Loop
    objNetView.Close
    'Delete the working temporary file.
    objFSO.DeleteFile strTempFile
    LogItem "Deleting working temporary file " & strTempFile
    GetOnLinePCList = strNetView  'Return the pc list that are online.
    Exit Function
  End If
  On Error GoTo 0
End Function

Function GetScriptPath()
  GetScriptPath = MID(WScript.ScriptFullName, 1, InstrRev(Wscript.ScriptFullName,"\"))
End Function

Function ReadPwdFile(strSource, strMonth)
On Error Resume Next
  Dim objFSO, objFile, strFile, strNewPWD
  
  'Instantiate file system object, verify if file exist and if yes
  'open this file.
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  If objFSO.FileExists(strSource) Then
    Set objFile = objFSO.OpenTextFile(strSource, 1)
    LogItem "Opening text file containing password list " & strSource
  End If
  'Loop through each line of password text file.
  Do Until objFile.AtEndOfStream
    strFile = objFile.ReadLine  'read one line at a time.
    'Verify if month in current line match value in strNextMonth 
    If InStr(strFile, strMonth) Then
      'Retrieve the password for next month after the equal sign (=).
      strNewPWD = Mid(strFile, InStrRev(strFile, "=") + 1)
      LogItem "Found new password for current month. It is " & strNewPWD
      ReadPwdFile = strNewPWD
      objFile.close
      Set objFSO = Nothing
      Exit Function
    End If
  Loop
  On Error GoTo 0
End Function

Sub LogItem(strItem)
'If there is an error, continue executing
On Error Resume Next
  'Check to see if log exists if not create it (or die trying)
  If strLogFile Is Nothing Then
    Dim objFSO
    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
    Set strLogFile = objFSO.CreateTextFile(LOG_FILE_NAME, True)
    If Err.Number <> 0 Then
      WScript.Echo "Error! - Could not create " & strLogFileName & "!"
      WScript.Echo "Error Number: " & Err.Number
      WScript.Echo "Description: " & Err.Description
      WScript.Quit Err.Number
    End If
  End If
  'If the script made it this far the log file is fine
  'so we'll write our item to the Log
  strLogFile.WriteLine strItem
  On Error GoTo 0
End Sub

Function GetDomainDN()
On Error Resume Next
  Dim objRoot, objDomain, strTemp
  
  ' Connect to domain and retrieve distinguish name.
  LogItem "Try to connect to domain through LDAP to retrieve FQDN of this domain From GetDomainDN"
  Set objRoot = GetObject("LDAP://RootDSE") 
  Set objDomain = GetObject("LDAP://" & objRoot.Get("DefaultNamingContext")) 
  If Err.Number <> 0 Then
    LogItem "Failed connecting to domain through LDAP to retrieve FQDN of this domain From GetDomainDN"
    GetDomainDN = "N/A"
    Err.Clear
  Else  'If connected, suppress suffix LDAP:// and keep only DC=Domain,DC=Com
    strTemp = Mid(objDomain.ADsPath,8)
    GetDomainDN = strTemp
    LogItem "Successfully connected to domain " & strTemp & " From GetDomainDN"
  End If
  On Error GoTo 0
End Function

Function ExtractPCType(strQuery)
On Error Resume Next
  Dim arrDC, arrDCName, intI, strPC
  Dim objEnumConnection, objEnumCommand, objEnumRecordSet
  
  intI = 0
  LogItem "Creating object ADODB.Connection From ExtractPCType"
  Set objEnumConnection = CreateObject("ADODB.Connection")
  If Err.Number <> 0 Then
    LogItem "Failed Creating object ADODB.Connection From ExtractPCType"
    Err.Clear
  End If
  On Error GoTo 0
  LogItem "Creating object ADODB.Command From ExtractPCType"
  Set objEnumCommand = CreateObject("ADODB.Command")
  If Err.Number <> 0 Then
    LogItem "Failed Creating object ADODB.Command From ExtractPCType"
    Err.Clear
  End If
  On Error GoTo 0
  LogItem "Assign Provider ADsDSOObject From ExtractPCType"
  objEnumConnection.Provider = "ADsDSOObject"
  If Err.Number <> 0 Then
    LogItem "Failed assigning Provider ADsDSOObject From ExtractPCType"
    Err.Clear
  End If
  On Error GoTo 0
  LogItem "Opening Active Directory Provider From ExtractPCType"
  objEnumConnection.Open "Active Directory Provider"
  If Err.Number <<> 0 Then
    LogItem "Failed Opening Active Directory Provider From ExtractPCType"
    Err.Clear
  End If
  On Error GoTo 0
  Set objEnumCommand.ActiveConnection = objEnumConnection
  objEnumCommand.CommandText = strQuery
  objEnumCommand.Properties("Page Size") = 80000
  objEnumCommand.Properties("Timeout") = 30 
  objEnumCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
  objEnumCommand.Properties("Cache Results") = False 
  On Error Resume Next
  LogItem "Executing ADODB command From ExtractPCType"
  Set objEnumRecordSet = objEnumCommand.Execute
  If Err.Number <> 0 Then
    LogItem "Failed Executing ADODB command From ExtractPCType"
    Err.Clear
  End If
  On Error GoTo 0
  objEnumRecordSet.MoveFirst
  'Retrieve info for current server name and look if this is a DC or not.
  Do Until objEnumRecordSet.EOF
    arrDC = Split(objEnumRecordSet.Fields("distinguishedName").Value, ",", -1, 1)
    arrDCName = Split(arrDC(1), "=", -1, 1)
    'Look for DCs.
    If InStr(strQuery, "nTDSDSA") Then
      If intI = 0 Then
        strPC = arrDCName(1)
      Else
        strPC = strPC & "," & arrDCName(1)
      End If
    End If
    'Look for Servers.
    If InStr(strQuery, "*Server*") Then
      If intI = 0 Then
        strPC = objEnumRecordSet.Fields("Name").Value
      Else
        strPC = strPC  & "," & objEnumRecordSet.Fields("Name").Value
      End If
    End If
    'Look for Workstations.
    If InStr(strQuery, "*Professional*") Then
      If intI = 0 Then
        strPC = objEnumRecordSet.Fields("Name").Value
      Else
        strPC = strPC & "," & objEnumRecordSet.Fields("Name").Value
      End If
    End If
    intI = intI + 1
    objEnumRecordSet.MoveNext
  Loop
  
  ExtractPCType = strPC
  
  Set objEnumConnection = Nothing
  Set objEnumCommand = Nothing
  Set objEnumRecordSet = Nothing
End Function

Option Explicit
On Error Resume Next

'***********************************************************************
' Arrays - Globally defined arrays.
'***********************************************************************

Dim arrServers
Dim arrEVTfiles

'***********************************************************************
' Variables - Globally defined variables.
'***********************************************************************

Dim WshShell, WshNetwork, objFSO, objArgs

Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim dtmThisDay
Dim dtmThisMonth
Dim dtmThisYear
Dim strToday
Dim strNameSpace
Dim strEvtMsg
Dim strNode
Dim strEVTname
Dim strBackupName
Dim strComputer
Dim strTempDisk
Dim intFatalCount : intFatalCount = 0
Dim intWarnCount : intWarnCount = 0
Dim intSuccessCount : intSuccessCount = 0
Dim bouBailOut : bouBailOut = FALSE
Dim bouSkipNode : bouSkipNode = FALSE
Dim strSuccess
Dim strFailure
Dim strThisScript
Dim intResult

'***********************************************************************
' Main Program
'***********************************************************************

Call GetBaseInfo()

intResult = FindNBind()

intResult = GetDomServers()  'Line 50

For Each strNode in arrServers

bouSkipNode = FALSE
If Not bouSkipNode Then GetLogTypes(strNode)

If Not bouSkipNode Then
  For Each strEVTname in arrEVTfiles
    If Not bouSkipNode Then
      intResult = EVTstuff(strNode, strEVTname, "clear")
    End If
  Next
End If

Next

'***********************************************************************
' Sub GetBaseInfo() - Collect some baseline info into global variables.
'***********************************************************************

Sub GetBaseInfo()

On Error Resume Next
strComputer = LCase(WshNetwork.ComputerName)
strThisScript = WScript.ScriptName
dtmThisDay = Day(Now)
dtmThisMonth = Month(Now)
dtmThisYear = Year(Now)
strToday = dtmThisYear & " " &_
dtmThisMonth & " " &_
dtmThisDay

End Sub

'***********************************************************************
' Function FindNBind() - Get LDAP Active Directory Provider Namespace
' at the domain level.
'***********************************************************************

Function FindNBind()

On Error Resume Next
Dim objBaseLDAP, strErrDesc
FindNBind = TRUE
Set objBaseLDAP = GetObject("LDAP://RootDSE")
Err.Clear
strNameSpace = objBaseLDAP.get("DefaultNamingContext")
End Function

'****************************************************************** Line 100
' Function GetDomServers() - Get the names of all domain DC and member
' servers into a data array.
'***********************************************************************

Function GetDomServers()

On Error Resume Next
Dim objConnection, objCommand, objRecordSet, strQuery1
Dim intSvrCount : intSvrCount = 0

GetDomServers = TRUE
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
strQuery1 = "<LDAP://" & strNameSpace & ">;" &_
"(&(objectCategory=Computer)(operatingSystem=*Server*));" &_
"Name;subtree"
objCommand.CommandText = strQuery1
Err.Clear
Set objRecordSet = objCommand.Execute
ReDim arrServers(objRecordSet.RecordCount - 1)
While Not objRecordSet.EOF
  arrServers(intSvrCount) = objRecordSet.Fields("Name")
  intSvrCount = intSvrCount + 1
  objRecordSet.MoveNext
Wend
objConnection.Close
End Function

'***********************************************************************
' Function GetLogTypes() - Use WMI to get names of all event logs on
' one server. Server name must be passed in.
'***********************************************************************

Function GetLogTypes(strSrvName)
On Error Resume Next
GetLogTypes = TRUE
Dim objWMIService, objInstalledLogFiles, objLogfile, intEvtCount
Dim strQuery1, strQuery2, strErrDesc
intEvtCount = 0
strQuery1 = "winmgmts:{impersonationLevel=impersonate}!\\" &_
strSrvName & "\root\cimv2"
Set objWMIService = GetObject(strQuery1)
strQuery2 = "Select * from Win32_NTEventLogFile"
Err.Clear
Set objInstalledLogFiles = objWMIService.ExecQuery (strQuery2)
If Err.Number <> 0 Then
  strErrDesc = Err.Description
  GetLogTypes = FALSE   ' Line 150
  bouSkipNode = TRUE
  bouBailOut = FALSE
  Exit Function
End If
arrEVTfiles(intEvtCount) = objLogfile.LogFileName
intEvtCount = intEvtCount + 1
End Function

'***********************************************************************
' Function EVTstuff() - Backup or clear one event log.
'***********************************************************************

Function EVTstuff(strSrvName, strEVTtype, strFunction)
On Error Resume Next
Dim LogFileSet, objLogfile, strQuery1, strQuery2
EVTstuff = TRUE
For Each objLogfile in LogFileSet
  objLogFile.ClearEventLog()
  EVTstuff = TRUE
Next
End Function

' Convert Html Files To DOC using VBS

option explicit
'Just change these two lines
Const HTMLFileIn="C:My Documentsookmark.htm" 'could be using http
Const DocFileOut="d:vbsewfile.doc"

Dim MyWord
Dim oIE

set MyWord=CreateObject("Word.Document") 
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Navigate HTMLFileIn
Attend
oIE.document.body.createTextRange.execCommand("Copy")
Attend
MyWord.Content.Paste
MyWord.SaveAs DocFileOut
MyWord.Close
oIE.Quit

Set oIE=Nothing
set MyWord=Nothing 

msgbox HTMLFileIn & " is now saved as " & DocFileOut

Sub Attend
  Wscript.Sleep 500
  While oIE.busy
    Wscript.Sleep 1000
  Wend
  While oIE.Document.readyState  "complete"
    Wscript.Sleep 1000
  Wend
End Sub

resultspath = BrowseForFolderDialogBox
resultsfile = resultspath & "ServerOverview" & varYear & varMonth & varDay & ".html" 

Option Explicit
Dim objPrinter
Set objPrinter = CreateObject("WScript.Network") 
objPrinter.SetDefaultPrinter "\\pharmacy\DYMO450"

'defrag_all2.vbs
'Defrags all hard disks - Can be run as a Scheduled Task
'Modified to create an error log and display it

Option Explicit

Dim WshShell, fso, d, dc, ErrStr(), Return, X, A(), MyFile, I, MyBox, Drive

Set WshShell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
X = 0

Set dc = fso.Drives
For Each d in DC 
  If d.DriveType = 2 Then
      X = X + 1

    'Determine drive letter of first fixed disk
    'This is the drive that the error report will be placed on
    If X = 1 Then
      Drive = d
    End If
  End If
Next

ReDim A(X)
ReDim ErrStr(X)

X = 0
For Each d in dc
  If d.DriveType = 2 Then
          X = X + 1
          Return = WshShell.Run("defrag " & d & " -f", 1, TRUE)

    'Determine the Error code returned by Defrag for the current drive and save it
    If return = 0 then
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag completed successfully" & vbCRLF
    elseif return = 1 then
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag aborted with error level " & return & " (defrag was cancelled manually) " & vbCRLF
    elseif return = 2 then
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag aborted with error level " & return & " (there was a command line error. Check your command line for valid switches and drives)" & vbCRLF
    elseif return = 3 then
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag aborted with error level " & return & " (there was an unknown error)" & vbCRLF
    elseif return = 4 then
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag aborted with error level " & return & " (defrag could not run due to insufficient memory resources)" & vbCRLF
      'errorlevel 5 is not currently used
    elseif return = 5 then
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag aborted with error level " & return & " (general error)" & vbCRLF
    elseif return = 6 then
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag aborted with error level " & return & " (System error: either the account used to run defrag is not an administrator, there is a problem loading the resource DLL, or a defrag engine could not be accessed. Check for proper user permissions and run Sfc.exe to validate system files)" & vbCRLF
    elseif return = 7 then
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag aborted with error level " & return & " (There is not enough free space on the drive. Defrag needs 15% free space to run on a volume)" & vbCRLF
    else
        ErrStr(x) = ErrStr(x) &  "Drive " & d & " Defrag aborted with an unknown error level: " & return & vbCRLF
    end if

       End If
Next

'Create the Error Report in the root of the first fixed disk.
Set MyFile = fso.OpenTextFile(Drive & "\defragreport.txt", 2, True)
MyFile.WriteLine(Date) & vbCRLF
MyFile.WriteLine(Time) & vbCRLF
For I = 1 to X
  MyFile.WriteLine(ErrStr(I))
Next
MyFile.Close

'Do Not open report by default
'Return = WshShell.Run(Drive & "\defragreport.txt",3,True)

Set WshShell = Nothing
Set fso = Nothing

Dim fso, f, f1, fc, s, folderspec, diff
folderspec = "c:\temp" 'Change folder path here
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each fl in fc
  diff = date - fl.datelastmodified
  if diff > 15 then
    wscript.echo fl.name & "    deleted"
    fl.delete
  end if
Next

' COLLECTS LAST 24HRS WORTH OF EVENTS AND SAVES IT IN AN HTML FILE 
' INITIALISE DATE VARIABLES TO COMPILE DATE AND TIME IN CORRECT FORMAT FOR COMPARISON 

varYear = Year(now) 
varMonth = Month(now) 
varDay = Day(now) 
if varDay = 1 then 
varMonth1 = Month(now) -1 
else 
varmonth1 = Month(now) 
end if 
if varDay = 1 then 
varYesterday = Day(last) 
else 
varYesterday = Day(now) -1 
end if 
varHour = Hour(now) 
varMins = Minute(now) 
varSecs = Second(now) 
varWarning = "warning" 
varError = "error" 
Dim varServerArray 
a = 0 
Dim strComputer 
strComputer = "." 
'ARRAY TO POPULATE WITH THE SERVERS OR WORKSATIONS IN YOUR DOMAIN 
varServerArray = Array("WorksationName","ServerName") 
'MsgBox varServerArray(a) 
'APPEND 0 TO DAYS AND MONTHS UNDER 10 TO MAINTAIN CORRECT FORMAT FOR COMPARISON 
If varSecs < 10 Then 
varSecs = "0" & varSecs 
End If 
If varMins < 10 Then 
varMins = "0" & varMins 
End If 
If varHour < 10 Then 
varHour = "0" & varHour 
End If 
If varDay < 10 Then 
varDay = "0" & varDay 
End If 
If varMonth < 10 Then 
varMonth = "0" & varMonth 
End If 
If varMonth1 < 10 Then 
varMonth1 = "0" & varMonth1 
End If 
If varYesterday < 10 Then 
varYesterday = "0" & varYesterday 
End If 
'Concatanate the date fields 
dtmStartDate = varYear & varMonth1 & varYesterday & varHour & varMins & "00" & ".000000-240" 
dtmEndDate = varYear & varMonth & varDay & varHour & varMins & "00" & ".000000-240" 
'This is where the file will be saved 
resultsfile = "C:\" & varYear & varMonth & varDay & " event log error" & ".html" 
msgbox resultsfile 
'Function to create a readable Date time 
Function WMIDateStringToDate(dtmDate) 
WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _ 
Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _ 
& " " & Mid (dtmDate, 9, 2) & ":" & _ 
Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate, _ 
13, 2)) 
End Function 

'Creates html file 
Set fs = WScript.CreateObject("Scripting.FileSystemObject") 
Set objDocument = fs.CreateTextFile(resultsfile, True) 
objDocument.Writeline ("<html>") 
objDocument.Writeline ("<table BORDER=0 width=100% cellspacing=0 cellpadding=3>") 
objDocument.Writeline ("<tr>") 
objDocument.Writeline ("<th bgcolor=#000080 colspan=6 width=400>") 
objDocument.Writeline ("<p align=center>") 
objDocument.Writeline ("<b><font face=Verdana size=2 color=#FFFFFF>Event Log Errors and Warnings in the last 24Hrs</font></b></p>") 
objDocument.Writeline ("</th>") 
objDocument.Writeline ("</tr>") 
objDocument.Writeline ("<tr>") 
objDocument.Writeline ("<th bgcolor=#C0C0C0 width=60><font face=Verdana color=#000080 size=1>Computer Name</font></th>") 
objDocument.Writeline ("<th bgcolor=#C0C0C0 width=100><font face=Verdana color=#000080 size=1>Event Code/Log</font></th>") 
objDocument.Writeline ("<th bgcolor=#C0C0C0 width=60><font face=Verdana color=#000080 size=1>Source Name</font></th>") 
objDocument.Writeline ("<th bgcolor=#C0C0C0 width=60><font face=Verdana color=#000080 size=1>Time Written</font></th>") 
objDocument.Writeline ("<th bgcolor=#C0C0C0 width=60><font face=Verdana color=#000080 size=1>Type</font></th>") 
objDocument.Writeline ("<th bgcolor=#C0C0C0 width=60><font face=Verdana color=#000080 size=1>Message</font></th>") 
objDocument.Writeline ("</tr>") 
'For each counter in varServerArray 
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 'varServerArray(a) 
Set colLoggedEvents = objWMIService.ExecQuery ("Select * from Win32_NTLogEvent Where TimeWritten >= '" & dtmStartDate & "' and TimeWritten <= '" & dtmEndDate & "' and Type = '" & varError & "'") 
Set colLoggedEvents1 = objWMIService.ExecQuery ("Select * from Win32_NTLogEvent Where TimeWritten >= '" & dtmStartDate & "' and TimeWritten <= '" & dtmEndDate & "' and Type = '" & varWarning & "'") 

For Each objEvent in colLoggedEvents 
objDocument.Writeline ("<TR>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.ComputerName & "</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.EventCode & " / " & objEvent.LogFile &"</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.SourceName & "</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & WMIDateStringToDate(objEvent.TimeGenerated) & "</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.Type & "</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.Message & "</font></TD>") 
objDocument.Writeline ("</TR>") 

Next 
For Each objEvent in colLoggedEvents1 
objDocument.Writeline ("<TR>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.ComputerName & "</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.EventCode & " / " & objEvent.LogFile &"</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.SourceName & "</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & WMIDateStringToDate(objEvent.TimeGenerated) & "</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.Type & "</font></TD>") 
objDocument.Writeline ("<TD><font face=Verdana color=#000080 size=1> " & objEvent.Message & "</font></TD>") 
objDocument.Writeline ("</TR>") 
Next 
a = a + 1 ' THIS IS THE ARRAY INCREMENTOR 
'Next 
MsgBox "Eventlog dump complete" 

On Error Resume Next
strComputer = InputBox("Please enter the computer to find:")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_BIOS",,48)
For Each objItem In colItems
  MsgBox strComputer & " has Dell Service Tag " & objItem.SerialNumber
Next

Option Explicit
Dim IP_Address : IP_Address = GetIP()

If IP_Address = "0.0.0.0" OR IP_Address = "" Then
  MsgBox "No IP Address found."
Else
  InputBox vbcrlf & "Current IP Address is " &  IP_Address & _
           vbcrlf & vbcrlf & vbcrlf & vbcrlf & _
           "(Use Ctrl + C to copy IP Address to Clipboard)", _
           "GetIPaddr.vbs © Bill James", IP_Address
End If

Function GetIP()
  Dim ws : Set ws = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
  Dim ThisLine, IP
  If ws.Environment("SYSTEM")("OS") = "" Then
    ws.run "winipcfg /batch " & TmpFile, 0, True
  Else
    ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
  End If
  With fso.GetFile(TmpFile).OpenAsTextStream
    Do While NOT .AtEndOfStream
      ThisLine = .ReadLine
      If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
    Loop
    .Close
  End With
  'WinXP (NT? 2K?) leaves a carriage return at the end of line
  If IP <> "" Then
    If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
  End If
  GetIP = IP
  fso.GetFile(TmpFile).Delete  
  Set fso = Nothing
  Set ws = Nothing
End Function

Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
strArticleNumber = InputBox("What is the article number?")
If strArticleNumber = "" Then WScript.quit
objExplorer.Navigate "http://support.microsoft.com/default.aspx?scid=kb;en-us;" & strArticleNumber
objExplorer.ToolBar = 1
objExplorer.Addressbar = 1
objExplorer.StatusBar = 0
objExplorer.Width=1000
objExplorer.Height = 800 
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Visible = 1

Dim oShell
Dim CommandToRun

Set oShell = WScript.CreateObject ("WScript.Shell")
CommandToRun = "%comspec% /k reg query HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM | find " & chr(34) & "REG_SZ" & chr(34)

oShell.run (CommandToRun)
Set oShell = Nothing

Dim oNetwork
Set oNetwork = CreateObject("WScript.Network")

Dim sLocal
sLocal = oNetwork.ComputerName

Dim oFSO, oTS
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTS = oFSO.CreateTextFile("C:\" & sLocal & ".txt")
 
On Error Resume Next
Dim strComputer
Dim objWMIService
Dim colItems

oTS.WriteLine
oTS.WriteLine "INSTALLED HOTFIXES"
oTS.WriteLine

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_QuickFixEngineering",,48)
For Each objItem in colItems
 oTS.WriteLine "HotFixID: " & objItem.HotFixID
 oTS.WriteLine "ServicePackInEffect: " & objItem.ServicePackInEffect
 oTS.WriteLine "Status: " & objItem.Status
 oTS.WriteLine
Next

oTS.WriteLine
oTS.WriteLine "INSTALLED SOFTWARE"
oTS.WriteLine

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Product",,48)
For Each objItem in colItems
 oTS.WriteLine "Caption: " & objItem.Caption
 oTS.WriteLine "Version: " & objItem.Version
 oTS.WriteLine
Next

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
For Each objItem in colItems
  Wscript.Echo "Processor Id: " & objItem.ProcessorId
  Wscript.Echo "Maximum Clock Speed: " & objItem.MaxClockSpeed
Next

strComputer = "." 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Service",,48) 
For Each objItem in colItems 
    Wscript.Echo "Service Name: " & objItem.Name & VBNewLine _
        & "State: " & objItem.State
Next

Option Explicit

Dim strComputer, objComputer, objUser
strComputer = "."
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.Filter = Array("user")
For Each objUser In objComputer
On Error Resume Next
Wscript.Echo objUser.Name & ", " & objUser.LastLogin
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo objUser.Name & ", "
End If
On Error GoTo 0
Next

Option Explicit
On Error Resume Next

'***********************************************************************
' Constants - Globally defined string constants.
'***********************************************************************

' Location for target copy of events logs. Change this to customize
' archival point for the logs.

Const cLogTarget = "\\cheyenne\nora$\EventLogs"

'***********************************************************************
' Arrays - Globally defined arrays.
'***********************************************************************

' Array to hold sever computer names.
Dim arrServers
' Array to hold event log names for a given server.
Dim arrEVTfiles

'***********************************************************************
' Variables - Globally defined variables.
'***********************************************************************

' Declare & create global Shell objects
Dim WshShell, WshNetwork, objFSO, objArgs

Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Declare misc global variables. Follow these through the script
' to see what they do.
Dim dtmThisDay
Dim dtmThisMonth
Dim dtmThisYear
Dim strToday
Dim strNameSpace
Dim strEvtMsg
Dim strNode
Dim strEVTname
Dim strBackupName
Dim strComputer
Dim strTempDisk
Dim intFatalCount : intFatalCount = 0
Dim intWarnCount : intWarnCount = 0
Dim intSuccessCount : intSuccessCount = 0
Dim bouBailOut : bouBailOut = FALSE
Dim bouSkipNode : bouSkipNode = FALSE
Dim strSuccess
Dim strFailure
Dim strThisScript
Dim intResult

'***********************************************************************
' Main Program
'***********************************************************************

' Get some baseline information into variables.
Call GetBaseInfo()

' Stamp script startup into event log.
Call WriteEvent(00, 4, strComputer, "", "")

' Get the Active Directory namespace.
intResult = FindNBind()

' Get names of domain DC's & member servers.
intResult = GetDomServers()

' Assure the target archive folder is reachable.
intResult = TargetReady(cLogTarget)

' Here we do all steps for a single log on one server to completion.
' After all logs for one server are finished then we move on to
' the next server.

' Loop the array of servers in our domain.
For Each strNode in arrServers

' NOTE: for security reasons, WMI will not allow backup of event
' logs to a network share. We must back them up to local disk
' then move them to a network share.

' Note: if we can't do certain things on the server then no
' sense in continuing and logging multiple errors. Hence the
' bouSkipNode variant.

bouSkipNode = FALSE

' Find a local hard disk to write the backups.
If Not bouSkipNode Then GetScratchDisk(strNode)

' Get the event logs resident on the current server.
If Not bouSkipNode Then GetLogTypes(strNode)

If Not bouSkipNode Then

' Loop the event logs of one server. Finish all tasks on
' the current log file before moving on to the next log.
For Each strEVTname in arrEVTfiles

' Note: no check for bouSkipNode from here on out.
' It is possible that a failure condition for one
' evt log will not exist for another evt log.

' Backup or clear an event log. If P3 is "backup"
' then EVTstuff will run in backup mode. If P3
' is anything else then it will clear the log.
intResult = EVTstuff(strNode, strEVTname, "backup")

' If the logfile backup worked....
If Not bouSkipNode Then

' Copy the backup file to the network target.
intResult = MoveEVT(strNode, strBackupName, _
strTempDisk, cLogTarget)

End If

If Not bouSkipNode Then

' If the copy worked then clear event log.
intResult = EVTstuff(strNode, strEVTname, "clear")

End If
Next
End If

Next

Call BailOut()

'***********************************************************************
' Sub GetBaseInfo() - Collect some baseline info into global variables.
'***********************************************************************

Sub GetBaseInfo()

On Error Resume Next

' Get the computer name
strComputer = LCase(WshNetwork.ComputerName)

strThisScript = WScript.ScriptName

' Populate date variables for use in backup logfile name.
dtmThisDay = Day(Now)
dtmThisMonth = Month(Now)
dtmThisYear = Year(Now)

' Set time portion of the event log backup file name variant.
strToday = dtmThisYear & " " &_
dtmThisMonth & " " &_
dtmThisDay

End Sub

'***********************************************************************
' Function FindNBind() - Get LDAP Active Directory Provider Namespace
' at the domain level.
'***********************************************************************

Function FindNBind()

On Error Resume Next
Dim objBaseLDAP, strErrDesc
FindNBind = TRUE

' Bind to the root of our LDAP AD.
Set objBaseLDAP = GetObject("LDAP://RootDSE")

' Return the namespace text string.
Err.Clear
strNameSpace = objBaseLDAP.get("DefaultNamingContext")

If Err.Number <> 0 Then

strErrDesc = Err.Description
FindNBind = FALSE
bouBailOut = TRUE

' Write fatal error log # 1. P2 = 1 means we
' abort the script. The script will exit on
' a call from WriteEvent().
Call WriteEvent(01, 1, "FindNBind()", strErrDesc, "")

Exit Function

End If

End Function

'***********************************************************************
' Function GetDomServers() - Get the names of all domain DC and member
' servers into a data array.
'***********************************************************************

Function GetDomServers()

On Error Resume Next
Dim objConnection, objCommand, objRecordSet, strQuery1
Dim intSvrCount : intSvrCount = 0

GetDomServers = TRUE

' Create ADO connecton object in memory.
Set objConnection = CreateObject("ADODB.Connection")

' Open the connection object using ADSI OLE DB provider.
objConnection.Open "Provider=ADsDSOObject;"

' Create ADO command object in local memory.
Set objCommand = CreateObject("ADODB.Command")

' Link the connection object to the command object's
' ActiveConnection property.
objCommand.ActiveConnection = objConnection

' Build the LDAP query string...serach entire AD for computer
' objects containing the word Server in the OS field. Return
' the computer name of each instance found.
strQuery1 = "<LDAP://" & strNameSpace & ">;" &_
"(&(objectCategory=Computer)(operatingSystem=*Server*));" &_
"Name;subtree"

' Write the query string into the command object.
objCommand.CommandText = strQuery1

' Run the query against AD and trap for error.
Err.Clear
Set objRecordSet = objCommand.Execute

' If nothing returned then log error and quit the script.
If objRecordSet.RecordCount = 0 Then

GetDomServers = FALSE
bouSkipNode = TRUE
bouBailOut = TRUE

' Write fatal error log # 2. The script will exit
' on a call from WriteEvent().
Call WriteEvent(02, 1, "GetDomServers()", _
strNameSpace, "")

End If

' Size up the array to hold server names.
ReDim arrServers(objRecordSet.RecordCount - 1)

' Loop the record set.
While Not objRecordSet.EOF

' Load up the array.
arrServers(intSvrCount) = objRecordSet.Fields("Name")
intSvrCount = intSvrCount + 1

objRecordSet.MoveNext

Wend

' Kill the connection object.
objConnection.Close

End Function

'***********************************************************************
' Function TargetReady() - Assure the final network target location for
' the evt file backups exist.
'***********************************************************************

Function TargetReady(strLogTarget)

On Error Resume Next
TargetReady = TRUE

' Test for the target folder with error checking. If it
' doesn't exist now then we log and abort.
If Not objFSO.FolderExists(strLogTarget) Then

TargetReady = FALSE
bouSkipNode = TRUE
bouBailOut = TRUE

' Write fatal error log # 3. The script will exit
' on a call from WriteEvent().
Call WriteEvent(03, 1, "TargetReady()", _
strLogTarget, "")

Exit Function

End If

End Function

'***********************************************************************
' Function GetScratchDisk() - Find a local hard disk for one server
' with more than 100 mb free. This is to
' write the initial evt backup before
' moving it to the network destination.
'***********************************************************************

Function GetScratchDisk(strSrvName)

On Error Resume Next
Dim objWMIService, strQuery1, strQuery2, colDisks, objDisk
GetScratchDisk = TRUE
strTempDisk = ""

' Get WMI CIM root.
strQuery1 = "winmgmts:{impersonationLevel=impersonate}!\\" &_
strSrvName & "\root\cimv2"
Set objWMIService = GetObject(strQuery1)

' Query the node for all logical disks.
strQuery2 = "Select * from Win32_LogicalDisk"
Set colDisks = objWMIService.ExecQuery (strQuery2)

' Loop the local disk objects.
For each objDisk in colDisks

' Type 3 = Local Hard Disk.
If objDisk.DriveType = 3 Then

' If over 100 mb free disk space then we have our
' temp disk. 100 mb = (1024 x 1024) x 100
If objDisk.FreeSpace > 104857600 Then

' Populate the global variant used for
' temporary backup log file location.
strTempDisk = objDisk.DeviceID & "\"
'Exit Function

End If

End If

Next

' strTempDisk null means no hard disks had free space
' of greater then 100 mb. We'll consider this fatal for
' the current server only and keep running the script
' since other servers might be OK.
If strTempDisk = "" Then

GetScratchDisk = FALSE
' Set flag to stop processing for the current server.
bouSkipNode = TRUE
' Keep running the script.
bouBailOut = FALSE

' Write warning error log # 4. The script will not
' exit on warnings.
Call WriteEvent(04, 2, "GetScratchDisk()", _
strSrvName, "")

' Keep track of failure metrics.
Call WriteEvent(999, 2, strSrvName & " - All Event Logs", _
"", "nolog")

End If

End Function

'***********************************************************************
' Function GetLogTypes() - Use WMI to get names of all event logs on
' one server. Server name must be passed in.
'***********************************************************************

Function GetLogTypes(strSrvName)

On Error Resume Next
GetLogTypes = TRUE
Dim objWMIService, objInstalledLogFiles, objLogfile, intEvtCount
Dim strQuery1, strQuery2, strErrDesc
intEvtCount = 0

' Connect remotely to WMI root Cimv2
strQuery1 = "winmgmts:{impersonationLevel=impersonate}!\\" &_
strSrvName & "\root\cimv2"
Set objWMIService = GetObject(strQuery1)

' Execute the WMI query to return all logfile objects.
strQuery2 = "Select * from Win32_NTEventLogFile"
Err.Clear
Set objInstalledLogFiles = objWMIService.ExecQuery (strQuery2)

If Err.Number <> 0 Then

' The WMI query didn't work, so stop processing for
' this server but keep running the script. (Other
' servers might be OK)
strErrDesc = Err.Description
GetLogTypes = FALSE
' Abort processing for the current server in the loop.
bouSkipNode = TRUE
' Keep running the script code.
bouBailOut = FALSE

' Write warning error log # 5. The script will not
' exit on warnings.
Call WriteEvent(05, 2, "GetLogTypes()", _
strSrvName, strErrDesc)

' Keep track of failure metrics.
Call WriteEvent(999, 2, strSrvName & " - All Event Logs", _
"", "nolog")

Exit Function

End If

' Size up array to hold this node's event logs names.
ReDim arrEVTfiles(objInstalledLogFiles.Count - 1)

' Populate the array with this node's event log names.
For each objLogfile in objInstalledLogFiles

arrEVTfiles(intEvtCount) = objLogfile.LogFileName
intEvtCount = intEvtCount + 1

Next

End Function

'***********************************************************************
' Function EVTstuff() - Backup or clear one event log.
'***********************************************************************

Function EVTstuff(strSrvName, strEVTtype, strFunction)

On Error Resume Next
Dim LogFileSet, objLogfile, strQuery1, strQuery2
EVTstuff = TRUE

' Create backup log filename. Format will appear as...
' Nodename - Application - 2004 8 18.evt
strBackupName = strSrvName & " - " & strEVTtype & " - " &_
strToday & ".evt"

' Set up WMI query text strings. This query returns an object
' for a specific event log.
strQuery1 = "winmgmts:{impersonationLevel=impersonate," &_
"(Backup,Security)}!\\" & strSrvName & "\root\cimv2"
strQuery2 = "select * from Win32_NTEventLogFile where " &_
"LogfileName='" & strEVTtype & "'"

' Get a single event log object.
Set LogFileSet = GetObject(strQuery1).ExecQuery(strQuery2)

For Each objLogfile in LogFileSet

If strFunction = "backup" Then

Err.Clear
' This is where we backup one event log file to a
' local hard disk.
objLogFile.BackupEventLog(strTempDisk & strBackupName)

If Err.Number <> 0 Then

EVTstuff = TRUE
' Again, a failure on one server does not mean the
' others will fail...so keep running code.
bouBailOut = FALSE
' If we can't backup one log file to the local disk
' then we'll assume all of them will fail. This will
' prevent scores of event log entries, one per log.
bouSkipNode = TRUE

' Write fatal error log # 6. The script will not
' exit. Since this is the actual backup of an event
' log we consider this an error, unlike some prior
' logs which were considered warnings. We do not
' abort script because this condition might not
' be prevalant on all servers.
Call WriteEvent(06, 2, "EVTstuff()", _
strEVTtype , strSrvName)

' Keep track of failure metrics.
Call WriteEvent(999, 2, strSrvName & " - " &_
strEVTtype, "", "nolog")

End If

Else

Err.Clear
' This is where we clear one event log file.
objLogFile.ClearEventLog()

If Err.Number <> 0 Then

EVTstuff = TRUE
bouBailOut = FALSE
bouSkipNode = FALSE

' Write warning error log # 7. The script will not
' exit.
' If we can't clear a log then it's a warning
' because the log was backed up.
Call WriteEvent(07, 2, "EVTstuff()", _
strEVTtype , strSrvName)

' Keep track of failure metrics.
Call WriteEvent(999, 2, strSrvName & " - " & strEVTtype, _
"", "nolog")

' Since the logfile did actually get backed up we'll
' log success also.
Call WriteEvent(999, 0, strSrvName & " - " & strEVTtype, _
"", "nolog")

Else

' If we get here then everything worked for one log!
' Bump success metrics and append to the list of
' logs that were successfull. "nolog" in P5 causes
' WriteEvent() not to log to event log. This will
' be done at gracefull script exit.
Call WriteEvent(999, 0, strSrvName & " - " & strEVTtype, _
"", "nolog")

' Flag success back to the caller
EVTstuff = TRUE

End If

End If

Next

End Function

'***********************************************************************
' Function MoveEVT() - Use WMI to move one event log file from local
' disk to network share.
'***********************************************************************

Function MoveEVT(strSrvName, strTempEvt, strCopyRoot, strNet)

On Error Resume Next
Dim strNetSource, strTempFile
MoveEVT = TRUE

' This copy will go net location to net location. So we
' need to convert the temp evt filename from local disk
' to UNC. We can use the admin share of the disk.
strNetSource = "\\" & strSrvName & "\" &_
Left(strCopyRoot, 1) & "$\" &_
strBackupName

' Copy a single backed up event log to the network target.
Err.Clear
objFSO.CopyFile strNetSource, strNet & "\", TRUE

If Err.Number <> 0 Then

MoveEVT = FALSE
' Same as other function....if we can't do this once
' then it'll probably fail for each log, so quit
' processing for the current server.
bouSkipNode = TRUE
' Keep running the script.
bouBailOut = FALSE

' Write fatal error log # 8.
Call WriteEvent(08, 2, "MoveEVT()", _
strNetSource, _
strNet & ".")

' Keep track of failure metrics.
Call WriteEvent(999, 2, strTempEvt, "", "nolog")

Else

' Everything has worked to this point so we'll go
' ahead and dealte the local temp evt file.
Set strTempFile = objFSO.GetFile(strNetSource)

Err.Clear
strTempFile.Delete
If Err.Number <> 0 Then

MoveEVT = FALSE
' Since everything worked but this we'll go ahead
' and keep trying on each event log, (We are getting
' a good backup and file transfer) but later on
' we'll advise the administrator to manually delete
' the temp log files.
bouSkipNode = FALSE
bouBailOut = FALSE

' Write fatal error log # 9.
Call WriteEvent(09, 2, "MoveEVT()", _
strNetSource, "")

' Keep track of failure metrics.
Call WriteEvent(999, 2, strTempEvt, "", "nolog")

End If

End If

End Function

'***********************************************************************
' Sub WriteEvent() - Write one event to the Windows app event log.
' This function exists to make the other functions
' shorter and less convoluted. This is like a
' central repository for error messages and metrics
' processing.
'***********************************************************************
Sub WriteEvent(intEvent, intSeverity, strTxt1, strTxt2, strTxt3)

On Error Resume Next


Select Case intEvent

     Case 00 ' Informational - Script startup time stamp.
     strEvtMsg = strThisScript & " has started on node " &_
     strTxt1 & "."

     Case 01 ' Fatal - Can't get LDAP namespace.
     strEvtMsg = "Fatal " & strThisScript &_
     " error in function " &_
     strTxt1 & ". Script aborted. " &_
     "Zero servers backed up. " &_
     "to query the AD LDAP " &_
     "namespace..." & strTxt2

     Case 02 ' Fatal - Can't get list of servers from ADSI.
     strEvtMsg = "Fatal " & strThisScript & " error " &_
     "in function " & strTxt1 & ". " &_
     "Script aborted. Zero servers " &_
     "backed up. Unable to get list " &_
     "of server names from ADSI query of " &_
     strTxt2 & "."

     Case 03 ' Fatal - Target network folder is not available.
     strEvtMsg = "Fatal " & strThisScript & " error in " &_
     "function " & strTxt1 & ". Script " &_
     "aborted. Zero servers backed up. " &_
     "Target backup folder " &_
     strTxt2 & " is not reachable."

     Case 04 ' Fatal - Can't locate local disk with > 100 mb
     ' free disk space.
     strEvtMsg = "Fatal " & strThisScript & " error in " &_
"function " & strTxt1 & ". Script " &_
"continuing. Unable to locate local disk " &_
"with > 100 mb free on " & strTxt2 &_
" to write temp backup files."

     Case 05 ' Fatal - Can't get event log types from WMI.
     strEvtMsg = "Fatal " & strThisScript & " error in " &_
"function " & strTxt1 & ". Script " &_
"continuing. Unable to retrieve " &_
"list of event log names from WMI " &_
"on " & strTxt2 & "..." & strTxt3

     Case 06 ' Warning - Can't backup event log to temp folder.
     strEvtMsg = "Fatal " & strThisScript & " error in " &_
"function " & strTxt1 & ". Script " &_
"continuing. Failure attempting " &_
"to backup the " & strTxt2 &_
" log on " & strTxt3 & "."

     Case 07 ' Warning - Can't clear event log.
     strEvtMsg = strThisScript & " warning in " &_
"function " & strTxt1 & ". Script " &_
"continuing. Failure attempting " &_
"to clear the " & strTxt2 &_
" log on " & strTxt3 & "."

     Case 08 ' Warning - Can't copy event log backup from temp
     ' location to network share.
     strEvtMsg = strThisScript & " warning in " &_
"function " & strTxt1 & ". Script " &_
"continuing. Failure attempting " &_
"to copy " & strTxt2 & " to " &_
strTxt3

     Case 09 ' Warning - Failure to delete temp backup file. We
     ' remind admin to manually delete the temp
     ' file because WMI will not overwrite on a
     ' copy function, so the next backup would
     ' fail.
     strEvtMsg = strThisScript & " warning in " &_
"function " & strTxt1 & ". Script " &_
"continuing. Failure attempting " &_
"to delete " & strTxt2 & ". " &_
"Please manually delete the file. " &_
" If you don't then the next " &_
"backup will fail."

     Case 10 strEvtMsg = ""

     Case Else ' Do Nothing.

End Select

If strTxt3 <> "nolog" Then

' Log the event.
WshShell.LogEvent intSeverity, strEvtMsg

End If

' Handle metrics. Call to exit script if error severity is 1.
Select Case intSeverity

     Case 0 ' Success
     intSuccessCount = intSuccessCount + 1
     If strTxt3 = "nolog" Then

' Build list of servers backed up.
strSuccess = strSuccess & VbCrLf &_
strTxt1 & strTxt2

End If

     Case 1 ' Error
' Error status means we abort the script.
intFatalCount = intFatalCount + 1
' Build list of servers not backed up.
If bouBailOut Then Call BailOut()

     Case 2 ' Warning

     If strTxt3 = "nolog" Then

intWarnCount = intWarnCount + 1
     strFailure = strFailure & VbCrLf & strTxt1 &_
     strTxt2

     End If

     Case 4 ' Informational

     Case 8 ' Audit Success

Case 16 ' Audit Failure

End Select

End Sub

'***********************************************************************
' Sub BailOut() - Exit after logging in Event Log. This is the only
' exit point for the entire script.
'***********************************************************************
Sub BailOut()

On Error Resume Next
Dim intType

' The three if statements construct the text portion of the
' final event log entry.

If intWarnCount = 0 and intFatalCount = 0 Then

' If no errors or warnings write success status message
' with statistics & pertinate information.
strEvtMsg = WScript.ScriptName & " completed successfully." &_
" The event logs were cleared. The backups can" &_
" be found at: " & cLogTarget &_
VbCrLf & VbCrLf &_
intSuccessCount & " logfiles were backed up..." &_
VbCrLf & strSuccess

intType = 8

End If

' If zero backups worked.
If intSuccessCount = 0 Then

' If any warnings or errors then write the status message
' with statistics and advise to look at previous WSH logs.
strEvtMsg = WScript.ScriptName & " ended with warning count of " &_
intWarnCount & " and fatal error count of " &_
intFatalCount & ". See prior WSH events for " &_
"details. " & VbCrLf & VbCrLf &_
intWarnCount & " problems were encountered..." &_
VbCrLf & strFailure

intType = 16

End If

If intWarnCount + intFatalCount <> 0 and intSuccessCount <> 0 Then

' If any some warning and some successes then log stats for
' both.
strEvtMsg = WScript.ScriptName & " ended with warning count of " &_
intWarnCount & ", fatal error count of " &_
intFatalCount & " and success count of " &_
intSuccessCount & ". See prior WSH events for " &_
"details. " & VbCrLf & VbCrLf &_
intWarnCount & " problems were encountered..." &_
VbCrLf & strFailure &_
VBCrLf & VbCrLf & intSuccessCount &_
" logfiles were backed up..." &_
VbCrLf & strSuccess

intType = 16

End If

' Log the final event and quit script.
WshShell.LogEvent intType, strEvtMsg
WScript.Quit(0)

End Sub