Solved

Vbscript and Trusted Locations - Listing/checking exising ones before adding

Posted on 2013-10-24
5
427 Views
Last Modified: 2013-10-30
I've found several good examples of adding a registry entry for trusted locations and have most of a script cobbled together.  However, I'd like the script to check and make sure that the Trusted Location I'm trying to add isn't already in the user's list of Trusted Locs before I add it.  This routine is ideally going to be added to a startup script we are already running to get users' drives mapped in a split/untrusted network situation, and I don't want to keep adding duplicates of the trusted locations.  These machines may have their profiles or images wiped by the Other Entity which manages most of our desktops, so it would be good to have these refreshed automatically.

I want to have the body of the script iterate through the existing mapped drives and add those and their MyDocuments folder (with subfolders) using a function that passes the app and the path *if* they haven't already been added. The only part I haven't figured out is how to check to see if a supplied path is already in the TLs for the supplied application.

This script will be run on Windows 7 Enterprise with Office 2007.

Help appreciated... thanks.
0
Comment
Question by:jaw0807
  • 3
  • 2
5 Comments
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Hi, can you provide some code that adds a path to the trusted locations area you are talking about?  If they're registry keys, we can use EnumKeys and EnumValues methods to test for existing strings.

Regards,

Rob.
0
 

Author Comment

by:jaw0807
Comment Utility
Thanks Rob.  Here's what I've got.   I confess that I don't fully understand what's happening here (registry is not in my wheelhouse) but I'm usually pretty good at synthesizing in what others have written.   (I mostly do database work)

One of the 'problems' here is how the code is finding the maximum location folder number.  

Const HKEY_CURRENT_USER = &H80000001

dim wsh
dim fso
dim netwk
Dim HasTL
Dim drvs
Dim drv
Dim strPath
Dim oReg
Dim msg 
Dim tHold
Dim PathExists
Dim cPath
Dim cPkey
Dim RegTop
Dim intLocns

set wsh = CreateObject("WScript.Shell")
set fso = createobject("Scripting.FileSystemObject")
Set netwk = CreateObject("WScript.NetWork") 
'Set oReg = CreateObject("WScript.Shell")
Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")

u=netwk.username
m=netwk.computername
DT=wsh.specialfolders("Desktop")
MD=wsh.specialfolders("MyDocuments")

AddTrustedLocation "Excel",MD,"My Documents"
AddTrustedLocation "Access",MD,"My Documents"
AddTrustedLocation "Excel",MD,"My Desktop"
AddTrustedLocation "Access",MD,"My Desktop"

Set drvs = fso.Drives
For Each drv In drvs
	If drv.DriveType=3 Then
		AddTrustedLocation "Excel",drv.DriveLetter & ":\",drv.Path
		AddTrustedLocation "Access",drv.DriveLetter & ":\",drv.Path
	End If
Next

WScript.Echo msg


Set drvs=Nothing
Set netwk=Nothing
Set fso=Nothing
Set oReg=Nothing


Sub AddTrustedLocation(TLApp, TLPath, TLDescr)


blnAllowSubFolders = True
blnAllowNL=True
strParentKey = "Software\Microsoft\Office\12.0\" & TLApp & "\Security\Trusted Locations"
'strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\" & TLApp & "\Security\Trusted Locations\Location"

intLocCounter = 0
oReg.SetDWORDValue HKEY_CURRENT_USER, strParentKey, "AllowNetworkLocations", 1
oReg.EnumKey HKEY_CURRENT_USER, strParentKey, arrChildKeys
'next fails if there are zero truted locations 
'detects correct max number for Access but not for Excel--new folder numbers start much higher when you look in the registry
'after running this. Not sure if it's a problem
For Each strChildKey in arrChildKeys
	curKi=CInt(Mid(strChildKey, 9)) 
    If CInt(Mid(strChildKey, 9)) > intLocCounter Then
	intLocCounter = CInt(Mid(strChildKey, 9))
	End If
Next


'HasTL=[T/F result of either a separate function or something else I'm doing in this one
'that will tell me whether the path is already a Trusted Location for this user and app
'and can be skipped]

'If hastl=False Then
	strNewKey = strParentKey & "\Location" & CStr(intLocCounter + 1)
	oReg.CreateKey HKEY_CURRENT_USER, strNewKey
	oReg.SetStringValue HKEY_CURRENT_USER, strNewKey, "Path", TLPath
	oReg.SetStringValue HKEY_CURRENT_USER, strNewKey, "Description", TLDescr
	If blnAllowSubFolders Then
	    oReg.SetDWORDValue HKEY_CURRENT_USER, strNewKey, "AllowSubFolders", 1
	End If
	msg=msg & vbCrLf & tlpath & " was added to your Trusted Locations for " & tlapp	
'Else
'	msg=msg  & vbCrLf & tlpath & " was already in your trusted locations for " & tlapp
'End If


		
End Sub	
	
	
	

Open in new window



I was also able to get a separate script to [mostly] work to  list the current Trusted Locations from a completely nutty, badly formed VBA sub someone posted somewhere.  I  had to rem out the Excel part due to the number problem there.  The registry object here is declared differently from the first script.

Dim oReg 
Dim wsh
dim fso
dim netwk
Dim RegTop
Dim tHold
Dim tList
Dim i
Dim intLocns
Dim PathExists
descr="Testing H: drive trust"
set wsh = CreateObject("WScript.Shell")
Set fso = createobject("Scripting.FileSystemObject")
Set netwk = CreateObject("WScript.NetWork") 
u=netwk.username
m=netwk.ComputerName

TLPath="H:\"		'path being checked for

TLApp="Access"	
msg=msg & vbcrlf & vbcrlf & "Checking " & TLApp
 
'strPath = path        'CurrentProject.Path

strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\" & TLApp & "\Security\Trusted Locations\Location"
    
'RegTop is a hard value that I know is not greater than the number of existing  TLs after running the other script
'this one is quick and dirty so I didn't bother with finding the maximum registry key as in the other script, but 
'thats what RegTop should be.

RegTop=10
For intLocns = 1 To RegTop
    tHold=wsh.RegRead(strLnKey & intLocns & "\Path")
	msg=msg & vbcrlf & intlocns & "-" & tHold
    'If Path already in registry -> exit
    If InStr(1, wsh.RegRead(strLnKey & intLocns & "\Path"), TLpath) = 1 Then 
    	PathExists="Has path " & TLPATH & " in " & TLApp
    	msg=msg & vbCrLf & PathExists
    End If
Next

'This doesn't work if folder numbers are discontinuous--remmed it out.
'TLApp="Excel"	
'msg=msg & vbcrlf & vbcrlf & "Checking " & TLApp


'RegTop=7
'For intLocns = 1 To RegTop
'    tHold=wsh.RegRead(strLnKey & intLocns & "\Path")
'	msg=msg & vbcrlf & intlocns & "-" & tHold
    'If Path already in registry -> exit
'    If InStr(1, wsh.RegRead(strLnKey & intLocns & "\Path"), TLpath) = 1 Then 
'    	PathExists="Has path " & TLPATH & " in " & TLApp
'    	msg=msg & vbCrLf & PathExists
'    End If
'Next

WScript.Echo msg

Open in new window



I can't mash these together and have them work.  It's driving me nuts.  Because I don't fully get the registry stuff I can't make better guesses about how to fix it.    What I need is a way to to check whether the supplied folder already exists under that app's locations.  Hope this makes sense.

Thanks for any help you can provide!
0
 

Accepted Solution

by:
jaw0807 earned 0 total points
Comment Utility
You know what, never mind--I found the rest of my answer right here:

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_10805-Overcome-the-Trust-Center-Nuisance.html

Don't know why that didn't pop up when I was looking yesterday!  That is the first and only unified example I've seen of someone who built in a check for pre-existing locations.  

Here was my ultimate solution:

Option Explicit

Const HKEY_CURRENT_USER = &H80000001

Dim strProgram
Dim strFolder
Dim strDescription
Dim blnAllowSubFolders             
Dim blnAllowNetworkLocations
Dim blnCurrentTrusted
Dim strParentKey
Dim objRegistry
Dim intHighest
Dim arrChildKeys
Dim strChildKey
Dim strValueName
Dim strNewKey
Dim strFullPath
Dim strValue

dim wsh
dim fso
Dim drvs
Dim drv
Dim oReg
Dim msg 
Dim tHold
Dim PathExists
Dim cPath
Dim cPkey
Dim RegTop
Dim intLocns
Dim TLApp
Dim TLPath 
Dim TLDescr
Dim DT
Dim MD

set wsh = CreateObject("WScript.Shell")
set fso = createobject("Scripting.FileSystemObject")
DT=wsh.specialfolders("Desktop")
MD=wsh.specialfolders("MyDocuments")

AddTrustedLocation "Excel",MD,"My Documents"
AddTrustedLocation "Access",MD,"My Documents"
AddTrustedLocation "Excel",DT,"My Desktop"
AddTrustedLocation "Access",DT,"My Desktop"

Set drvs = fso.Drives
For Each drv In drvs
	If drv.DriveType=3 Then
		AddTrustedLocation "Excel",drv.DriveLetter & ":\",drv.Path
		AddTrustedLocation "Access",drv.DriveLetter & ":\",drv.Path
	End If
Next

WScript.Echo msg


Set drvs=Nothing
Set fso=Nothing
Set objRegistry=Nothing




Sub AddTrustedLocation(TLApp, TLPath, TLDescr)



strProgram = TlApp                          'Name of Microsoft program that's being set for
strFolder = TLPath           'Path to set as a Trusted Location
strDescription = TLDescr   'Description of the Trusted Location
blnAllowSubFolders = True                   'Trust sub folders (True or False)
blnAllowNetworkLocations = True       'Trust a network location (True or False)

strParentKey = "Software\Microsoft\Office\12.0\" & strProgram & "\Security\Trusted Locations"
intHighest = -1
blnCurrentTrusted = False

Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")

objRegistry.EnumKey HKEY_CURRENT_USER, strParentKey, arrChildKeys
'get the highest key number'
On Error Resume Next
For Each strChildKey In arrChildKeys
	If Left(strChildKey,8)="Location" Then
		If CInt(Mid(strChildKey, 9)) > intHighest Then
			intHighest = CInt(Mid(strChildKey, 9))
		End If
		
		'check to see if the folder is already trusted' 
		strValueName = "Path"
		strFullPath = strParentKey & "\" & strChildKey
		objRegistry.GetExpandedStringValue HKEY_CURRENT_USER,strFullPath,strValueName,strValue
		If strValue = strFolder Then
			blnCurrentTrusted = True
		End If
	End If
Next

If blnCurrentTrusted Then
	'MsgBox """ & strFolder & """ & " is already a Trusted Location.", vbInformation
	msg=msg & vbCrLf & strFolder & " is already a trusted " & strProgram & " location."
Else
	'add new'
	If intHighest = 999 Then
		MsgBox "Location count exceeded - unable to write trusted location to registry", vbInformation
	Else
		strNewKey = strParentKey & "\Location" & CStr(intHighest + 1)
		
		objRegistry.CreateKey HKEY_CURRENT_USER, strNewKey
		objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Path", strFolder
		objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Description", strDescription
		objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Date", CStr(Now())
		
		If blnAllowSubFolders Then
			objRegistry.SetDWORDValue HKEY_CURRENT_USER, strNewKey, "AllowSubFolders", 1
		End If
		
		If blnAllowNetworkLocations Then
			objRegistry.SetDWORDValue HKEY_CURRENT_USER, strParentKey, "AllowNetworkLocations", 1
		End If
		
		'MsgBox """ & strFolder & """ & " added as a Trusted Location.", "Success"
		msg=msg & vbCrLf & strFolder & " added as a trusted " & strProgram & " location."
	End If
End If 

End sub

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Yep, great. That's a nice piece of code. Good find.
0
 

Author Closing Comment

by:jaw0807
Comment Utility
I was able to resolve the issue by incorporating parts of code found elsewhere on this site.
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

As with any other System Center product, the installation for the Authoring Tool can be quite a pain sometimes. This article serves to help you avoid making these mistakes and hopefully save you a ton of time on troubleshooting :)  Step 1: Make sur…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
The viewer will learn how to create a basic form using some HTML5 and PHP for later processing. Set up your basic HTML file. Open your form tag and set the method and action attributes.: (CODE) Set up your first few inputs one for the name and …

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now