'
' 移動プロファイル初期化スクリプト
'
' 古いプロファイルは、Profile.YYMMDDHHMMSS にリネームされます。
'
' @author Jun Futagawa (Integsystem Corporation)
' @license Apache License, Version 2.0

' オブジェクトの生成
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objEnv = objShell.environment("Process")

' プロファイルのリネーム用に現在の日時を取得
nowTime = Now
profilePostfix = Year(nowTime) _
	& Right("0" & Month(nowTime), 2) _
	& Right("0" & Day(nowTime), 2) _
	& Right("0" & Hour(nowTime), 2) _
	& Right("0" & Minute(nowTime), 2) _
	& Right("0" & Second(nowTime), 2)

' 実行確認メッセージ
confirmMessage = "プロファイルを初期化します。実行して良い場合は 「OK」 を押してください。" & vbCrLf _
	& "実行すると自動的にログオフされ、ログオンし直すとプロファイルが初期化されています。" & vbCrLf _
	& vbCrLf _
	& "動作のおかしくなったアプリケーションは、多くの場合プロファイルを初期化することで復旧します。" & vbCrLf _
	& "実行すると主に次のデータが初期化されます。必要なファイルは ** 必ず ** バックアップを取ってから実行してください。" & vbCrLf _
	& vbCrLf _
	& "・Windows エクスプローラの設定" & vbCrLf _
	& "・タスクバー設定" & vbCrLf _
	& "・レジストリに保存されたアプリケーション設定" & vbCrLf _
	& "・壁紙" & vbCrLf _
	& "・Internet Explorerのお気に入り" & vbCrLf _
	& vbCrLf _
	& "古いプロファイルは、[ファイルサーバのパスを記入]." & profilePostfix & " に保存されますが、後から回収出来ないデータも含まれています。" & vbCrLf _
	& vbCrLf _
	& "複数回実行しても正常にプロファイルが初期化されない場合は、[管理者の居場所を記入] までお知らせください。"

confirmStatus = MsgBox(confirmMessage, vbOKCancel, "プロファイル初期化実行確認")
If confirmStatus = vbOK Then
	' 環境変数の取得
	computerName = objEnv.item("COMPUTERNAME")
	userName = objEnv.item("USERNAME")
	userDomain = objEnv.item("USERDOMAIN")

	' WMI名前空間の取得
	WMINameSpace = "winmgmts:\\" & computerName & "\root\cimv2"
	Set objWMIService = GetObject(WMINameSpace)

	' WMIユーザオブジェクトの取得
	queryAccount = "Win32_UserAccount.Name='" _
		& userName & "',Domain='" & userDomain & "'"
	Set objAccount = objWMIService.Get (queryAccount)

	' ユーザの SID 文字列取得(UserPreference 値設定に必要)
	userSID = objAccount.SID

	' 現在のレジストリ CentralProfile 値を元にバックアップ保存先パス作成
	registoryPath = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" _
		& userSID & "\CentralProfile"
	currentProfilePath = objShell.RegRead(registoryPath)
	newProfilePath = currentProfilePath & "." & profilePostfix
	' Wscript.Echo currentProfilePath
	' Wscript.Echo newProfilePath

	If objFSO.FolderExists(currentProfilePath) Then
		' 現在サーバ上にある移動プロファイルを移動
		Set currentProfileFolder = objFSO.GetFolder(currentProfilePath)
		currentProfileFolder.Move(newProfilePath)
		' レジストリ CentralProfile 値の設定
		objShell.RegWrite registoryPath, newProfilePath
	End If

	' ログオフを実行
	Const SHUTDOWN = 1
	Const FORCE_LOGOFF = 4
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colOperatingSystems = objWMIService.ExecQuery _
		("SELECT * FROM Win32_OperatingSystem")
	For Each objOperatingSystem in colOperatingSystems
		ObjOperatingSystem.Win32Shutdown(FORCE_LOGOFF)
	Next

End If