' Written by
' This script is called by its companion script TBCUpdate.vbs and performs the
' actual creation, comparison, and updating of the user's TBC Directory.
' The TBC Directory is populated from the TBC Directory public folder. That
' folder is populated via a scheduled task that runs on
' The scheduled task is called "Update TBC Directory Public Folder" and runs
'
' TBC Directory Update\UpdatePublicFolder\Adfind.bat" at 12:00 am daily.
' *** Check to see if the user is a member of the GPO_NoOLContacts group ***
Dim objADObject, strGroup, objGroupList, objSysInfo, strUser, objUser, wshNetwork
' Bind to the user object in Active Directory with the LDAP provider.
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
Set objADObject = GetObject(objUser.AdsPath)
Set wshNetwork = CreateObject("WScript.Network")
'strGroup = "GPO_NoOLContacts"
'If IsMember(strGroup) Then
' wscript.quit
'End If
if weekday(date) = vbsunday then
moddate = -4
end if
if weekday(date) = vbmonday then
moddate = -5
end if
if weekday(date) = vbtuesday then
moddate = -6
end if
if weekday(date) = vbwednesday then
moddate = 0
end if
if weekday(date) = vbthursday then
moddate = -1
end if
if weekday(date) = vbfriday then
moddate = -2
end if
if weekday(date) = vbsaturday then
moddate = -3
end if
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
Set objFSO = CreateObject("Scripting.FileSystemObject")
filedate = DateAdd("d", moddate, Date())
filedate = Replace(filedate,"/","-")
filename = "g:\TBC Directory - updated " & filedate & ".txt"
Set objFile = objFSO.OpenTextFile(filename,8)
objFile.WriteLine(Now() & " Running PublictoPrivate.vbs from machine: " & strComputerName)
Const olFolderContacts = 10
Const olPublicFoldersAllPublicFolders = 18
Dim olkApp, olkSes, olkContacts, olkPublic, olkContact, intIndex, olPV, olkPublicVersion, plkPersonalVersion
Wscript.echo "Checking TBC Directory."
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
' Find Outlook default profile name and start Outlook in that profile
profile = ReadReg("HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\DefaultProfile")
Wscript.echo "Connecting to default Outlook profile: " & profile
objFile.WriteLine(Now() & " Connecting to default Outlook profile: " & profile)
olkSes.Logon profile
' Create the TBC Directory if it doesn't exist
Set tbcFolder = olkSes.GetDefaultFolder(olFolderContacts)
On Error Resume Next
Set myNewFolder = tbcFolder.Folders.Add("TBC Directory")
if Err.number = 0 then myNewFolder.ShowAsOutlookAB = True
On Error GoTo 0
' Location of the user's TBC Directory folder
Set olkContacts = olkSes.GetDefaultFolder(olFolderContacts).Folders("TBC Directory")
' Location of the Public TBC Directory folder
Set olkPublic = olkSes.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("TBC Directory").Folders("TBC Directory")
' Find the version of the user's personal copy of the TBC Directory
' It looks for the only contact with an "*" in the last name
For intIndex = olkContacts.Items.count To 1 Step -1
olkPV = olkContacts.items(intIndex).lastname
if inStr(olkPV, "*") > 0 then
olkPersonalVersion = olkContacts.items(intIndex).lastname
exit for
end if
Next
' Find the version of the public folder copy of the TBC Directory
' It looks for the only contact with an "*" in the last name
For intIndex = 1 To olkPublic.Items.count Step +1
olkPV = olkPublic.items(intIndex).lastname
if inStr(olkPV, "*") > 0 then
olkPublicVersion = olkPublic.items(intIndex).lastname
exit for
end if
Next
wscript.echo "Personal version: " & olkPersonalVersion
wscript.echo "Public version : " & olkPublicVersion
objFile.WriteLine("")
objFile.WriteLine(Now() & " Personal version: " & olkPersonalVersion)
objFile.WriteLine(Now() & " Public version: " & olkPublicVersion)
' If the versions are not equal
if olkPublicVersion <> olkPersonalVersion then
' Delete all contacts
wscript.echo "Removing personal copy of the TBC Directory"
objFile.WriteLine(Now() & " Removing personal copy of the TBC Directory")
For intIndex = olkContacts.Items.count To 1 Step -1
olkContacts.Items.Remove intIndex
Next
wscript.echo "Total items in TBC Directory: " & olkContacts.Items.count
objFile.WriteLine(Now() & " Total items in TBC Directory: " & olkContacts.Items.count)
' Copy contacts from the public folder to the private folder
Set olkPublic = olkSes.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("TBC Directory").Folders("TBC Directory")
Wscript.echo "Updating " & olkPublic.Items.count & " TBC Directory Contacts..."
objFile.WriteLine(Now() & " Updating " & olkPublic.Items.count & " TBC Directory Contacts...")
For intIndex = olkPublic.Items.count To 1 Step -1
Set olkContact = olkPublic.Items(intIndex).Copy
olkContact.Unread = "False"
olkContact.Move olkContacts
if intIndex Mod 100 = 0 then
Wscript.echo "Only " & intIndex &" left."
objFile.WriteLine(Now() & " Only " & intIndex &" left.")
end if
if (intIndex < 100) and (intIndex Mod 25 = 0) then Wscript.echo "Only " & intIndex &" left."
Next
end if
Wscript.echo "Your local TBC Directory contains " & olkContacts.Items.count & " items and is up to date."
Wscript.echo ""
Wscript.echo "If someone is missing from the TBC Directory, please contact them and ask that "
Wscript.echo "they update their record in . More information can be found on "
Wscript.echo "IT's page."
Wscript.echo ""
Wscript.echo "This window will close shortly. Please wait while the server data is updated..."
objFile.WriteLine(Now() & " Your TBC Directory contains " & olkContacts.Items.count & " items and is up to date.")
objFile.WriteLine("---------------------------------------------------------------------------------------------")
objFile.WriteLine("")
Wscript.sleep(30000)
Set olkContacts = Nothing
Set olkPublic = Nothing
Set olkContact = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
Set objGroupList = Nothing
Set objADObject = Nothing
' Functions and Stuff
Function IsMember(strGroup)
' Function to test for group membership.
' strGroup is the NT name (sAMAccountName) of the group to test.
' objGroupList is a dictionary object, with global scope.
' Returns True if the user or computer is a member of the group.
If IsEmpty(objGroupList) Then
Call LoadGroups
End If
IsMember = objGroupList.Exists(strGroup)
End Function
Sub LoadGroups
' Subroutine to populate dictionary object with group memberships.
' objADObject is the user or computer object, with global scope.
' objGroupList is a dictionary object, with global scope.
Dim arrbytGroups, j
Dim arrstrGroupSids(), objGroup
Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare
objADObject.GetInfoEx Array("tokenGroups"), 0
arrbytGroups = objADObject.Get("tokenGroups")
If TypeName(arrbytGroups) = "Byte()" Then
ReDim arrstrGroupSids(0)
arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(0) _
& ">")
objGroupList(objGroup.sAMAccountName) = True
Set objGroup = Nothing
Exit Sub
End If
If UBound(arrbytGroups) = -1 Then
Exit Sub
End If
ReDim arrstrGroupSids(UBound(arrbytGroups))
For j = 0 To UBound(arrbytGroups)
arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(j) _
& ">")
objGroupList(objGroup.sAMAccountName) = True
Next
Set objGroup = Nothing
End Sub
Function OctetToHexStr(arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.
Dim k
OctetToHexStr = ""
For k = 1 To Lenb(arrbytOctet)
OctetToHexStr = OctetToHexStr _
& Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
Next
End Function
Function ReadReg(RegPath)
' Function to read string value of registry key
Dim objRegistry, Key
Set objRegistry = CreateObject("Wscript.shell")
Key = objRegistry.RegRead(RegPath)
ReadReg = Key
End Function
|
