For this request. We wanted a way to determine, based on the workstations IP, what print server a user should be pointed to. It first reads in the contents of the CSV file, then the IP of the workstation, then compares it against a list of IP Ranges in the CSV file until it finds a match. Finally it launches the, with IE, the Printer selection page on that Print Server.
Idea's for enhancement, it would be great to build the Site list off AD Site boundaries. Then pull in the assigned print server (not sure how) for that site. Basically, eliminate the static CSV file, and make it dynamic. Else, someone will need to maintain the list of sites ans servers in the CSV file forever (although they shouldn't change all that often)...
'----------------------------------------------------------------
' Purpose: Scans against a CSV file containing Subnet information
' the local Workstations IP address, then if it finds a match
' it Launches a Web Page with IE for the Local Print Server
' Version: 1.0
' NOTE: in the CSV file the format must be: (IP Addresses must be in Quotes)
' "172.0.1.1","172.255.255.254",{AD SITE NAME}, {PRINT SERVER}
' Created by: Corey A Sines
'----------------------------------------------------------------
On Error Resume Next ' If this isn't set, any incorrect entry in the CSV file will cause the script to exit.
forceCScriptExecution
VERBOSE = 1 ' Sets script to display debug info
sCSVFile = "printservers.csv" ' File must be in the same container as the VBS file, you can add pathing / cmd line args if you want...
' Commands used to open the CSV file and select all of the records
set oConnection = createobject("adodb.connection")
set oRecordSet = createobject("adodb.recordset")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = Wscript.CreateObject("Wscript.Shell")
iRecCount = 1 ' record counter
sWorkstationIP = GetIPAddress() ' calls function to get IP Address
'comment out the above variable for sWorkstationIP, and use the below variable to set to a random IP for testing
'sWorkstationIP = "172.0.0.23"
Wscript.Echo "---------------------------------------------------------"
Wscript.Echo "Running Find Local Print Server Script on " & Date & " " & Time
If FSO.FileExists(sCSVFile) Then 'Opens the CSV file with ADO Objects
If VERBOSE = 1 Then Wscript.echo "Atttemping to Open CSV File :" & sCSVFile End If
oConnection.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & WshShell.CurrentDirectory &_
";Extended Properties=" & Chr(34) & "text;HDR=NO;FMT=Delimited" & Chr(34)
oRecordSet.open "SELECT * FROM " & sCSVFile ,oConnection ' Selecting all
If Err.Number <> 0 Then ' Error occured in the above code
DisplayError "An ADODB Error Occured opening the CSV file! Script Exiting!"
Wscript.Quit(1) ' Script exits
End If
Else
WScript.Echo "CSV file: " & sCSVFile & "Not found!" & vbCrLf & "Script Exiting..."
WScript.Quit(1) ' Script exits
End If
Wscript.Echo "Attempting to Determine what Subnet this Workstation at IP:" & sWorkstationIP & " Belongs to..."
While oRecordSet.EOF = False
' Read variable information from the CSV file
' and determines what the is Appropriate Print Server
sIPRangeStart = oRecordSet.Fields.Item(0).value ' Starting IP Address
sIPRangeEnd = oRecordSet.Fields.Item(1).value ' Ending IP Address
sADSiteName = oRecordSet.Fields.Item(2).value ' AD Site value for the IP Range
sPrintServer = oRecordSet.Fields.Item(3).value ' Print Server for the Specific Site
If VERBOSE = 1 Then
Dim strLDAP
Wscript.Echo "---------------------------------------------------------"
Wscript.Echo "Record Count:" & iRecCount
WScript.Echo "Attempting IP Range: " & sIPRangeStart & " - " & sIPRangeEnd
tmpArraySt = Split(sIPRangeStart, ".", -1,0)
iClassASt = int(tmpArraySt(0))
iClassBSt = int(tmpArraySt(1))
iClassCSt = int(tmpArraySt(2))
'Wscript.echo iClassASt & " " & iClassBSt & " " & iClassCSt
tmpArrayEnd = Split(sIPRangeEnd, ".", -1,0)
iClassAEnd = int(tmpArrayEnd(0))
iClassBEnd = int(tmpArrayEnd(1))
iClassCEnd = int(tmpArrayEnd(2))
'Wscript.echo iClassAEnd & " " & iClassBEnd & " " & iClassCEnd
tmpArrayIP = Split(sWorkstationIP, ".", -1,0)
iWorkStIP_A = int(tmpArrayIP(0))
iWorkStIP_B = int(tmpArrayIP(1))
iWorkStIP_C = int(tmpArrayIP(2))
'Wscript.echo iWorkStIP_A & " " & iWorkStIP_B & " " & iWorkStIP_C
If iWorkStIP_A >= iClassASt and iWorkStIP_A <= iClassAEnd Then
'Wscript.echo "Class A matched, trying Class B"
If iWorkStIP_B >= iClassBSt and iWorkStIP_B <= iClassBEnd Then
'Wscript.echo "Class B matched, trying Class C"
If iWorkStIP_C >= iClassCSt and iWorkStIP_C <= iClassCEnd Then
wscript.echo "This workstation is part of this site: " & sADSiteName
wscript.echo "Local Print Server will be set to: " & sPrintServer
Return = WshShell.Run("iexplore.exe http://" & sPrintServer & "/printers/", 1)
Wscript.quit(0)
Else
Wscript.echo "No Network Match for Subnet:" & sIPRangeStart & " - " & sIPRangeEnd
End If
Else
Wscript.echo "No Network Match for Subnet:" & sIPRangeStart & " - " & sIPRangeEnd
End If
Else
Wscript.echo "No Network Match for Subnet:" & sIPRangeStart & " - " & sIPRangeEnd
End If
End if
iRecCount = iRecCount + 1
oRecordSet.MoveNext
Wend
oRecordSet.Close
oConnection.Close
Set WshShell = Nothing
Set FSO = Nothing
set oConnection = nothing
set oRecordSet = nothing
'----------------------------------------Subs and Functions-----------------------------------
Function GetIPAddress() 'Function that Returns the IPAdress of a workstation, note in machines
' with multiple NIC adapters, or multiple bound IPs(shouldn't be many)
' it will return only the first NIC's IP address.
Dim strComputer, odjWMIService, IPConfigSet, IPAdress, IPConfig
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery _
("Select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
'WScript.Echo IPConfig.IPAddress(i)
GetIPAddress = IPConfig.IPAddress(0)
Next
End If
Next
End Function
'-------------
Sub forceCScriptExecution ' Script designed to run under cscript only!
Dim Arg, Str
If Not LCase( Right( WScript.FullName, 12 ) ) = "\cscript.exe" Then
For Each Arg In WScript.Arguments
If InStr( Arg, " " ) Then Arg = """" & Arg & """"
Str = Str & " " & Arg
Next
CreateObject( "WScript.Shell" ).Run "cscript //nologo """ & WScript.ScriptFullName & """" & Str
WScript.Quit
End If
End Sub
Thursday, January 31, 2013
Monday, January 7, 2013
Vb Script to Join computer to domain based on user DN
This was a complicated script. We wanted to create an automated process to join a workstation to the domain in the correct destination OU. In our environment the users exist in a location where the relative OU path to where the workstations should be can easily determined. I did a good bit of error checking in this script, as I wanted to capture issues well and be able to diagnosis them.
When the computer joins the domain successfully and reboots, the user login will now be a domain account and consequently a new profile will be created. So I had the script dynamically create another vbs file for profile copy that would run after reboot to copy all their previous profile information to the new profile.
The 4th command line arg is for the password of the user account in AD for the user/comp this is being run on. In our environment, users had never logged into the domain before (this was a Novell env). So the password was statically assigned during en-mass user creation operations. You can prompt the user for a password instead if the user already exists in AD and is actively using his or her account.
'-------------------------------------------------------
'SCRIPT: ADJOIN
'PURPOSE: to find the Proper OU for the Computer to be
'joined to the domain, based on matching the Novell User ID to
'the AD User ID. Then attempts to Join the Computer to the
'Domain to that OU. Finally, it attempts copying Profile information.
'This Script also alters the DNS search suffixes and order.
'NOTES & ASSUMPTIONS:
'1. This script assumes the user account has been created in AD prior
' To this script running.
'2. The Username and password supplied by command line arguments, must
' have rights to create the computer object in the OU being specified.
'3. The Script also requires that the user doesn't have set option to
' "Force the user to change password on next login".
'Version: 1.6
'Author: Corey Sines
'-------------------------------------------------------
Option Explicit
On Error Resume Next
Dim objArgs, wshShell, VERBOSE
Dim strDomain, strJoinADuser, strJoinADpass, tmpArray, strNTDomain
Dim dnsSuffix1, dnsSuffix2, dnsSuffix3, dnsSuffixArray, objWMIService, objNetworkSettings
Dim strComptr, strUser, strPassword, strNTName, strUserDN
Dim ReturnValue, strErrorDescription, objRegExp, objTrans, strCompOU
Dim objNetwork, strComputer, objComputer
Dim strOpenReg, strExportUserSettings
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_DOMAIN = 1
Const ADS_NAME_INITTYPE_SERVER = 2
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
' Constants for Domain Join
Const JOIN_DOMAIN = 1
Const ACCT_CREATE = 2
Const ACCT_DELETE = 4
Const WIN9X_UPGRADE = 16
Const DOMAIN_JOIN_IF_JOINED = 32
Const JOIN_UNSECURE = 64
Const MACHINE_PASSWORD_PASSED = 128
Const DEFERRED_SPN_SET = 256
Const INSTALL_INVOCATION = 262144
'Constants for Window Mode
Const MAXIMIZEDWINDOW = 3
Const MINIMIZEDWINDOW = 2
'Debug Script, set to yes (1) if you want VERBOSE feedback, set (0) for none.
VERBOSE = 1
'Section to handle the command line arguments
If WScript.Arguments.count = empty Or WScript.Arguments.Count <> 4 Then
Call Usage()
End If
Set objArgs = WScript.Arguments
strDomain = LCase(objArgs(0)) ' Domain that will be used for this script
strJoinADuser = LCase(objArgs(1)) ' User Account that has Domain Create Privledges to OUs
strJoinADpass = objArgs(2) ' Password for the Account that has Domain Create Privledges
strPassword = objArgs(3) ' Password For the User Account in AD that matches the Novell ID
tmpArray = Split(strDomain, ".", -1,0)
strNTDomain = tmpArray(0)
If VERBOSE = 1 Then
WScript.Echo "VERBOSE LOG of Active Directory Domain Join Script"
WScript.Echo Date & " " & Time
WScript.Echo "______________________________________________________________"
WScript.echo "You supplied the following command line arguments: " & vbCrLf & vbCrLf &_
"The Domain is set to: " & strDomain & vbCrLf &_
"NT4 Domain Name will be: " & strNTDomain & vbCrLf &_
"UserName to Join Domain (must have create rights!) is: " & strJoinADuser & vbCrLf '&_
'"Password for Join Domain account is: " & strJoinADpass & vbCrLf
End If
'-------------------------------------------------------
'Start of Section to set DNS Suffix Order
'where the Computer Account is going to reside.
'-------------------------------------------------------
'Production
'dnsSuffix1 = "Sandbox.testlab.local"
'dnsSuffix2 = "test.sandbox.testlab.local"
'dnsSuffix3 = "testlab.local"
'Adding Suffixes to an array
dnsSuffixArray = Array(dnsSuffix1 & ", " & dnsSuffix2 & ", " & dnsSuffix3)
If VERBOSE = 1 Then
WScript.Echo "Changing DNS Suffixes to the following: "
Dim suffix
For Each suffix In dnsSuffixArray
WScript.Echo suffix
Next
WScript.Echo ""
End If
strComptr = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComptr & "\root\cimv2")
Set objNetworkSettings = objWMIService.Get("Win32_NetworkAdapterConfiguration")
objNetworkSettings.SetDNSSuffixSearchOrder(dnsSuffixArray)
If Err.Number <> 0 Then ' Error occured in the above code
DisplayError "Error adding DNS Suffixes: " & dnsSuffixArray & vbCrLf & " Script Exiting!"
Wscript.Quit(0) ' Script exits
End If
'-------------------------------------------------------
'Start of Section to Retrive the OU for
'where the Computer Account is going to reside.
'-------------------------------------------------------
Set wshShell = Wscript.CreateObject("Wscript.Shell")
'Specifies Username and Password for the matching user of this machine in AD
If Ucase(WshShell.ExpandEnvironmentStrings("%NWUSERNAME%")) <> "" then
strUser = Ucase(WshShell.ExpandEnvironmentStrings("%NWUSERNAME%")) 'Novell ID
else
strUser = Ucase(WshShell.ExpandEnvironmentStrings("%USERNAME%")) 'Novell ID
End if
strNTName = strNTDomain & "\" & strUser ' Specify the NT4 name user. ex: DOMAIN\USER
If VERBOSE = 1 Then
WScript.echo "The Novell UserName to match on search in AD is:" & strUser & vbCrLf &_
"The Password to use for this AD account is:" & strPassword & vbCrLf &_
"The Matching AD NT4 Domain Name is: " & strNTName & vbCrLf
End If
' Use the NameTranslate object to convert the NT user name to the
' Distinguished Name required for the LDAP provider.
Set objTrans = CreateObject("NameTranslate")
' Initialize NameTranslate by locating the DC for the Domain.
' Because this computer isn't part of the domain, you must supply credentials
objTrans.InitEx ADS_NAME_INITTYPE_DOMAIN, strDomain, strUser, strNTDomain, strPassword
' Use the Set method to specify the NT format of the object name.
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
' Use the Get method to retrieve the RFC 1779 Distinguished Name.
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
If Err.Number <> 0 Then ' Error occured in the above code
DisplayError "User: " & strNTName & " not found in Domain: " & strDomain & vbLf &_
"or Password: " & strPassword & " is incorrect for this User." & vbCrLf & "Script Exiting!"
Wscript.Quit(0) ' Script exits
End If
' Escape any "/" characters with backslash escape character.
' All other characters that need to be escaped will be escaped.
strUserDN = Replace(strUserDN, "/", "\/")
If VERBOSE = 1 Then WScript.echo "User DN Found:" & strUserDN End If
' Using regex to remove the CN, and then concat the Computers OU to string
If InStr(strUserDN, "OU=Users_and_Groups") Then
Set objRegExp = New RegExp
With objRegExp
.Pattern = "^cn=[^,]+,OU=Users_and_Groups,"
.IgnoreCase = True
.Global = True
End With
strCompOU = "OU=Computers," & CStr(objRegExp.Replace(strUserDN, ""))
Else
Set objRegExp = New RegExp
With objRegExp
.Pattern = "^cn=[^,]+,"
.IgnoreCase = True
.Global = True
End With
strCompOU = "OU=Workstations," & CStr(objRegExp.Replace(strUserDN, ""))
End If
If VERBOSE = 1 Then WScript.echo "Computer OU set to:" & strCompOU End If
'-------------------------------------------------------
'Start of Section to Join the Computer to the Domain.
'-------------------------------------------------------
' Geting the Computer Name from WMI
Set objNetwork = CreateObject("WScript.Network")
strComputer = objNetwork.ComputerName
If VERBOSE = 1 Then WScript.Echo "Computer Name is:" & strComputer End If
'Getting the Computer Object from WMI so it can be use to Join Domain
Set objComputer = _
GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & _
strComputer & "\root\cimv2:Win32_ComputerSystem.Name='" _
& strComputer & "'")
If VERBOSE = 1 Then WScript.Echo "Attempting to Join Computer to the Domain.." End if
'Attempting to Join Domain - Using the credentials supplied by command line arguements.
'NOTE: This account must have priviledges to Create Computer in the specified OU
ReturnValue = objComputer.JoinDomainOrWorkGroup(strDomain, _
strJoinADpass, _
strJoinADuser, _
strCompOU, _
JOIN_DOMAIN + ACCT_CREATE)
If VERBOSE = 1 Then WScript.Echo "RETURNVALUE from Joining Domain was: " & ReturnValue End If
If Err.Number <> 0 Or ReturnValue <> 0 Then ' Error occured in the above code
On Error Resume Next
Err.Raise CInt(ReturnValue)
Err.Source = "objComputer.JoinDomainOrWorkGroup"
Select Case ReturnValue
Case 5 strErrorDescription = "Access is denied"
Case 87 strErrorDescription = "The parameter is incorrect"
Case 110 strErrorDescription = "The system cannot open the specified object"
Case 1323 strErrorDescription = "Unable to update the password"
Case 1326 strErrorDescription = "Logon failure: unknown username or bad password"
Case 1355 strErrorDescription = "The specified domain either does not exist or could not be contacted"
Case 2224 strErrorDescription = "The account already exists"
Case 2691 strErrorDescription = "The machine is already joined to the domain"
Case 2692 strErrorDescription = "The machine is not currently joined to a domain"
End Select
Err.Description = strErrorDescription
DisplayError "Joining Computer: " & strComputer & " to Domain: " & strDomain &_
" Failed. " & vbCrLf & "Script Exiting!"
Wscript.Quit(0) ' Script exits
End If
Wait(20)
'-------------------------------------------------------
'Start of Section to Handle Profile Copy
'-------------------------------------------------------
If VERBOSE = 1 Then WScript.Echo "Backing up Previous Registry Info..." End If
'Backing up Registry into .Reg file.
strOpenReg = "REG add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DisableRegistryTools /t REG_DWORD /d 0 /f"
strExportUserSettings = "regedit /e C:\DESKTOP.REG " & Chr(34) & "HKEY_CURRENT_USER\Control Panel" & Chr(34)
If VERBOSE = 1 Then 'Executes the program in the desired window mode base on VERBOSE setting
RunProgram strOpenReg, MAXIMIZEDWINDOW, True
RunProgram strExportUserSettings, MAXIMIZEDWINDOW, True
Else
RunProgram strOpenReg, MINIMIZEDWINDOW, True
RunProgram strExportUserSettings, MINIMIZEDWINDOW, True
End If
If Err.Number <> 0 Then ' Error occured in the above code
DisplayError "An Error occurred backing up your previous profile information, your profile may not" &_
"have been transferred over... Script Continuing.. Contact Customer Service!"
Err.Clear ' Script continues, Error is cleared...
End If
'Sub routine that creates the PCOPY.VBS file to be used on reboot.
CreatePCOPYVBS "c:\pcopy.vbs"
If VERBOSE = 1 Then WScript.Echo strComputer & " has been joined to the " & strDomain & " Domain." &_
"This Computer will now Reboot." End If
MsgBox strComputer & " has been joined to the " & strDomain & " Domain."
MsgBox "This computer will now reboot."
RunProgram "Shutdown -r -t 10", 2, False 'Restarts PC in 10 seconds
'Cleaning up resources.
Set objArgs = Nothing
Set wshShell = Nothing
Set objWMIService = Nothing
Set objNetworkSettings = Nothing
Set objRegExp = Nothing
Set objTrans = Nothing
Set objNetwork = Nothing
Set objComputer = Nothing
WScript.Quit(0) ' Exiting Script
'--------------------------SUBS & FUNCTIONS------------------------------
Sub Wait(someSeconds)
Dim tmpTime, i
tmpTime = 1000000 * someSeconds
for i = 0 to tmpTime
next
End Sub
'-----
Sub Usage() ' Displays a Popup window detailing how to use the Script with Commandline Arguments
Dim wshShell, responce, FSO, objFile
Set WshShell = Wscript.CreateObject("Wscript.Shell")
WshShell.Popup("Usage:" & vbNewLine &_
"cscript ADJOIN.vbs {AD Domain} {AD Join Account} {AD Join Account Password} " &_
" {New User Account Password for the Matching Novell to AD User}" & vbNewLine &_
VbCrLF & "Example:" & vbtab & "cscript ADJOIN.vbs SANDBOX.TESTLAB.LOCAL " &_
"SANDBOX\JOINDOM adminP@55 p@ssw0rd" & vbNewLine &_
VbCrLF & "Note:" & vbtab & "AD Join Account must be DOMAIN\USER format!")
responce = MsgBox ("Do you want this script to create an example Batch file?", VBYesNo, "AD DOMAIN JOIN SCRIPT")
If responce = VBYes Then
WScript.Echo "Creating file: EXAMPLE.BAT"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFile = fso.CreateTextFile(WshShell.CurrentDirectory & "\EXAMPLE.BAT", True)
objFile.WriteLine "@ECHO OFF"
objFile.WriteLine "cscript //nologo ADJOIN.VBS SANDBOX.TESTLAB.LOCAL SANDBOX\JOINDOM adminP@55 p@ssw0rd > ADJOIN.LOG"
objFile.Close
End If
WScript.Quit(0)
End Sub
'-----
Sub RunProgram(progName, windowMode, waitForReturn) ' Runs a Program with desired options
wshShell.Run progName, windowMode, waitForReturn
End Sub
'-----
Sub DisplayError(customErrText) ' Displays Error information
WScript.Echo customErrText
WScript.Echo "Error: " & Err.Number
WScript.Echo "Error (Hex): " & Hex(Err.Number)
WScript.Echo "Source: " & Err.Source
WScript.Echo "Description: " & Err.Description
End Sub
'-----
Sub CreatePCOPYVBS(locationOfFile) 'creates PCOPY.VBS file.
Dim FSO, objFile
If VERBOSE = 1 Then WScript.Echo "Attempting to create PCOPY.VBS..." End If
Set FSO = CreateObject("Scripting.FileSystemObject") ' Sets the FSO Object for accessing Files
Set objFile = fso.CreateTextFile(locationOfFile, True)
objFile.Write("On Error Resume Next" & vbCrLf &_
"Wscript.Echo " & Chr(34) & "------AD PROFILE COPY--------" & Chr(34) & vbCrLf &_
"Wscript.Echo " & Chr(34) & "Checking if Logged in User is and Administrator.." & Chr(34) & vbCrLf &_
"Set FSO = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")" & vbCrLf &_
"Set WshShell = WScript.CreateObject(" & Chr(34) & "WScript.Shell" & Chr(34) & ")" & vbCrLf &_
"Set WshSysEnv = WshShell.Environment(" & Chr(34) & "PROCESS" & Chr(34) & ")" & vbCrLf &_
"If isAdmin = True Then" & vbCrLf &_
"Wscript.Echo " & Chr(34) & "User is Administrator, Starting Profile Copy..." & Chr(34) & vbCrLf &_
" oldProfile = " & Chr(34) & wshShell.ExpandEnvironmentStrings("%USERPROFILE%") & Chr(34) & vbCrLf &_
" oldUserName = " & Chr(34) & WshShell.ExpandEnvironmentStrings("%USERNAME%") & Chr(34) & vbCrLf &_
" newProfile = WshShell.ExpandEnvironmentStrings(" & Chr(34) & "%USERPROFILE%" & Chr(34) & ")" & vbCrLf &_
" newUserName = WshShell.ExpandEnvironmentStrings(" & Chr(34) & "%USERNAME%" & Chr(34) & ")" & vbCrLf &_
" Wscript.Echo " & Chr(34) & "old username was:" & Chr(34) & " & oldUserName" & vbCrLf &_
" Wscript.Echo " & Chr(34) & "new username was:" & Chr(34) & " & newUserName" & vbCrLf &_
" If oldProfile <> newProfile Then" & vbCrLf &_
" Wscript.Echo " & Chr(34) & "Old and New Profile's don't match, beginning Copy process.." & Chr(34) & vbCrLf &_
" MsgBox " & Chr(34) & "Copying your Previous Novell Profile to your new AD profile, " &_
"your system may seem slow or unresponsive for a few minutes depending on the size of your old profile..." & Chr(34) &_
" , 0, " & Chr(34) & "AD Profile Copy" & Chr(34) & vbCrLf &_
" Wscript.Echo " & Chr(34) & "Copying Desktop" & Chr(34) & vbCrLf &_
" CopyProfileFolder oldProfile & "& Chr(34) & "\desktop" & Chr(34) & ", newProfile " & vbCrLf &_
" Wscript.Echo " & Chr(34) & "Copying Favorites" & Chr(34) & vbCrLf &_
" CopyProfileFolder oldProfile & "& Chr(34) & "\favorites" & Chr(34) & ", newProfile" & vbCrLf &_
" Wscript.Echo " & Chr(34) & "Copying My Documents" & Chr(34) & vbCrLf &_
" CopyProfileFolder oldProfile & "& Chr(34) & "\my documents" & Chr(34) & ", newProfile " & vbCrLf &_
" Wscript.Echo " & Chr(34) & "Copying Start Menu" & Chr(34) & vbCrLf &_
" CopyProfileFolder oldProfile & "& Chr(34) & "\Start Menu" & Chr(34) & ", newProfile " & vbCrLf &_
" Wscript.Echo " & Chr(34) & "Copying Application Data" & Chr(34) & vbCrLf &_
" CopyProfileFolder oldProfile & "& Chr(34) & "\Application data" & Chr(34) & ", newProfile " & vbCrLf &_
" If FSO.FileExists(" & Chr(34) & "C:\desktop.reg" & Chr(34) & ") Then" & vbCrLf &_
" Wscript.Echo " & Chr(34) & "Importing old Registry Settings..." & Chr(34) & vbCrLf &_
" strOpenReg = " & Chr(34) & "REG add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DisableRegistryTools /t REG_DWORD /d 0 /f" & Chr(34) & vbCrLf &_
" strImportUserSettings = " & Chr(34) & "regedit /s C:\DESKTOP.REG" & Chr(34) & vbCrLf &_
" RunProgram strOpenReg, 2, True" & vbCrLf &_
" RunProgram strImportUserSettings, 2, True" & vbCrLf &_
" Else" & vbCrLf &_
" ElevateToError()" & vbCrLf &_
" End If" & vbCrLf &_
" Else" & vbCrLf &_
" ElevateToError()" & vbCrLf &_
" End If" & vbCrLf &_
" If Err.Number <> 0 Then ElevateToError() End If" & vbCrLf &_
" Wscript.Echo " & Chr(34) & "Cleaning up Script..." & Chr(34) & vbCrLf &_
" strCloseReg = " & Chr(34) & "reg add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System " &_
" /v DisableRegistryTools /t REG_DWORD /d 1 /f" & Chr(34) & vbCrLf &_
" RunProgram strCloseReg, 2, True" & vbCrLf &_
" MsgBox " & Chr(34) & "Your Previous Profile information was copied to your new AD Profile, your system will now reboot." &_
Chr(34) & ", 0, " & Chr(34) & "AD Profile Copy" & Chr(34) & vbCrLf &_
" Fso.DeleteFile" & chr(34) & "C:\Documents and Settings\All Users\Start Menu\Programs\Startup\PCOPY.lnk" & Chr(34) & ", True" & vbCrlf &_
" RunProgram " & Chr(34) & "Shutdown -r -t 60" & Chr(34) & ", 2, True" & vbCrLf &_
"Else" & vbCrLf &_
" MsgBox " & Chr(34) & "Your current User doesn't appear to have administrator rights, " &_
" sometimes this happens on the first login to Active Directory, The script will go ahead and reboot your PC," &_
" On the subsequent reboot your profile should copy over properly." & Chr(34) &_
" , 0, " & Chr(34) & "AD Profile Copy" & Chr(34) & vbCrLf &_
" RunProgram " & Chr(34) & "Shutdown -r -t 60" & Chr(34) & ", 2, True" & vbCrLf &_
"End If" & vbCrLf &_
"Wscript.Quit(0)" & vbCrLf &_
"'--------------------------------------" & vbCrLf &_
"Function isAdmin()" & vbCrLf &_
"On Error Resume Next" & vbCrLf &_
" Err.Clear" & vbCrLf &_
" FSO.CreateTextFile " & Chr(34) & "C:\test.txt" & Chr(34) & ", True" & vbCrLf &_
" If Err.Number = 0 Then" & vbCrLf &_
" isAdmin = True" & vbCrLf &_
" Else" & vbCrLf &_
" isAdmin = False" & vbCrLf &_
" End If" & vbCrLf &_
"End Function" & vbCrLf &_
"Sub CopyProfileFolder(sourceFolder, destinationFolder)" & vbCrLf &_
" Set oSHApp = CreateObject(" & Chr(34) & "Shell.Application" & Chr(34) & ")" & vbCrLf &_
" oSHApp.Namespace(destinationFolder).CopyHere sourceFolder, 16" & vbCrLf &_
" Set oSHApp = nothing " & vbCrLf &_
"End Sub" & vbCrLf &_
"Sub ElevateToError()" & vbCrLf &_
" MsgBox " & Chr(34) & "A Problem Occured in tranferring your old Novell profile to your new AD Profile." &_
" Please Contact Customer Support!" & Chr(34) & ", 0, " & Chr(34) & "AD Profile Copy" & Chr(34) & vbCrLf &_
" Wscript.Quit(0)" & vbCrLf &_
"End Sub" & vbCrLf &_
"Sub RunProgram(progName, windowMode, waitForReturn)" & vbCrLf &_
" wshShell.Run progName, windowMode, waitForReturn" & vbCrLf &_
"End Sub")
objFile.Close
'Adds to the startup folder to run after reboot. Requres 2 reboots to complete entire process...
Dim MyShortcut
Set MyShortcut = wshShell.CreateShortcut("C:\Documents and Settings\All Users\Start Menu\Programs\Startup\PCOPY.lnk")
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings("%windir%\system32\cscript.exe")
MyShortcut.Arguments = "C:\pcopy.vbs"
MyShortcut.WorkingDirectory = "C:\"
MyShortcut.WindowStyle = 1
MyShortcut.Save
If Err.Number <> 0 Then ' Error occured in the above code
DisplayError "An Error occurred creating the Profile Copy File, your profile may not" &_
"Transfer over. Contact Customer Service. Script Continuing.."
Err.Clear ' Script continues, Error is cleared...
End If
End Sub
Wednesday, January 2, 2013
NET SEND Replacement using msg.exe
Some our employees utilized the old Netware 'SEND' command to provide instant alerts to others in their office. They used this is a quick "I NEED HELP ASAP !!!" Button. As we transition to Windows 7, this no longer works, as well as Microsoft no longer supports the NET SEND command either. Their are paid alternatives you can buy, but a little utility called MSG.EXE, which is designed to send Terminal Server messages to others mostly on the same workstation/server can be used.
Credit goes to Pedro Lima for most of the script (pedrofln.blogspot.com/). I changed it up a little to send custom messages by way of command line argument and also send originator info (full name) of the message information and added a 15min display time. This is so the same script can be used for multiple messages, multiple people, and multiple office locations for deployment in SCCM.
I thought this requires local administrator permissions on the destination workstation, but in my testing it works without it, ymmv...
oh and one more thing, this registry key must be present for this to work: (Copy this into a reg file)
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server]
"AllowRemoteRPC"=dword:00000001
__________________________________________________________
' alert.vbs
' Script to send messages to network computers, like ancient net send
' Version 1.1a
' Version Release Date : 12/20/2012 (org 8/26/2011)
' Version Improvements : Script processing does not show various command prompt windows
' and progress messages are shown during processing, with no CPU stress.
' Edit: added command line arguments for custom messages, and user origination information
' By Pedro Lima (pedrofln.blogspot.com) (edited by Corey Sines 12-20-2012)
' ------------------------------------------------------------
If WScript.Arguments.count = empty Then
Call Usage()
Else
If WScript.Arguments.Count <> 1 Then
Call Usage()
End If
End If
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
Dim objShell, objSA, objArquivoTexto, objProcessEnv
Dim strContent, strCommand, strComputers, strMessage, strComputerss, strCall
Dim intCounter, intLines, intResponse
Dim objArgs, wshShell, userID, fullName
Set objShell = CreateObject("WScript.Shell")
Set objProcessEnv = objShell.Environment("Process")
Set objArgs = WScript.Arguments
userID = Ucase(objShell.ExpandEnvironmentStrings("%USERNAME%"))
fullName = Ucase(objShell.ExpandEnvironmentStrings("%FULLNAME%"))
strMessage = objArgs.Item(0)
strComputers = "computerlist.txt"
If instr(strComputers,":") then ' File above is not in the same folder as the script being called.
'Useful if you want to have a common network location to share a common list of Computers for an
' office, or organization.
' Routine to read a file containing a list of computers
Set objSA = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
intLines = 0
Set objArquivoTexto = objSA.OpenTextFile(strComputers, ForReading)
If Err.Number <> 0 then
Wscript.echo "The file specified does not exist. Try again with a correct path to the file. Exiting."
Wscript.Quit
End If
strContent = ObjArquivoTexto.ReadAll
intLines = Conta(strContent, chr(13), false)
Redim strComputerss(intLines+1)
For intCounter = 1 to intLines
strCall = GetLine(strContent, intCounter)
strComputerss(intCounter) = strCall
Set objShell = WScript.CreateObject( "WScript.Shell" )
strCommand = objShell.Run("cmd /c msg * /time:900 /server:" & strComputerss(intCounter) & " " & chr(34) & fullName & " says: " & strMessage & chr(34),0,True)
Set objShell = Nothing
Next
Wscript.Quit
End If
wscript.quit
'----------------------------------------------------------------------------------------------------------------
' Functions
'----------------------------------------------------------------------------------------------------------------
Function GetLine(strbuffer, Line)
Dim intEnd, strData, StrLine, IntLine
StrLine = StrBuffer
intEnd = InStr(strLine, Chr(13)) ' Get the initial position of ASCII 13 code (ENTER)
IntLine = 0
Do
IntLine = IntLine + 1
If intEnd > 0 Then
If IntLine = Line Then
strLine = Left(strLine, intEnd-1)
intEnd = InStr(strLine, Chr(13))
Else
StrLine = Mid(StrLine,IntEnd+2)
intEnd = InStr(strLine, Chr(13))
End If
Else
strLine = strLine
End If
Loop While IntLine < Line
GetLine = strLine
End Function
'--------------------------------------------------------------------------------------------------------------------
Function Conta(strText, strFind, fCaseSensitive)
Dim intCount, intPos, intMode
If Len(strFind) > 0 Then
' Configures the comparison mode.
If fCaseSensitive Then
intMode = vbBinaryCompare
Else
intMode = vbTextCompare
End If
intPos = 1
Do
intPos = InStr(intPos, strText, strFind, intMode)
If intPos > 0 Then
intCount = intCount + 1
intPos = intPos + Len(strFind)
End If
Loop While intPos > 0
Else
intCount = 0
End If
Conta = intCount+1
End Function
'-------------------------------------------------------------------------------------------------
Sub Usage()
WScript.Echo "Usage:" & vbNewLine &_
"wscript alert.vbs " & chr(34) & "message" & chr(34) & vbNewLine &_
"Note: Quotes are only necessary if there are spaces."
WScript.Echo "Example:" & vbNewLine &_
"wscript alert.vbs " & chr(34) & " Help there is someone threatening at my desk!" & chr(34)
WScript.Quit(0)
End Sub
Credit goes to Pedro Lima for most of the script (pedrofln.blogspot.com/). I changed it up a little to send custom messages by way of command line argument and also send originator info (full name) of the message information and added a 15min display time. This is so the same script can be used for multiple messages, multiple people, and multiple office locations for deployment in SCCM.
I thought this requires local administrator permissions on the destination workstation, but in my testing it works without it, ymmv...
oh and one more thing, this registry key must be present for this to work: (Copy this into a reg file)
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server]
"AllowRemoteRPC"=dword:00000001
__________________________________________________________
' alert.vbs
' Script to send messages to network computers, like ancient net send
' Version 1.1a
' Version Release Date : 12/20/2012 (org 8/26/2011)
' Version Improvements : Script processing does not show various command prompt windows
' and progress messages are shown during processing, with no CPU stress.
' Edit: added command line arguments for custom messages, and user origination information
' By Pedro Lima (pedrofln.blogspot.com) (edited by Corey Sines 12-20-2012)
' ------------------------------------------------------------
If WScript.Arguments.count = empty Then
Call Usage()
Else
If WScript.Arguments.Count <> 1 Then
Call Usage()
End If
End If
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
Dim objShell, objSA, objArquivoTexto, objProcessEnv
Dim strContent, strCommand, strComputers, strMessage, strComputerss, strCall
Dim intCounter, intLines, intResponse
Dim objArgs, wshShell, userID, fullName
Set objShell = CreateObject("WScript.Shell")
Set objProcessEnv = objShell.Environment("Process")
Set objArgs = WScript.Arguments
userID = Ucase(objShell.ExpandEnvironmentStrings("%USERNAME%"))
fullName = Ucase(objShell.ExpandEnvironmentStrings("%FULLNAME%"))
strMessage = objArgs.Item(0)
strComputers = "computerlist.txt"
If instr(strComputers,":") then ' File above is not in the same folder as the script being called.
'Useful if you want to have a common network location to share a common list of Computers for an
' office, or organization.
' Routine to read a file containing a list of computers
Set objSA = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
intLines = 0
Set objArquivoTexto = objSA.OpenTextFile(strComputers, ForReading)
If Err.Number <> 0 then
Wscript.echo "The file specified does not exist. Try again with a correct path to the file. Exiting."
Wscript.Quit
End If
strContent = ObjArquivoTexto.ReadAll
intLines = Conta(strContent, chr(13), false)
Redim strComputerss(intLines+1)
For intCounter = 1 to intLines
strCall = GetLine(strContent, intCounter)
strComputerss(intCounter) = strCall
Set objShell = WScript.CreateObject( "WScript.Shell" )
strCommand = objShell.Run("cmd /c msg * /time:900 /server:" & strComputerss(intCounter) & " " & chr(34) & fullName & " says: " & strMessage & chr(34),0,True)
Set objShell = Nothing
Next
Wscript.Quit
End If
wscript.quit
'----------------------------------------------------------------------------------------------------------------
' Functions
'----------------------------------------------------------------------------------------------------------------
Function GetLine(strbuffer, Line)
Dim intEnd, strData, StrLine, IntLine
StrLine = StrBuffer
intEnd = InStr(strLine, Chr(13)) ' Get the initial position of ASCII 13 code (ENTER)
IntLine = 0
Do
IntLine = IntLine + 1
If intEnd > 0 Then
If IntLine = Line Then
strLine = Left(strLine, intEnd-1)
intEnd = InStr(strLine, Chr(13))
Else
StrLine = Mid(StrLine,IntEnd+2)
intEnd = InStr(strLine, Chr(13))
End If
Else
strLine = strLine
End If
Loop While IntLine < Line
GetLine = strLine
End Function
'--------------------------------------------------------------------------------------------------------------------
Function Conta(strText, strFind, fCaseSensitive)
Dim intCount, intPos, intMode
If Len(strFind) > 0 Then
' Configures the comparison mode.
If fCaseSensitive Then
intMode = vbBinaryCompare
Else
intMode = vbTextCompare
End If
intPos = 1
Do
intPos = InStr(intPos, strText, strFind, intMode)
If intPos > 0 Then
intCount = intCount + 1
intPos = intPos + Len(strFind)
End If
Loop While intPos > 0
Else
intCount = 0
End If
Conta = intCount+1
End Function
'-------------------------------------------------------------------------------------------------
Sub Usage()
WScript.Echo "Usage:" & vbNewLine &_
"wscript alert.vbs " & chr(34) & "message" & chr(34) & vbNewLine &_
"Note: Quotes are only necessary if there are spaces."
WScript.Echo "Example:" & vbNewLine &_
"wscript alert.vbs " & chr(34) & " Help there is someone threatening at my desk!" & chr(34)
WScript.Quit(0)
End Sub
Finding the GroupWise Archive Location on each company workstation
I needed to find the GroupWise Archive Location, for my company, in the end we want to migration anyone that still has their archive on a local drive to a network drive. So the first step is identifying where their archive currently is. This setting isn't to be found anywhere on on the local PC, But you can see the setting in the GroupWise Client Settings. So I came up with this VB script that can locate it and copies it to the Windows Clipboard, and then display's it back to you. For this example it simply "echo"'s the results back, but you can use it for whatever action you want to take from there.
I Tested this on Groupwise 8 client we have here. You may have to adjust some sendkey actions depending on your version if it isn't found in the identical location under client properties. If you know of a better way to evaluate this, on a per client basis, leave a reply!
'-----------------------------------------------------------------
'Written by Corey Sines
'Version 1.0
'Purpose: Open's the GroupWise Client settings and reads the contents of the
' Archive Location into the Windows Clipboard.
' This setting is stored in the user.db file / GroupWise Sytem and I found
' no other way to retrieve this setting, on a per client basis, other
' than through the GroupWise Client options GUI.
'-----------------------------------------------------------------
'On Error Resume Next
Dim objShell, objHTML, ClipboardText
Set objShell = WScript.CreateObject("WScript.Shell")
' Terminates the process gwsync.exe if active, causes issues running groupwise client repeatedly
Const strComputer = "."
Dim objWMIService, colProcessList
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'gwsync.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
' Launches the groupwise client, does nothing if already launched.
objShell.Run "C:\Novell\GroupWise\grpwise.exe", 3, false
If Err.Number Then
Wscript.Echo "Unable Lauch GroupWise! Script Aborting!"
Wscript.Quit(1)
End If
Call RunAppLoop("Novell GroupWise - Mailbox") 'calls loop to bring the Groupwise client to Forground to sendkeys
' Sendkeys with sleep commands to allow for system delays
Wscript.Sleep 100
objShell.SendKeys "%T"
Wscript.Sleep 100
objShell.SendKeys "O"
Wscript.Sleep 100
objShell.SendKeys "{ENTER}"
Wscript.Sleep 100
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
Wscript.Sleep 100
objShell.SendKeys "{RIGHT}"
objShell.SendKeys "{RIGHT}"
Wscript.Sleep 100
objShell.SendKeys "{TAB}"
objShell.SendKeys "^C"
Wscript.Sleep 100
objShell.SendKeys "{ENTER}"
objShell.SendKeys "%C"
'Accessing data copied to the clipboard in the above action
Set objHTML = CreateObject("htmlfile")
ClipboardText = objHTML.ParentWindow.ClipboardData.GetData("text")
wscript.echo "GW Archive Location is set to: " & ClipboardText 'should display Archive location information
Set objShell = nothing
Set objHTML = nothing
wscript.quit(0)
'--------------------------------------------------------------------
Sub RunAppLoop(APPNAME) ' brings the desired application to the Forfront, loops till successful or timesout after 30 sec
Dim Success
Set objShell = WScript.CreateObject("WScript.Shell")
x = 1
Do Until Success = True or x = 300
objShell.AppActivate(APPNAME)
Success = objShell.AppActivate(APPNAME)
'Wscript.echo Success
'Wscript.echo "x = " & x
Wscript.Sleep 100
x = x + 1
Loop
if x = 300 then ' Sleep 100ms x 300 tries in the loop = 30 seconds
Wscript.echo "The Operation Timed out, unable to locate a running application named: " & APPNAME
Wscript.quit(1)
End if
End Sub
I Tested this on Groupwise 8 client we have here. You may have to adjust some sendkey actions depending on your version if it isn't found in the identical location under client properties. If you know of a better way to evaluate this, on a per client basis, leave a reply!
'-----------------------------------------------------------------
'Written by Corey Sines
'Version 1.0
'Purpose: Open's the GroupWise Client settings and reads the contents of the
' Archive Location into the Windows Clipboard.
' This setting is stored in the user.db file / GroupWise Sytem and I found
' no other way to retrieve this setting, on a per client basis, other
' than through the GroupWise Client options GUI.
'-----------------------------------------------------------------
'On Error Resume Next
Dim objShell, objHTML, ClipboardText
Set objShell = WScript.CreateObject("WScript.Shell")
' Terminates the process gwsync.exe if active, causes issues running groupwise client repeatedly
Const strComputer = "."
Dim objWMIService, colProcessList
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'gwsync.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
' Launches the groupwise client, does nothing if already launched.
objShell.Run "C:\Novell\GroupWise\grpwise.exe", 3, false
If Err.Number Then
Wscript.Echo "Unable Lauch GroupWise! Script Aborting!"
Wscript.Quit(1)
End If
Call RunAppLoop("Novell GroupWise - Mailbox") 'calls loop to bring the Groupwise client to Forground to sendkeys
' Sendkeys with sleep commands to allow for system delays
Wscript.Sleep 100
objShell.SendKeys "%T"
Wscript.Sleep 100
objShell.SendKeys "O"
Wscript.Sleep 100
objShell.SendKeys "{ENTER}"
Wscript.Sleep 100
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
objShell.SendKeys "{TAB}"
Wscript.Sleep 100
objShell.SendKeys "{RIGHT}"
objShell.SendKeys "{RIGHT}"
Wscript.Sleep 100
objShell.SendKeys "{TAB}"
objShell.SendKeys "^C"
Wscript.Sleep 100
objShell.SendKeys "{ENTER}"
objShell.SendKeys "%C"
'Accessing data copied to the clipboard in the above action
Set objHTML = CreateObject("htmlfile")
ClipboardText = objHTML.ParentWindow.ClipboardData.GetData("text")
wscript.echo "GW Archive Location is set to: " & ClipboardText 'should display Archive location information
Set objShell = nothing
Set objHTML = nothing
wscript.quit(0)
'--------------------------------------------------------------------
Sub RunAppLoop(APPNAME) ' brings the desired application to the Forfront, loops till successful or timesout after 30 sec
Dim Success
Set objShell = WScript.CreateObject("WScript.Shell")
x = 1
Do Until Success = True or x = 300
objShell.AppActivate(APPNAME)
Success = objShell.AppActivate(APPNAME)
'Wscript.echo Success
'Wscript.echo "x = " & x
Wscript.Sleep 100
x = x + 1
Loop
if x = 300 then ' Sleep 100ms x 300 tries in the loop = 30 seconds
Wscript.echo "The Operation Timed out, unable to locate a running application named: " & APPNAME
Wscript.quit(1)
End if
End Sub
Subscribe to:
Posts (Atom)