#LL @ME

VBScript Open Internet Explorer with No Address Bar

Sometime you need to open IE with no address bar, like when you publish IE through Citrix XenApp: Below VBScript is the way to go:
Dim objIENoToolbars
Set objIENoToolbars = WScript.CreateObject ("InternetExplorer.Application")
ObjIENoToolbars.Toolbar = false
objIENoToolbars.Navigate "http://mywebsite.domain.com/"
objIENoToolbars.Visible = true 

SSRS SQL 2008 R2 Export Reports

I need to migrate reports from the old SSRS to the new one. To do this, I need to export all the reports as an RDL file and upload them all to the new SSRS server

Found this article by geektrainer.com how to create a VB script .rss file to exports all SQL Server Report file as an .rdl file.

Here is the code:

'must use -v rootPath="C:\Reports"
Sub Main()    
    Dim items As CatalogItem() = rs.ListChildren("/", true)

    For Each item As CatalogItem in items
        If item.Type = ItemTypeEnum.Folder Then
            CreateDirectory(item.Path)
        Else If item.Type = ItemTypeEnum.Report Then
            SaveReport(item.Path)
        End If
    Next
End Sub

Sub CreateDirectory(path As String)
    path = GetLocalPath(path)
    System.IO.Directory.CreateDirectory(path)
End Sub

Sub SaveReport(reportName As String)
    Dim reportDefinition As Byte()
    Dim document As New System.Xml.XmlDocument()
    
    reportDefinition = rs.GetReportDefinition(reportName)
    
    Dim stream As New MemoryStream(reportDefinition)
    document.Load(stream)
    document.Save(GetLocalPath(reportName) + ".rdl")
End Sub

Function GetLocalPath(rsPath As String) As String
    Return rootPath + rsPath.Replace("/", "\")
End Function

Save the code below as export.rss file, create a folder where the reports will be stored (e.g. C:\Reports) then run the RS.EXE command against your report server web service URL

rs.exe -i export.rss -s http://reportserver.domain.local/ReportServer -v rootPath="C:\Reports"

This will create all the reports in the .rdl format in the folder specified above



Remote Assistant with Mandatory Profile

By default, you cannot launch Remote Assistant to help a user who is running on Mandatory Profile. For example, running XenDesktop + AppSense + Mandatory Profile is a good mix of technologies - however when a user having problem, you won't be able to start Remote Assistant session to their XenDesktop session.

To fix this, use the following VBScript to modify the registry:

Option Explicit
Const HKLM = &H80000002

Dim objReg, strRegKey, strRegValue, strRegData, objAdInfo, objUser, username, objWMIService, objAccount, strComputer, wmipath, oShell, usersid, domain
strComputer = "."

Set oShell = CreateObject( "WScript.Shell" )

username = oShell.ExpandEnvironmentStrings("%UserName%")
domain = oShell.ExpandEnvironmentStrings("%UserDomain%")

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
wmipath = "Win32_UserAccount.Name='" & username & "',Domain='" & domain & "'"

Set objAccount = objWMIService.Get(wmipath)
usersid = objAccount.SID

Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ".\root\default:StdRegProv")
strRegKey = "Software\Microsoft\Windows NT\CurrentVersion\ProfileList\" & usersid & "\"

strRegValue = "State"
strRegData = "0"

objReg.SetStringValue HKLM, strRegKey, strRegValue, strRegData

WScript.Quit 0 'Return success

They way we do it, we attach this VBScript everytime the msra.exe process starts - this makes sure the "State" is set to 0 before the msra.exe process started

Script to do file cleanup

The following VBScript can be used to clean files of certain age:


-----------------------------

'* Specify the folder Name & Location here

Foldername="D:\DB Backup"

'* Specify how many days worth of Backup files you wanted to keep on the drive
Days = 7

'* Specify the Output fiel Name & location
LogFileName= "D:\CleanUp.txt"

Counter = 0

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set LogFile=objFSO.OpenTextFile(LogFileName,2,true)

LogFile.WriteBlankLines 1
LogFile.Writeline " **************************************************"
LogFile.Writeline " * Delete Backup files Older than 7 Days *"
LogFile.Writeline " **************************************************"
LogFile.WriteBlankLines 1
LogFile.Writeline " Backup Folder Name .........: " & Foldername
LogFile.Writeline " Deleting files older then...: " & Days & " days"
LogFile.Writeline " Output File ................: " & LogFileName
LogFile.Writeline " Date Deleted ...............: " & Date
LogFile.WriteBlankLines 2

Counter = ViewSubFolders(Foldername, LogFile)

LogFile.WriteBlankLines 3
LogFile.Writeline "Total Old file(s) Deleted.....: " & Counter
LogFile.WriteBlankLines 3

LogFile.Close


Function checkFolder(Foldername, LogFile)
Set objFolder = objFSO.GetFolder(Foldername)
Counter = 0
For Each file in objFolder.Files
FileName=file.name
FileFullName=Foldername & "\" & filename
Set objFile = objFSO.GetFile(FileFullName)

LastModifiedDate=objFile.DateLastModified

LogFile.Writeline "Checking: " & FileName & "," & LastModifiedDate

IsOld=DateCheck(LastModifiedDate)

If IsOld="old" then
objFSO.DeleteFile(FileFullName)
Counter = Counter + 1
LogFile.Writeline "Deleting: " & FileName & "," & LastModifiedDate
end if

FileName=null
FileFullName= null
LastModifiedDate= null
IsOld= null
Set objFile = Nothing
Next

checkFolder = Counter
End Function

Function ViewSubFolders(strFolder, LogFile)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)

Counter = 0

CounterX = checkFolder(strFolder, LogFile)
Counter = Counter + CounterX

For Each SubFolder in objFolder.SubFolders
CounterY = ViewSubFolders(SubFolder,LogFile)
Counter = Counter + CounterY
Next

Set objFolder = Nothing
Set objFSO = Nothing

ViewSubFolders = Counter
End Function

Function DateCheck(Lastmodified)
If DateDiff("d", lastmodified,date) > Days Then
DateCheck="old"
else
DateCheck="new"
end if
end Function



---------------------------

Exporting Active Directory Group Membership

Save this code as a .vbs file:

Dim objGroup, objUser, objFSO, objFile, strDomain, strGroup, Domain, Group

'user Input box
strDomain = Inputbox ("Enter the FQDN Domain name, e.g. domain.com", "Domain Name", "Domain Name")
strGroup = InputBox ("Enter the NetBIOS Group name, e.g. mygroup", "Group Name", "Group Name")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("C:\temp\" & strGroup & ".txt")
Set objGroup = GetObject("WinNT://" & strDomain & "/" & strGroup & ",group")

For Each objUser In objGroup.Members
objFile.WriteLine objUser.Fullname & " (" & objUser.Name & ")"
Next

objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Set objUser = Nothing
Set objGroup = Nothing

Wscript.Echo "Group Membership Exported to the file: " & "C:\temp\" & strGroup & ".txt"

Re-Mapping Shared Folders or Printers

When you are tasked to migrate a file/print server, you have 2 options - keep the same server name for the new server or use a new name.

Keeping the same server name is an easier solution - you can build a new server with a temp name, do whatever you need to do and when the cutover time, rename the old server name to something else and name the new server to the old server name.

However, this approach is not always an option for you. If you need to use a different name for your new server, you need to somehow re-map all the shared folders and printers to the new file/print server.

Here is the script to map the printers:

' Full path to text file containing list of printer share names. e.g.
' OldPrinter1,NewPrinterA

Const PRINTERS_FILE = "\\server\printers$\new-printers.csv"

'Old and new Printer Server information
Const OLD_SERVER = "\\oldservername"
Const NEW_SERVER = "\\newservername"

'Create something to store the list of printers in
Set objPrinters = CreateObject("Scripting.Dictionary")

'Open the File in Read Only mode
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystem.OpenTextFile(PRINTERS_FILE, 1, False, 0)

Do While Not objFile.AtEndOfStream
arrLine = Split(objFile.ReadLine, ",")

' Load each printer entry into memory (keyed list, key is the old printer name)
If Not objPrinters.Exists(arrLine(0)) Then
objPrinters.Add LCase(arrLine(0)), LCase(arrLine(1))
End If

Loop

Set objFile = Nothing
Set objFileSystem = Nothing
Set objWSH = CreateObject("WScript.Network")

On Error Resume Next

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer WHERE Network=True",,48)

For Each objPrinter in colItems
If UCase(objPrinter.ServerName) = UCase(OLD_SERVER) Then
strPrinter = LCase(objPrinter.ShareName)
strOldPrinterPath = objPrinter.ServerName & "\" & strPrinter

'Remove any printer still connected to OLD_SERVER
objWSH.RemovePrinterConnection strOldPrinterPath, True, True

'See if the old Printer exists in the file (from memory)
If objPrinters.Exists(strPrinter) Then

' Create the new Printer Path
strNewPrinterPath = NEW_SERVER & "\" & objPrinters(strPrinter)
Err.Clear

' Add the new Printer Connection
objWSH.AddWindowsPrinterConnection strNewPrinterPath

If objPrinter.Default = "True" Then
objWSH.SetDefaultPrinter strNewPrinterPath
End If
End If
End If
Next

Set colItems = Nothing
Set objWMIService = Nothing
Set objWSH = Nothing
Set objPrinters = Nothing

Here is the script to map the shared folder:

' Full path to text file containing list of share names. e.g.
' OldShared,NewShared Const
SHARES_FILE = "\\server\printers$\new-shares.csv"

' Old and new Server information
Const OLD_SERVER = "oldserver"
Const NEW_SERVER = "newserver"

' Create something to store the list of shares in
Set objShares = CreateObject("Scripting.Dictionary")

' Open the File in Read Only mode
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystem.OpenTextFile(SHARES_FILE, 1, False, 0)

Do While Not objFile.AtEndOfStream
arrLine = Split(objFile.ReadLine, ",")

' Load each shares entry into memory (keyed list, key is the old printer name)
If Not objShares.Exists(arrLine(0)) Then
objShares.Add LCase(arrLine(0)), LCase(arrLine(1))
End If
Loop

Set objFile = Nothing
Set objFileSystem = Nothing

'Create a filesystem object
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

'Create a drives collection
Set Drives = FileSystemObject.Drives

Dim objNetwork, strDriveLetter
Set objNetwork = CreateObject("WScript.Network")

'step through the drive collection, and extract'the drive letter and the type of drive
'according to the Microsoft VBScript documentation'there are 6 distinct types of drive

For Each DiskDrive in Drives
DriveLetter = DiskDrive.DriveLetter
DriveType = DiskDrive.DriveType

strDriveLetter = DriveLetter & ":"

Select Case DriveType
Case "0" DriveType = "Unknown type of drive"
Case "1" DriveType = "Removable drive"
Case "2" DriveType = "Fixed drive"
Case "3" DriveType = "Network drive"
Path = DiskDrive.ShareName
'get the server name of this shared folder
Temp = Right( Path, Len( Path ) - 2 )
IndexOfSlash = InStr( Temp, "\" )

OldServerName = Left( Temp, IndexOfSlash - 1 )

'get the shared name
OldSharedName = Right( Temp, Len( Temp ) - Len(OldServerName) - 1 )

'we only touch the shared folder in the old server
If UCase( OldServerName ) = UCase( OLD_SERVER ) Then
'is this the old shared name
If objShares.Exists( OldSharedName ) Then
'delete the old mapping drive
objNetwork.RemoveNetworkDrive strDriveLetter, True, True

strNetworkPath = "\\" & NEW_SERVER & "\" & objShares(OldSharedName )

'sleeping for a while
WScript.sleep 3000

'map the new drive persistently
objNetwork.MapNetworkDrive strDriveLetter, strNetworkPath, True
End If
End If
Case "4" DriveType = "CD-ROM drive"
Case "5" DriveType = "RAM Disk"
End Select
Next

Set Drives = nothing
Set FileSystemObject = nothing
Set objNetwork = nothing
Set objShares = nothing

Good Luck

Find the users' OU from Active Directory

If you need to find the Active Directory user accounts' OU, run the following script:

Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")

objConnection.Provider = "ADsDSOObject"objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection


objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

REM get the filename
If WSCript.Arguments.Count <> 1 Then
WScript.Echo "Text file contains user accounts must be supplied"
WScript.Quit 0
End If

dim filenamefilename = WScript.Arguments.Item(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")

Const ForReading = 1

Set objFile = objFSO.OpenTextFile (filename, ForReading)

i = 0
Do Until objFile.AtEndOfStream
strNextLine = objFile.Readline
If strNextLine <> "" Then
getOu strNextLine
End If

i = i + 1
Loop

objFile.Close

REM Sub to get username OU


Sub getOu( username )
objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://dc=domain,dc=com'" & "WHERE objectCategory='user' " & "AND sAMAccountName='" & username & "'"

Set objRecordSet = objCommand.Execute

If objRecordSet.EOF Then
WScript.Echo username & " does not exist "
Else
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("distinguishedName").Value
arrPath = Split(strDN, ",")
dim uOu

for each ou in arrPath
if Left( ou, 3 ) = "OU=" Then
if uOu = "" Then
uOu = ou
else

uOu = uOu & "," & ou
end if

end if
Next


uOu = username & " : " & uOu
Wscript.Echo uOu

objRecordSet.MoveNext
Loop
End If
End Sub

copy the above code to .vbs file (e.g. getOu.vbs). You also need to change the domain name from the LDAP query to your domain name in the code above.

Next, you need to create a text file just having a username per-line, e.g. users.txt

bgates
dduck

Next, run the the following:

cscript getOu.vbs c:\users.txt

Restart Server Remotely

Do you want to give permission to other people to restart your server remotely? All they can do is to restart the server - nothing else. Here is how you do it:

  • Create a local user in the server
  • Create a local group in the server, and assign the new user to this group
  • Add the user to the built-in Remote Desktop Users group
  • Assign the new group to the local policy to be able to login through Terminal Service and Shutdown the server
  • Create a reboot VBScript - call it r.vbs

Option Explicit
Dim Reboot
Dim Cancel
Dim objShellSet

objShell = WScript.CreateObject("Wscript.Shell")
Reboot = msgBox("You are about to reboot the server now. Click YES to confirm or NO to cancel", 4, "Confirm Reboot Server")

If Reboot = 6 Then
objShell.Run "cmd /c C:\windows\system32\shutdown -r -f -t 30", 0, True

Cancel = msgBox("To cancel the reboot, Click YES now", 4, "Cancel Reboot")

If Cancel = 6 Then
objShell.Run "cmd /c C:\windows\system32\shutdown -a", 0, True
End If
End If

  • Create a wrapper batch file - call it a.cmd

@echo off
cscript r.vbs

  • Assign the new user environment properties to run the a.cmd when they login through terminal service

Get the users' memberOf from Active Directory

Sometime you need to do an audit of your Enterprise users and make sure they are a member of the proper security group and distribution list within your Active Directory.

Here is the code in VBScript and talking to AD with LDAP:

On Error Resume Next
Dim OutPutFileDim FileSystem

Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("users.txt", True)

'-- Number value of the error return by ADSI if the '-- memberOf attribute cannot be found.
'==================================================
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D

'-- Bind to the Users container'==============================
Set objOU = GetObject("LDAP://OU=Users,dc=domain,dc=com")

'-- Initialize the array for user accounts.
'==========================================
ObjOU.Filter= Array("user")

'-- Control Loop
'===============
For Each objUser in objOU
OutPutFile.WriteLine objUser.cn & " is a member of: "

'-- Use the GetEX method to intialize the array for group
'-- membership. Get method cannot be used as it does not
'-- multivalued attributes (user can be member of many groups.)
'============================================================== arrMemberOf = objUser.GetEx("memberOf")

'-- If the error is not raised from ADSI, then list the
'-- groups that are entries within the arrMemberOf array.
'-- If error is raised, display notification on screen.
'========================================================
If Err.Number <> E_ADS_PROPERTY_NOT_FOUND Then
For Each Group in arrMemberOf
OutPutFile.WriteLine vbTab & Group
Next
Else
Err.Clear
End If
Next

'Clean up
OutPutFile.CloseSet
FileSystem = Nothing