vbscript

Available Code Samples



Install software and email result report to admins

  • designed to be triggered at the workstation by Altiris or some other agent method.
  • agent must run script as a local admin.
  • With Altiris, I create ‘run script’ task, where the script is ‘wscript \\fubarserver\setups$\_software_applications \picasa\picasa_install.vbs’
  • the script suppresses the file security warning “This file is from an unknown publisher”
strDestEmailAddress = "admins@fubar.com" 'smtp email addresses of desired notification recipients separated by commas
Set objShell = CreateObject("WScript.Shell")
Set objEnv = objShell.Environment("PROCESS")
strComputer = objShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
on error resume next
err.clear

objEnv("SEE_MASK_NOZONECHECKS") = 1 'Remove the file open security warning
'------------------
  strCommand = "\\fubarserver\setups$\_software_applications\picasa\picasa36-setup.exe /S /L"
  objShell.Run strCommand, 0, True
'------------------
objEnv.Remove("SEE_MASK_NOZONECHECKS") 'resume warnings
intError = err.number
Call srNotify(strComputer, intError)

'==============================================================================================
'==============================================================================================
Sub srNotify(sComputer, iError) 'stage and send email notification message
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "Picasa installed: " & sComputer
    objMessage.From = "fubarSoftwareInstall@fubar.com"
    objMessage.To = strDestEmailAddress
    objMessage.TextBody = "Result code: " & iError & vbcrlf & vbcrlf & "0 = no runtime errors occured."
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "relay.fubar.com"
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    objMessage.Configuration.Fields.Update
    objMessage.Send
End sub

Subroutine to stop and disable a service

Sub srServiceStopDisable()
  strCommand = "sc stop vss"
  objShell.Run strCommand, 0, True
  strCommand = "sc config vss start= disabled"
  objShell.Run strCommand, 0, True
End sub

Find all of the SPN’s for a hostname and echo them one at a time to a copyable input box

  • requests an spn from user
  • replies with all spn’s found for the host named in the spn

If in doubt, enter ‘host/<computer netbios name>’, as every computer should have an SPN of that type

=============================================================
' Copyright (c) Microsoft Corporation 2004 -
' File:       querySpn.vbs
' Contents:   Query a given SPN in a given forest to find the owners
' History:    7/7/2004   Craig Wiand   Created
' November 10, 2009 kab, numerous user interface and output modifications

Option Explicit
Const DUMP_SPNs = True
Dim oConnection, oCmd, oRecordSet
Dim oGC, oNSP
Dim strGCPath, strClass, strSPN, strADOQuery, strObjectInfo
Dim vObjClass, vSPNs, vName

strSPN = ucase(InputBox("Enter SPN to query for." & vbcrlf & "Example 'HOST/admnt1'." & vbcrlf & "If in doubt, use 'host/<netbios name of computer>'. The query will list ALL SPNs found for the computer in a series of popup windows.","SPN Query"))

'global catalog

srGetGC()

'--- Set up the connection ---
Set oConnection = CreateObject("ADODB.Connection")
Set oCmd = CReateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "ADs Provider"
Set oCmd.ActiveConnection = oConnection
oCmd.Properties("Page Size") = 1000

'--- Build the query string ---
strADOQuery = "<" + strGCPath + ">;(servicePrincipalName=" + strSPN + ");" & _
    "dnsHostName,distinguishedName,servicePrincipalName,objectClass," & _
        "samAccountName;subtree"
oCmd.CommandText = strADOQuery

'--- Execute the query for the object in the directory ---
Set oRecordSet = oCmd.Execute
If oRecordSet.EOF and oRecordSet.Bof Then
  Wscript.Echo "No SPNs found!"
Else
 While Not oRecordset.Eof
   strObjectInfo = "DN: " & oRecordset.Fields("distinguishedName") & vbcrlf
   vObjClass = oRecordset.Fields("objectClass")
   strClass = vObjClass( UBound(vObjClass) )
   strObjectInfo = strObjectInfo & "Object Class: " & strClass & vbcrlf
   If UCase(strClass) = "COMPUTER" Then
      inputbox strObjectInfo & vbcrlf & "Computer DNS: ", "SPN Query", oRecordset.Fields("dnsHostName")
   Else
      inputbox strObjectInfo & vbcrlf & "User Logon: ", "SPN Query", oRecordset.Fields("samAccountName")
   End If

   If DUMP_SPNs Then
      '--- Display the SPNs on the object ---
      vSPNs = oRecordset.Fields("servicePrincipalName")
      For Each vName in vSPNs
         inputbox strObjectInfo & vbcrlf & "SPN:", "SPN Query", vName
      Next
   End If
   oRecordset.MoveNext
 Wend
End If

oRecordset.Close
oConnection.Close

Sub srGetGC()
    Set oNSP = GetObject("GC:")
    For Each oGC in oNSP
      strGCPath = oGC.ADsPath
    Next
End Sub

A function and subroutine pair for converting a local user profile to an Active Directory domain user profile

Function fnStrToHex(ByRef Str, ByVal intType) 'converts string value to hex bytes, comma-separated
'intType 2 output is double byte format needed for hex(2)/REG_EXPAND_SZ
    Dim intLength
    Dim intMax
    Dim strHex
    Dim intCommaCount
    intMax = Len(Str)
    intCommaCount = 0
    For intLength = 1 To intMax
      strHex = strHex & Right("0" & Hex(Asc(Mid(Str, intLength, 1))), 2)
      If intCommaCount <> 17 Then
        If intType = 2 Then
          If Not intLength = intMax Then strHex = strHex & ",00,"
        Else
          If Not intLength = intMax Then strHex = strHex & ","
        End if
        intCommaCount = intCommaCount + 1
      Else
        If intType = 2 Then
          If Not intLength = intMax Then strHex = strHex & ",00,\" & vbcrlf
        Else
          If Not intLength = intMax Then strHex = strHex & ",\" & vbcrlf
        End if
        intCommaCount = 0
      End if
      If intType = 2 And intLength = intMax Then strHex = strHex & ",00"
    Next
    fnStrToHex = strHex
End function

Sub srBuildReg(ByVal sUser, ByVal sSid, ByVal sGuid) 'builds .reg import file to define keys for domain user's profile
    strProfImgPath = "%SystemDrive%\Documents and Settings\" & sUser
    strSIDHex = fnStrToHex(sSid, 0)
    strProfImgPathHex = fnStrToHex(strProfImgPath, 2)
      set objFileReg = objFileSys.OpenTextFile("c:\windows\infosysuserconvert.reg", 2, True, -1)'file type is unicode
      objFileReg.WriteLine("Windows Registry Editor Version 5.00")
      objFileReg.WriteLine("")
      objFileReg.WriteLine("[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & sSid & "]")
      objFileReg.WriteLine("""ProfileImagePath""=hex(2):" & strProfImgPathHex)
      objFileReg.WriteLine("""Sid""=hex:" & strSIDHex)
      objFileReg.WriteLine("""Flags""=dword:00000000") 'optional
      objFileReg.WriteLine("""State""=dword:00000100") 'optional
      objFileReg.WriteLine("""CentralProfile""=""""")
      objFileReg.WriteLine("""ProfileLoadTimeLow""=dword:c0f78a72") 'optional
      objFileReg.WriteLine("""ProfileLoadTimeHigh""=dword:01c85490") 'optional
      objFileReg.WriteLine("""Guid""=""{" & sGuid & "}""")
      objFileReg.WriteLine("""RefCount""=dword:00000003") 'optional
      objFileReg.WriteLine("""RunLogonScriptSync""=dword:00000000") 'optional
      objFileReg.WriteLine("""OptimizedLogonStatus""=dword:00000007") 'optional
      set objFileReg = nothing
End sub

Suppress/prevent the file security warning ‘This file is from an unknown publisher’ when calling an executable using the run method within a script

Set objShell = CreateObject("WScript.Shell")
Set objEnv = objShell.Environment("PROCESS")
objEnv("SEE_MASK_NOZONECHECKS") = 1 'Remove the file open security warning
'------------------
'do a shell run of the desired executables here
'------------------
objEnv.Remove("SEE_MASK_NOZONECHECKS") 'resume warnings

Perform an nslookup on host name or ip address supplied by user

strQueryObject = "nslookup " & InputBox("name or ip to lookup:","nslookup")
Set objShell = CreateObject("WScript.Shell")
Set objWshScriptExec = objShell.Exec(strQueryObject)
Set objStdOut = objWshScriptExec.StdOut
strOutput = objStdOut.ReadAll
msgbox strOutput

Function to ping a host and return a boolean result based on response

Function fnPing(strHost) 'for the hostname passed, checks if it replies to a ping
    set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery ("select * from Win32_PingStatus where address = '" & strHost & "'")
    for each objRetStatus in objPing
        if IsNull(objRetStatus.StatusCode) or objRetStatus.StatusCode<>0 then
            fnPing = False
        else
            fnPing = True
        end if
    next
    set objPing = nothing
End Function

Subroutine to acquire mac address and ip address pair(s) from a Windows workstation

sub srNetSettingsQry(ByVal strComputer)
  Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  Set objCollection = objWMIService.ExecQuery("select * from win32_networkadapterconfiguration WHERE IPEnabled='TRUE' " _
     & "AND ServiceName<>'AsyncMac' " _
     & "AND ServiceName<>'VMnetx' " _
     & "AND ServiceName<>'VMnetadapter' " _
     & "AND ServiceName<>'Rasl2tp' " _
     & "AND ServiceName<>'msloop' " _
     & "AND ServiceName<>'PptpMiniport' " _
     & "AND ServiceName<>'Raspti' " _
     & "AND ServiceName<>'NDISWan' " _
     & "AND ServiceName<>'NdisWan4' " _
     & "AND ServiceName<>'RasPppoe' " _
     & "AND ServiceName<>'NdisIP' " _
     & "AND ServiceName<>'' " _
     & "AND Description<>'PPP Adapter.'",,48)

  For Each objItem in objCollection
     if objItem.IPAddress(0) <> "0.0.0.0" then
          strValueIP = objItem.IPAddress(0)
          strValueMac = objItem.MACAddress
          strValue = strComputer & vbTab & strValueIP & vbTab & strValueMac
          msgbox strValue
          strValue = ""
     end if
  next
End sub

Send email using cdosys

Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "subject text"
objMessage.From = "sender@fubar.com"
objMessage.To = "receiver@fubar.com"
objMessage.TextBody = "Message body here."
objMessage.AddAttachment strCompletePath
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.fubar.com"
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "fubar\joe.user"
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objMessage.Configuration.Fields.Update
objMessage.Send

Function to convert Active Directory lastLogon attribute data to a standard date/time format

intBias = -360 'difference between Central time zone and UTC in minutes

'convert lastLogon data to a standard date/time format
Function fnTimeConvert(lngTimeMeasure) 'AD lastLogon attribute is a 64 bit integer representing the # of 100 nanosecond intervals since 1/1/1601
  fnTimeConvert = (lngTimeMeasure.HighPart * (2^32)) + lngTimeMeasure.LowPart 'since it's a 64 bit integer, it's two parts must be accessed separately and added together
  fnTimeConvert = fnTimeConvert / (60 * 10000000) 'convert from 100 nanosecond intervals to minutes (1x10^7 100 nanosecond intervals per second -times- 60 seconds per minute)
  fnTimeConvert = fnTimeConvert + intBias 'apply the time zone difference
  fnTimeConvert = fnTimeConvert / 1440 'convert to hours
  fnTimeConvert = fnTimeConvert + #1/1/1601# 'add to starting date
End Function

Function to generate a datestamp string

Function fnDateStr() 'provides date-stamped string for logfile name
    dateHold = now()
    fnDateStr = CStr(dateHold)
    fnDateStr = replace(fnDateStr, "/", "-")
    fnDateStr = replace(fnDateStr, " AM", "AM")
    fnDateStr = replace(fnDateStr, " PM", "PM")
    fnDateStr = replace(fnDateStr, " ", "_")
    fnDateStr = replace(fnDateStr, ":", "-")
End Function

129B2D7A40310509024A7D86C5393F3EDB0BE880803B3737771EE5F596583F4
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s