TomRiddle
-
Total Posts
:
535
- Scores: 7
-
Reward points
:
0
- Joined: 2/7/2008
- Location: Australia
-
Status: offline
|
RE: Find PST files configured in outlook
-
Thursday, July 24, 2008 6:21 PM
( #13 )
if you are going to re-profile a user you will want to do it from their machine, but if their profile is messed up or they are not logged in this script probably would not work. I was thinking of writing a script that gets all profile settings, but there is a couple in Outlook I could not work out so thought it pointless to get some by script but not all. Anyway I hacked on a bit of code I have used in the last couple of my scripts onto to this script to get the PST files in use on a remote machine. Have not tidied it up so it is a bit messy but it works. Basically I added a prompt for remote computer and then find user logged into that machine, then his SID and then changed HKEY_CURRENT_USER everywhere to HKEY_USERS then query runs on remote machine.
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_USERS = &H80000003
Const r_PSTGuidLocation = "01023d00"
Const r_MasterConfig = "01023d0e"
Const r_PSTCheckFile = "00033009"
Const r_PSTFile = "001f6700"
Const r_keyMaster = "9207f3e0a3b11019908b08002b2a56c2"
Const r_DefaultProfileString = "DefaultProfile"
Dim oReg, strComputer
Dim arrSubKeys, subkey, strValue, i, pstFile, arrPSTs, DefaultProfileName
strComputer = inputbox("Enter Remote Computer name to find PST files in use on that computer")
CU=GetCurrentUser(strComputer)
CUSID = GetSIDFromUser(CU)
r_ProfilesRoot = CUSID&"\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
oReg.GetStringValue HKEY_USERS,r_ProfilesRoot,r_DefaultProfileString,DefaultProfileName
GetPSTsForProfile(DefaultProfileName)
'_____________________________________________________________________________________________________________________________
Function GetPSTsForProfile(p_profileName)
Dim strHexNumber, strPSTGuid, strFoundPST
oReg.GetBinaryValue HKEY_USERS,r_ProfilesRoot & "\" & p_profileName & "\" & r_keyMaster,r_MasterConfig,strValue
For Each i In strValue
If Len(Hex(i)) = 1 Then
strHexNumber = CInt("0") & Hex(i)
Else
strHexNumber = Hex(i)
End If
strPSTGuid = strPSTGuid + strHexNumber
If Len(strPSTGuid) = 32 Then
If IsAPST(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) Then
Wscript.Echo PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & _
PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid))
End If
strPSTGuid = ""
End If
Next
End Function
'_____________________________________________________________________________________________________________________________
Function IsAPST(p_PSTGuid)
Dim x, P_PSTGuildValue
Dim P_PSTCheck:P_PSTCheck=0
IsAPST=False
oReg.GetBinaryValue HKEY_USERS,p_PSTGuid,r_PSTCheckFile,P_PSTGuildValue
For Each x in P_PSTGuildValue
P_PSTCheck = P_PSTCheck + Hex(x)
Next
If P_PSTCheck=20 Then
IsAPST=True
End If
End Function
'_____________________________________________________________________________________________________________________________
Function PSTlocation(p_PSTGuid)
Dim y, P_PSTGuildValue
oReg.GetBinaryValue HKEY_USERS,p_PSTGuid,r_PSTGuidLocation,P_PSTGuildValue
For Each y In P_PSTGuildValue
If Len(Hex(y)) = 1 Then
PSTlocation = PSTlocation & CInt("0") & Hex(y)
Else
PSTlocation = PSTlocation & Hex(y)
End If
Next
End Function
'_____________________________________________________________________________________________________________________________
Function PSTFileName(p_PSTGuid)
Dim z, P_PSTName
Dim strString : strString = ""
oReg.GetBinaryValue HKEY_USERS,p_PSTGuid,r_PSTFile,P_PSTName
For Each z in P_PSTName
If z > 0 Then strString = strString & Chr(z)
Next
PSTFileName = strString
End Function
'_________________________________________________________________________________________________________
Function ExpandEvnVariable(ExpandThis)
Dim objWSHShell :Set objWSHShell = CreateObject("WScript.Shell")
ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%")
End Function
'_________________________________________________________________________________________________________
Function GetCurrentUser(strComputer)
'Input: strComputer = machine to query
'Output: Current User as domain\logon
'Only works on XP/W2003
on error resume next
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'explorer.exe'")
For Each objProcess in colProcessList
objProcess.GetOwner strUserName, strUserDomain
Next
GetCurrentUser = strUserDomain & "\" & strUserName
if err<> 0 then
Msgbox " Error accessing remote machine"
wscript.quit
end if
on error goto 0
End Function
'-----------------------------------------------------------------------
Function GetSIDFromUser(UserName)
'Input: UserName as domain\logon
'Output: SID
Dim DomainName, Result, WMIUser
If InStr(UserName, "\") > 0 Then
DomainName = Mid(UserName, 1, InStr(UserName, "\") - 1)
UserName = Mid(UserName, InStr(UserName, "\") + 1)
Else
DomainName = CreateObject("WScript.Network").UserDomain
End If
On Error Resume Next
Set WMIUser = GetObject("winmgmts:{impersonationlevel=impersonate}!" _
& "/root/cimv2:Win32_UserAccount.Domain='" & DomainName & "'" _
& ",Name='" & UserName & "'")
If Err = 0 Then
Result = WMIUser.SID
Else
msgbox "Error retrieving SID"
wscript.quit
end if
On Error GoTo 0
GetSIDFromUser = Result
End Function
'-----------------------------------------------------------------------
|