;; KixGenerated: 2008/03/25 13:02:52 
; outlook mail archiving migration tool 
; Glenn Barnas - 2008/03/24 
; This script is designed to run during the logon process and perform the following actions: 
;  * Terminate Outlook, if running 
;  * Locate all PST files associated with the current user 
;  * Disassociate PST files from outlook This can be done for all PSTs, or only those stored on network drives 
;  * rename the PST file so users/Outlook cannot readily reopen it 
;  * log the location of the PST file(s) in UNC format 
 
 
 
Break On
 
Dim $, $_					; temp, throwaway var 
Dim $aPSTPaths[0]				; Array of PST paths 
Dim $aPSTKeys[0]				; Array of PST key paths 
Dim $RootPath					; registry root path 
Dim $WKey					; working key path 
Dim $EKey					; enumerated registry path 
Dim $TVal					; temp value for 
Dim $aIndex, $eIndex				; index pointers for array and enumeration 
Dim $MServer, $DName, $DProfile			; user data vars 
Dim $aMapped					; array of mapped network drives 
Dim $Drv, $NetFlag, $IsNet, $MoveFlag		; Drive letter enumerator, Network Only flag, IsNetwork flag, Move Flag 
Dim $PSTName, $PSTPath				; name & Path of current PST file 
Dim $NewPSTName, $NewPSTPath			; name of renamed PST file or new Path 
Dim $NewPSTRoot					; path of new PST path, when moving instead of renaming 
Dim $LogPath					; UNC path where logs are written 
 
 
$ = SetOption('Explicit', 'On')
$ = SetOption('WrapAtEOL', 'On')
$ = SetOption('NoVarsInStrings', 'On')
$ = SetOption('NoMacrosInStrings', 'On')
 
; # # # # # START OF CUSTOM PARAMETERS # # # # # 
$NetFlag = 0					; only process network PST files if 1 
$MoveFlag = 1					; Move files if 1, otherwise disassociate and rename 
$LogPath = '\\server\share\folder'		; UNC path where renamed PST file locations are logged 
$NewPSTRoot = '\\server\share\'			; UNC or mapped drive  
; # # # # #  END OF CUSTOM PARAMETERS  # # # # # 
 
 
$RootPath = 'HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles'
 
; get list of mapped drives 
$aMapped = WMIMappedDrives()
 
$DProfile = ReadValue($RootPath, 'DefaultProfile')
$WKey = $RootPath + '\' + $DProfile + '\'
 
$MServer = ReadValue($WKey + '13dbb0c8aa05101a9bb000aa002fc45a', '001e6602')
$DName   = UtoA(ReadValue($WKey + '13dbb0c8aa05101a9bb000aa002fc45a', '001f3001'))
 
; find the PST files associated with this profile - need to enumerate each subkey and find the 001f6700 value 
$eIndex = 0
$aIndex = -1
$EKey = EnumKey($WKey, $eIndex)
While Not @ERROR
  $TVal = UtoA(ReadValue($WKey + $EKey, '001f6700'))
  If $TVal
    $aIndex = $aIndex + 1
    ReDim Preserve $aPSTPaths[$aIndex]
    ReDim Preserve $aPSTKeys[$aIndex]
    $aPSTPaths[$aIndex] = $TVal
    $aPSTKeys[$aIndex] = $WKey + $EKey
  EndIf
  $eIndex = $eIndex + 1
  $EKey = EnumKey($WKey, $eIndex)
Loop
 
; Exit if nothing to do 
If $aIndex < 0
  'No PST files are registered for user ' $DName ' - exiting!' ? ?
  Exit 0
EndIf
 
? ? 'Preparing for Mail Archiving on ' @WKSTA ' for user ' $DName ?
 
 
 
; now have all needed info 
;  - terminate Outlook if it is running 
;  - delete the PST registry keys 
;  - rename the PST files 
 
; terminate Outlook  
$ = Split(WMIProcessList('outlook.exe')[0], ',')[1]
If Not @ERROR
  ' Closing Outlook...' ?
  $ = WMIProcessKill($)				; terminate Outlook 
  Sleep 3					; wait for Outlook to close open files 
EndIf
 
 
; Enumerate the PST files that are registered in Outlook 
For $ = 0 to UBound($aPSTPaths)
 
  $IsNet = -1					; Default to Not Network, will be 0 or more if network PSTs are found 
 
  $Drv = Left($aPSTPaths[$], 2)			; drive letter where PST is stored 
  $_ = InStrRev($aPSTPaths[$], '\')
  $PSTName = SubStr($aPSTPaths[$], $_ + 1)	; get name part 
  $PSTPath = Left($aPSTPaths[$], $_)		; get path part 
 
  ; determine if the PST is on a network drive.  
  For $_ = 0 to UBound($aMapped)
    If $aMapped[$_][0] = $Drv
      $IsNet = $_     				; is network! 
    EndIf
  Next
 
  ; Decide if this file should be processed - NetFlag=0 for all, or NetFlag=1 AND IsNet >= 0 
  If Not $NetFlag Or $NetFlag And $IsNet >= 0
 
    ; Display the PST name 
    ' ' Left($Drv + $PSTName + '                         ', 25) '- '
 
    If $MoveFlag
 
      ; Relocate the file to a user-specific folder on a common share 
      $NewPSTPath = $NewPSTRoot + @USERID + '\'
      'move'
      Move $PSTPath + $PSTName $NewPSTPath + $PSTName
 
      ; re-associate the PST registry key with the new location 
      '; reassociate' 
      $_ = AtoU($NewPSTPath + $PSTName)
      $_ = WriteValue($aPSTKeys[$], '001f6700-0', $_, 'REG_BINARY')
 
      ; convert local to UNC for logging 
      If $IsNet = -1 
        If Left($NewPSTPath, 1) = '\'
          $aPSTPaths[$] = $NewPSTPath + $PSTName
        Else
          $aPSTPaths[$] = '\\' + @WKSTA + '\' + Left($aPSTPaths[$], 1) + Chr(36) + SubStr($NewPSTPath, 3) + $PSTName
        EndIf
      Else
        If Left($NewPSTPath, 1) <> '\'
          $aPSTPaths[$] = $aMapped[$IsNet][1] + SubStr($NewPSTPath, 3) + $PSTName
        EndIf
      EndIF
 
    Else
 
      ; Disassociate by deleting the registry key 
      'Disassociate'
      $_ = DelTree($aPSTKeys[$])
 
      ; Rename the file 
      $NewPSTName = @USERID + '_' + Join(Split(Join(Split($PSTName, ' '), '_'), '.pst'), '.stp')
      '; move'
      Move $PSTPath + $PSTName $PSTPath + $NewPSTName
 
      ; convert local to UNC for logging 
      If $IsNet = -1				; local 
        $aPSTPaths[$] = '\\' + @WKSTA + '\' + Left($aPSTPaths[$], 1) + Chr(36) + SubStr($PSTPath, 3) + $NewPSTName
      Else
        $aPSTPaths[$] = $aMapped[$IsNet][1] + SubStr($PSTPath, 3) + $NewPSTName
      EndIF
 
    EndIf
 
    ; write log for processed PST files - these files will be processed offline to move the 
    ; renamed PST files to a central folder for processing 
    '; write log'
    $_ = RedirectOutput($LogPath + '\' + @WKSTA + '_PST.txt')
    $aPSTPaths[$] ?
    $_ = RedirectOutput('')
 
    ' - Done!' ?
 
  EndIf
 
Next
 
 
 
Exit 0
 
 
 
; convert Unicode strings to ASCII 
Function UtoA($_String)
 
  ; return if string is empty 
  If Not $_String Exit 0 EndIf
 
  Dim $_S, $_I				; temp string, index pointer 
 
  ; get each character pair as hex and convert to ASCII character 
  For $_I = 1 to Len($_String) Step 4
    $_S = $_S + Chr(Val('&' + SubStr($_String, $_I, 2)))
  Next
 
  $UtoA = $_S
  Exit 0
 
EndFunction
 
Function AtoU($_String)
 
  Dim $_S, $_I				; temp string, index pointer 
 
  ; get each ASCII character and convert to hex words 
  For $_I = 1 to Len($_String)
    $_S = $_S + Right('00' + DecToHex(Asc(SubStr($_String, $_I, 1))), 2) + '00'
  Next
 
  $AtoU = LCase($_S) + '0000'
  Exit 0  
 
EndFunction