'InUse Destroyer.vbs -- replaces or deletes at the next reboot files being used by any version of Windows
'
'DO NOT REMOVE THIS HEADER!
'Copyright Andrew ARONOFF, 25 April 2013
'  http://www.silentrunners.org/
'Inspired by the CWS removal procedure developed with Rossano FERRARIS
'This script is provided without any warranty, either express or implied
'It may not be copied or distributed without permission
'** YOU RUN THIS SCRIPT AT YOUR OWN RISK! **
'HEADER ENDS HERE


Option Explicit

'Revision 06

'objects
Dim Wshso : Set Wshso = WScript.CreateObject("WScript.Shell")
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim WshoArgs : Set WshoArgs = WScript.Arguments
Dim oReg  'WMI registry object - note that if this variable is
'associated before colOS, the WMI reboot will fail under NT4
'(only) with a WSH "Privilege not held." error, code 80041062,
'source: SWbemObject at the line containing "oWOS.Win32ShutDown"
Dim oShellApp  'Shell Application
Public colOS, oOS  'OS collection/member

'constants
Const DQ = """", HKLM = &H80000002, KQV = &H1, KSV = &H2
Const SysFolder = 1, WinFolder = 0, TempFolder = 2

'strings
Public strOS : strOS = "W9X"  'W9X, NT4 or WNX
Public strFPSF : strFPSF = Fso.GetSpecialFolder(SysFolder).Path   'FullPathSystemFolder 
Public strFPWF : strFPWF = Fso.GetSpecialFolder(WinFolder).Path   'FullPathWindowsFolder 
Public strFPTF : strFPTF = Fso.GetSpecialFolder(TempFolder).Path  'FullPathTempFolder 
Public strAppend : strAppend = ""  'PFRO/WII append indicator
Dim strKey, strArg  'registry key, copy of script argument
Dim strUAC : strUAC = ""  'set to string on re-entry
Dim strSysVer  'Winver.exe version number
Dim strLine : strLine = ""  'MsgBox text string

'integers
Dim intErrNum  'Err.Number

'flags
Public flagNT : flagNT = False  'True if OS = NT+
Dim flagAccess : flagAccess = False
Public flagWorkDone : flagWorkDone = False  'True if reboot should be requested prior to script exit 


'Winver.exe is in \Windows under W98, but in \System32 for other O/S's
'trap GetFileVersion error for VBScript version < 5.1
On Error Resume Next

 If Fso.FileExists (strFPSF & "\Winver.exe") Then

  strSysVer = Fso.GetFileVersion(strFPSF & "\Winver.exe")

 ElseIf Fso.FileExists (strFPWF & "\Winver.exe") Then

  strSysVer = Fso.GetFileVersion(strFPWF & "\Winver.exe")

 Else  'Winver.exe not found in either directory

  MsgBox "The file " & DQ & "WINVER.EXE" & DQ & " cannot be found." &_ 
   vbCRLF & "It is needed to identify the operating system." &_ 
   vbCRLF & vbCRLF &_
   "This script must exit.", _
   vbOKOnly + vbCritical + vbSystemModal, _
   "WINVER.EXE not found!"

  WScript.Quit

 End If

 'Winver.exe found, but GetFileVersion unsuccessful
 intErrNum = Err.Number : Err.Clear

On Error Goto 0

'if old VBScript version
If intErrNum <> 0 Then

 'explain the problem & quit
 MsgBox "Retrieval of the .GetFileVersion property of WINVER.EXE" &_
  vbCRLF & "threw an error, probably because VBScript needs to be" &_
  vbCRLF & "updated -- version 5.1 or higher is required." &_
  vbCRLF & vbCRLF &_
  "This script must exit.", _
  vbOKOnly + vbCritical + vbSystemModal, _
  "VBScript obsolete!" 

 WScript.Quit

End If  'error encountered?

'use WINVER.EXE file version to determine O/S

'W95, W98, WMe
If Instr(Left(strSysVer,8),"4.0.0.95") > 0 Or _ 
 Instr(Left(strSysVer,3),"4.1") > 0 Or _ 
 Instr(Left(strSysVer,3),"4.9") > 0 Then 

 strOS = "W9X" : flagNT = False

'NT4/NT4S
ElseIf  Instr(Left(strSysVer,5),"4.0.1") > 0 Then 
 strOS = "NT4" : flagNT = True 

'W2K/W2KS, WXP, WS2K3, WVa, Wn7/WS2K8, Wn8
ElseIf Instr(Left(strSysVer,3),"5.0") > 0 Or _ 
 Instr(Left(strSysVer,3),"5.1") > 0 Or _ 
 Instr(Left(strSysVer,3),"5.2") > 0 Or _ 
 Instr(Left(strSysVer,3),"6.0") > 0 Or _ 
 Instr(Left(strSysVer,3),"6.1") > 0 Or _ 
 Instr(Left(strSysVer,3),"6.2") > 0 Then 

 strOS = "WNX" : flagNT = True 

Else  'can't determine O/S version

 MsgBox "The operating system cannot be identified." &_
  vbCRLF & vbCRLF &_ 
  "This script must exit.", _
  vbOKOnly + vbExclamation + vbSystemModal, _ 
  "OS Unknown!"

 WScript.Quit

End If  'WINVER.EXE file version

'for NT-family OS (not needed for W9x), check for working WMI
'installation, check for admin rights - for WVa/Wn7, relaunch via
'Shell.Application with runas
If flagNT Then

 'use WMI to connect to the OS
 On Error Resume Next
  Set colOS = GetObject("winmgmts:{(Shutdown)}\root\cimv2")._
   InstancesOf("Win32_OperatingSystem")
  intErrNum = Err.Number : Err.Clear
 On Error Goto 0

 If intErrNum <> 0 Then

  MsgBox "Windows Management Instrumentation" &_ 
   " is unable to detect the operating system." &_ 
   vbCRLF & vbCRLF &_ 
   "This script must exit.", _
   vbOKOnly + vbCritical + vbSystemModal, _
   "WMI problem!"

  WScript.Quit

 End If  'WMI execution error

 'interpret command-line argument
 If WshoArgs.Count > 0 Then

  'copy the argument
  strArg = WshoArgs(0)

  'if found, reassign string variable
  If InStr(strArg, "__UAC__") > 0 Then strUAC = "__UAC__" 

 End If  'argument(s) passed to script?

 'check for Admin rights
 Set oReg = GetObject("winmgmts:root\default:StdRegProv")
 strKey = "System\CurrentControlSet\Control\Session Manager"
 intErrNum = oReg.CheckAccess(HKLM,strKey,KQV + KSV,flagAccess)
 Set oReg=Nothing

 'if no admin rights
 If Not flagAccess Then

  'if WVa/Wn7/Wn8 on first pass, re-enter via Shell.Application
  For Each oOS in colOS

   If ((InStr(LCase(oOS.Name),"vista") > 0) Or _ 
    (InStr(LCase(oOS.Name),"windows 7") > 0) Or _ 
    (InStr(LCase(oOS.Name),"windows" & Chr(160) & "7") > 0) Or _
    (InStr(LCase(oOS.Name),"windows server 2008") > 0) Or _
    (InStr(LCase(oOS.Name),"windows 8") > 0) Or _ 
    (InStr(LCase(oOS.Name),"windows" & Chr(160) & "8") > 0)) And _
    strUAC = "" Then 

    strArg = "__UAC__"

    Set oShellApp = CreateObject("Shell.Application")
    oShellApp.ShellExecute WScript.FullName, _
     DQ & WScript.ScriptFullName & DQ & Space(1) & strArg, "", "runas", 1 
    Set oShellApp=Nothing

    WScript.Quit

   Else  'not WVa/Wn7/Wn8 or WVa/Wn7/Wn8 on 2nd pass 

    'say Admin rights are needed & quit
    MsgBox "You must be an administrator to use this script!" &_ 
     vbCRLF & vbCRLF &_
     "This script must exit.", _
     vbOKOnly + vbSystemModal + vbCritical, _
     "Admin account required!"

    WScript.Quit

   End If  'WVa/Wn7/Wn8 or other OS?

   Exit For

  Next  'OS

 End If  'flagAccess?

End If  'NT O/S?

'go to main menu to delete or replace a file
ChooseFMO

'clean up
Set WshoArgs=Nothing : Set Fso=Nothing : Set Wshso=Nothing




'main menu - File Management Operation (replace or delete)
Sub ChooseFMO

'File Management Operation MsgBox return value, MsgBox return value 
Dim intFMO, intMB

'for NT, determine if PFRO already populated
If flagNT Then

 If PFROPopped Then strAppend = " >>"

'for 9x, determine if WII has [rename] section with non-empty line
Else  'W9x

 'if WII file exists
 If Fso.FileExists(strFPWF & "\wininit.ini") Then

  'if file not empty, toggle append flag
  If Fso.GetFile(strFPWF & "\wininit.ini").Size > 0 Then strAppend = " >>"

 End If  'WII exists

End If  'NT or 9x?

'do until Cancel button pressed or shutdown requested
Do While True

 'choose the File Management Operation
 'pressing "Cancel" will exit the sub and the script
 intFMO = MsgBox ("Press " & DQ & "Yes" & DQ &_
  " to REPLACE a file at the next reboot," & vbCRLF & vbCRLF &_
  Space(10) & DQ & "No" & DQ & " to DELETE a file at the" &_
  " next reboot, or" & vbCRLF & vbCRLF & Space(10) & DQ & "Cancel" &_
  DQ & " to quit.", _
  vbYesNoCancel + vbQuestion + vbDefaultButton3 + vbSystemModal, _
  "Main Menu: Replace, Delete or Quit?" & strAppend) 

 If intFMO = vbYes Then

  ReplaceAtNextBoot

 ElseIf intFMO = vbNo Then

  DeleteAtNextBoot

 'request reboot if Cancel button pushed but delete/replace already requested 
 ElseIf intFMO = vbCancel And flagWorkDone Then

  'request reboot
  intMB = MsgBox ("Choose " & DQ & "OK" & DQ & " to reboot now, or" &_ 
   vbCRLF & Space(13) & DQ & "Cancel" & DQ & " to exit this script.", _ 
   vbOKCancel + vbQuestion + vbDefaultButton2 + vbSystemModal, "Reboot now?")

  'if "Yes" button pushed, shutdown now
  If intMB = vbOK Then

   ShutDownNow : Exit Do

  Else  'vbCancel

   MsgBox "The changes will be made at the next reboot.", _
    vbOKOnly + vbInformation + vbSystemModal, _
    "Changes deferred"

  End If

  Exit Do

 ElseIf intFMO = vbCancel Then

  Exit Do

 End If

Loop

End Sub




'determine the file to replace at boot and add the data to PFRO or WII
Sub ReplaceAtNextBoot

'counter, MsgBox return value, source/target files, MsgBox string 
Dim i, intMB, oFiS, oFiT, strMB
'source LFN & SFN, target LFN & SFN
Dim strSrcLFN, strSrcSFN, strTgtLFN, strTgtSFN  
Dim strPFRO : strPFRO = ""  'PFRO value
Dim strAdd : strAdd = ""  'string appended to PFRO
Dim strIBMsg, strIBTitle  'Input Box msg, title
Dim intTFSize, intSFSize  'Tgt File Size/Src File Size

strIBMsg = "Enter the name of the file that will be " &_
 "replaced" & vbCRLF & "at the next reboot, including the full path:" &_
 vbCRLF & vbCRLF & "(Use ASCII only -- do not use Unicode characters)"

strIBTitle = "Replace This File at Reboot" & strAppend

'input target file (file to replace)
GetFN strTgtLFN, strIBMsg, strIBTitle

'exit sub if no file name entered
If strTgtLFN = "" Then Exit Sub

'return to main menu if file doesn't exist
If Not Fso.FileExists(strTgtLFN) Then

 MsgBox "The file: " & DQ & strTgtLFN & DQ & vbCRLF &_
  "cannot be found.", _ 
  vbOKOnly + vbCritical + vbSystemModal, _ 
  "File Not Found!"

 Exit Sub

End If  'target file exists?

'get short path & size
Set oFiT = Fso.GetFile (strTgtLFN)
strTgtSFN = oFiT.ShortPath
intTFSize = oFiT.Size

strIBMsg = "Enter the name of the file that will replace " &_
 vbCRLF & "the first file, including the full path:" &_
 vbCRLF & vbCRLF & "(Use ASCII only -- do not use Unicode characters.)"

strIBTitle = "Use This File to Replace The First File" & strAppend

'input source file (file used for replacement)
GetFN strSrcLFN, strIBMsg, strIBTitle

'exit sub if no file name entered
If strTgtLFN = "" Then Exit Sub

'return to main menu if file doesn't exist
If Not Fso.FileExists(strSrcLFN) Then

 MsgBox "The file: " & DQ & strSrcLFN & DQ & vbCRLF &_
  "cannot be found.", _ 
  vbOKOnly + vbCritical + vbSystemModal, _ 
  "File Not Found!"

 Exit Sub

End If  'source file exists?

'get short path & size
Set oFiS = Fso.GetFile(strSrcLFN)
strSrcSFN = oFiS.ShortPath
intSFSize = oFiS.Size

'avoid LFN's in WII for W9x
If Not flagNT Then

 'pass src & tgt LFN's & SFN's
 StuffWII "r", strSrcLFN, strSrcSFN, strTgtLFN, strTgtSFN

 'create message box text using SFN's
 strMB = "The file: " & vbCRLF & vbCRLF & strTgtLFN & vbCRLF & "(" & strTgtSFN &_ 
 ", " & intTFSize & " bytes" & ")" & vbCRLF & vbCRLF &_
 "will be replaced by the file: " & vbCRLF & vbCRLF & strSrcLFN &_
 vbCRLF & " (" & strSrcSFN & ", " & intSFSize & "bytes" & ")" &_
 vbCRLF & vbCRLF &_
 "on the next reboot." & vbCRLF & vbCRLF &_
 "Choose " & DQ & "Yes" & DQ & " to reboot now, or" & vbCRLF &_
 Space(13) & DQ & "No" & DQ & " to return to the main menu."

 flagWorkDone = True

'replace for NT systems via REG-file
ElseIf flagNT Then

 'append "\??\" & Src file & 00

 strAdd = "5c,3f,3f,5c,"

 'if PFRO value is populated, extract it & append string
 If PFROPopped Then
  strPFRO = ExtractPFRO
  strAdd = "," & strAdd
 End If

 'append Src FN
 For i = 1 To Len(strSrcLFN)
  strAdd = strAdd & Hex(Asc(Mid(strSrcLFN,i,1))) & ","
 Next

 'append "00"
 strPFRO = strPFRO & strAdd & "00"

 'append "!\??\" & Tgt file

 strAdd = ",21,5c,3f,3f,5c,"

 'append Tgt FN
 For i = 1 To Len(strTgtLFN)
  strAdd = strAdd & Hex(Asc(Mid(strTgtLFN,i,1))) & ","
 Next

 'append "00,00" to close PFRO
 strPFRO = strPFRO & strAdd & "00,00"

 'write PFRO to REG-file in TEMP directory & merge REG-file
 WriteREG (strPFRO)

 'prepare message box text with LFN's
 strMB = "The file: " & vbCRLF & vbCRLF & strTgtLFN &_
 " (" & intTFSize & " bytes)" & vbCRLF & vbCRLF &_
 "will be replaced by the file: " & vbCRLF & vbCRLF & strSrcLFN &_
 " (" & intSFSize & " bytes)" & vbCRLF & vbCRLF &_
 "on the next reboot." & vbCRLF & vbCRLF &_
 "Choose " & DQ & "Yes" & DQ & " to reboot now, or" & vbCRLF &_
 Space(13) & DQ & "No" & DQ & " to return to the main menu."

 flagWorkDone = True

End If  'W9x or NT?

Set oFiS=Nothing : Set oFiT=Nothing

'display target & source files and request reboot
intMB = MsgBox (strMB,vbYesNo + vbQuestion + vbDefaultButton2 + vbSystemModal, _
 "Reboot now?" & strAppend)

'shut down if "Yes" button pushed
If intMB = vbYes Then ShutDownNow

End Sub




'determine the file to delete at boot and add the data to PFRO or WII
Sub DeleteAtNextBoot

'source LFN & SFN
Dim strSrcLFN, strSrcSFN
Dim strPFRO : strPFRO = ""  'PFRO value
Dim strAdd : strAdd = ""  'string appended to PFRO
Dim strIBMsg, strIBTitle  'Input Box msg, title
'counter, MsgBox return value, registry hive array, message box string
Dim i, intMB, arRH(), strMB

'set up registry hive array
If flagNT Then

 'user profile environment variable to determine location of NTUSER.DAT
 Dim strUP : strUP = Wshso.ExpandEnvironmentStrings("%USERPROFILE%")

 ReDim arRH(6)
 arRH(0) = strFPSF & "\config\security" 
 arRH(1) = strFPSF & "\config\sam" 
 arRH(2) = strFPSF & "\config\system" 
 arRH(3) = strFPSF & "\config\software" 
 arRH(4) = strFPSF & "\config\default" 
 arRH(5) = strFPSF & "\config\userdiff" 
 arRH(6) = strUP & "\ntuser.dat"

Else  'flagWx

 ReDim arRH(1)
 arRH(0) = strFPWF & "\system.dat" 
 arRH(1) = strFPWF & "\user.dat" 

End If

'input file to delete
strIBMsg = "Enter the name of the file to delete " &_
 "at" & vbCRLF & "the next reboot, including the full path:" &_
 vbCRLF & vbCRLF & "(Use ASCII only -- do not use Unicode characters.)"

strIBTitle = "Delete at Reboot" & strAppend

'input file to delete
GetFN strSrcLFN, strIBMsg, strIBTitle

'exit sub if no file name entered
If strSrcLFN = "" Then Exit Sub

'set up standard message box text
strMB = "The file: " & DQ & strSrcLFN & DQ & vbCRLF &_
 "will be deleted on the next reboot." & vbCRLF & vbCRLF

'for every hive file
For i = 0 To UBound(arRH)

 'if file to delete is hive file or any other NTUSER.DAT, refuse to delete it 
 If LCase(strSrcLFN) = LCase(arRH(i)) Or InStr(LCase(strSrcLFN),"ntuser.dat") > 0 Then 

   MsgBox "The file: " & DQ & strSrcLFN & DQ & vbCRLF &_
   "is a registry hive and cannot be deleted.", _
   vbOKOnly + vbExclamation + vbSystemModal, _ 
   "Cannot Delete Registry Hive!"

   Exit Sub

 End If

Next

'if file doesn't exist, delete anyway or return to main menu
If Not Fso.FileExists(strSrcLFN) Then

 intMB = MsgBox("The file: " & DQ & strSrcLFN & DQ & vbCRLF &_
  "cannot be found." & vbCRLF & vbCRLF & "Choose " &_
  DQ & "Yes" & DQ & " to schedule deletion anyway, or" &_
  vbCRLF & Space(13) & DQ & "No" & DQ &_
  " to return to the main menu.", _
  vbYesNo + vbExclamation + vbDefaultButton2 + vbSystemModal, _
  "File Not Found!")

 'return to main menu if "No" button pushed
 If intMB = vbNo Then Exit Sub

End If  'file exists?

'avoid LFN's in WII for W9x
If Not flagNT Then

 Dim intLBS : intLBS = InStrRev(strSrcLFN,"\")  'find last backslash (bs)
 Dim strFNNP : strFNNP = Mid(strSrcLFN,intLBS+1)  'find file name after bs
 Dim intDot : intDot = InStr(strFNNP,".")  'find period
 strSrcSFN = strSrcLFN  'set SFN = LFN
 'if LFN can be found, find SFN
 If Fso.FileExists(strSrcLFN) Then strSrcSFN = Fso.GetFile(strSrcLFN).ShortPath

 'if file can't be found and name is in LFN format, display error
 'and return to main menu
 If Not Fso.FileExists(strSrcLFN) And (Len(strFNNP) > 12 Or intDot > 8 _
  Or InStr(strFNNP," ") > 0) Then

  'request use of SFN for file that can't be found
  MsgBox "The file name: " & DQ & strSrcLFN & DQ & vbCRLF &_
   "is in LFN format. Since it can't be found," & vbCRLF &_
   "only an 8.3 path\file name can be used." &_ 
   vbCRLF & vbCRLF &_ 
   "Press " & DQ & "OK" & DQ & " to return to the main menu.", _
   vbOKOnly + vbExclamation + vbSystemModal, _ 
   "8.3 name required!"

  Exit Sub

 End If  'LFN & Not FileExists?

 'if LFN identical to SFN, empty LFN
 If LCase(strSrcLFN) = LCase(strSrcSFN) Then strSrcLFN = "" 
 
 'pass LFN & SFN to WII-append sub 
 StuffWII "d", strSrcLFN, strSrcSFN, "", ""

 'if LFN not empty, set up message string with LFN & SFN
 If strSrcLFN <> "" Then _
   strMB = "The file:" & vbCRLF & vbCRLF & DQ & strSrcLFN & DQ & vbCRLF &_
   "(" & strSrcSFN & ")" & vbCRLF & vbCRLF & "will be deleted on the next " &_
   "reboot." & vbCRLF & vbCRLF

 flagWorkDone = True

'delete for NT systems via PFRO
ElseIf flagNT Then

 'append "\??\" & Src file & 00,00,00

 strAdd = "5c,3f,3f,5c,"

 'if PFRO value is populated, extract it & append string
 If PFROPopped Then
  strPFRO = ExtractPFRO
  strAdd = "," & strAdd
 End If

 'append Src FN
 For i = 1 To Len(strSrcLFN)
  strAdd = strAdd & Hex(Asc(Mid(strSrcLFN,i,1))) & ","
 Next

 'append Tgt Null & closing Null: "00,00,00"
 strPFRO = strPFRO & strAdd & "00,00,00"

 'write PFRO to REG-file in TEMP directory & merge REG-file
 WriteREG (strPFRO)

 flagWorkDone = True

End If  'flagNT?

'display file to delete and request reboot
intMB = MsgBox (strMB &_
 "Choose " & DQ & "Yes" & DQ & " to reboot now, or" & vbCRLF &_
 Space(13) & DQ & "No" & DQ & " to return to the main menu.", _
 vbYesNo + vbQuestion + vbDefaultButton2 + vbSystemModal, "Reboot now?" & strAppend)

'if "Yes" button pushed, shutdown now
If intMB = vbYes Then ShutDownNow

End Sub




'fill WININIT.INI with lines to delete or replace files
' "d" or "r", LFN of file that will be used to replace, SFN of that
' file, LFN of file to be replaced, SFN of that file
Sub StuffWII (strAction, strLFNparam1, strSFNparam1, strLFNparam2, strSFNparam2)

'read line, output line, file object, temp folder name, work file name
Dim strLine, strOut, oWIIFi, strTmpFoName, oWIITmpFN
Dim flagRen : flagRen = False  'TRUE if [rename] section found
Dim flagLineWritten : flagLineWritten = False  'TRUE if output line written 

'form output line for file deletion
If LCase(strAction) = "d" Then
 strOut = "NUL=" & strSFNparam1
'form output line for replacement
Else  'strAction = "r"
 strOut = strSFNparam2 & "=" & strSFNparam1
End If

'create WININIT.INI if file doesn't exist already
If strAppend = "" Then

 Set oWIIFi = Fso.OpenTextFile(strFPWF & "\WININIT.INI",2,True,0) 

 oWIIFi.WriteLine "[Rename]" : oWIIFi.WriteLine strOut

 oWIIFi.Close : Set oWIIFi=Nothing
 'toggle append flag via msgbox string
 strAppend = " >>"

Else  'WII not empty

 'open WII for reading
 Set oWIIFi = Fso.OpenTextFile(strFPWF & "\wininit.ini",1,False,0)
 'get the TEMP folder path
 strTmpFoName = Fso.GetSpecialFolder(2).Path
 'create a WII work file in the TEMP folder
 Set oWIITmpFN = Fso.OpenTextFile(strTmpFoName & "\WININIT.INI",2,True,0) 

 'read each WII line looking for an existing [rename] section
 Do While Not oWIIFi.AtEndOfStream

  'read a line
  strLine = oWIIFi.ReadLine

  'if [rename] section already encountered and find start of another section 
  If flagRen And InStr(LCase(strLine),"[") > 0 Then
   'write the output line and toggle its flag
   oWIITmpFN.WriteLine strOut : flagLineWritten = True
  End If

  'if encounter [rename] section at this line, toggle rename flag 
  If Not flagRen And InStr(LCase(strLine),"[rename]") > 0 Then flagRen = True

  'output the original WII line
  oWIITmpFN.WriteLine strLine

 Loop  'next WII line

 'if reached EOF w/o finding [rename] section, output section name now
 If Not flagRen Then oWIITmpFN.WriteLine "[Rename]"
 'if reached EOF w/o writing output line, do it now
 If Not flagLineWritten Then oWIITmpFN.WriteLine strOut

 'close the WII and WII-work files
 oWIIFi.Close : oWIITmpFN.Close

 'copy the work file over the existing WII file
 Set oWIIFi = Fso.GetFile(strFPWF & "\wininit.ini")
 Set oWIITmpFN = Fso.GetFile(strTmpFoName & "\WININIT.INI")
 Fso.CopyFile oWIITmpFN.Path,oWIIFi.Path
 'delete the work file
 Fso.DeleteFile oWIITmpFN.Path
 Set oWIIFi=Nothing : Set oWIITmpFN=Nothing

End If  'WII exists?

End Sub




'reboot via WMI for NT systems; use rundll32.exe function for W9x 
Sub ShutDownNow

If flagNT Then

 'use WMI to reboot
 For Each oOS In colOS : oOS.Win32ShutDown "6" : Exit For : Next
 Set colOS=Nothing
 WScript.Quit

Else  'W9x

 Wshso.Run "rundll32.exe shell32.dll,SHExitWindowsEx 2",0,TRUE 
 WScript.Quit

End If  'flagNT?

End Sub




'determine if PendingFileRenameOperations value is Populated (Popped)
Function PFROPopped

Dim strRegLoc, intErrNum, arFiles, oReg

'registry key
strRegLoc = "System\CurrentControlSet\Control\Session Manager"

'retrieve the existing PendingFileRenameOperations array
Set oReg = GetObject("winmgmts:root\default:StdRegProv")
intErrNum = oReg.GetMultiStringValue(HKLM,strRegLoc,"PendingFileRenameOperations",arFiles) 

'if array exists, PFRO already contains values
If IsArray(arFiles) Then
 If UBound(arFiles) >= 0 Then
  strAppend = " >>" : PFROPopped = True
 End If
Else
 PFROPopped = False
End If

Set oReg=Nothing

End Function




'extract PFRO value from export file of Session Manager key
Function ExtractPFRO

'PFRO data string, REG-file, beginning/end of hex-chr-coded data in line, 
'location of trailing "00", REG-file line
Dim strOut, oFi, intChrStart, intChrStop, intLast00, strLine
Dim flagValue : flagValue = False  'TRUE if in PFRO value section

'file to store Session Manager export
Dim strFN : strFN = strFPTF & "\PFROi.reg"
Dim strCLP : strCLP = " /a "  'REGEDIT cmd-line parameter for W2K/WXP/Wva/Wn7/Wn8 
If strOS = "NT4" Then strCLP = " /e "  'REGEDIT cmd-line paramter for NT4 

'export Session Manager key to TEMP directory
Wshso.Run strFPWF & "\regedit.exe" & strCLP & strFN & " " &_
 DQ & "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Session Manager" &_ 
 DQ,0,TRUE

Set oFi = Fso.OpenTextFile(strFN,1,False,0)  'open the exported file

'for every line
Do While Not oFi.AtEndOfStream

 strLine = LTrim(oFi.ReadLine)  'read a line

'"PendingFileRenameOperations"=hex(7):hh,hh,hh,hh,hh,hh,hh,hh,hh,hh,hh,hh,hh,hh,\

 'if inside PFRO section, exit DO if read line has double-quote or [ or is blank
 'since that means have reached end of section
 If flagVAlue And (InStr(strLine,DQ) Or InStr(strLine,"[") Or _ 
  strLine = "") Then Exit Do

 'if PFRO in line, toggle flag
 If InStr(strLine,"PendingFileRenameOperations") > 0 Then _
  flagValue = True  

 'if flag toggled
 If flagValue Then

  'find start & stop of PFRO data
  intChrStart = InStr(strLine,":")
  intChrStop = InStr(strLine,"\")
  'if stop mark not found, set it to 1 more than line length
  If intChrStop = 0 Then intChrStop = Len(strLine)+1

  'extract this line's data & append to previous
  strOut = strOut & Mid(strLine,intChrStart+1,intChrStop-intChrStart-1)  '42

 End If

Loop  'read next line

oFi.Close : Set oFi=Nothing

'snip trailing ,00
intLast00 = InStrRev(strOut,",00")
strOut = Left(strOut,intLast00 - 1)

'delete Session Manager REG-file in TEMP directory
Fso.DeleteFile strFN, TRUE

'pass extracted PFRO data
ExtractPFRO = strOut

End Function




'retrieve file name via InputBox
Sub GetFN (strFN, strMsg, strTitle)

'input target file (file to replace)
strFN = InputBox(strMsg, strTitle,"enter path\filename.ext here")

'remove double quotes from path\filename
If InStr(strFN,"""") > 0 Then

 'replace double quotes with empty string,start at beginning of string,
 'replace all occurrences, perform text comparison
 strFN = Replace (strFN,"""","",1,-1,1) 

End If  'strFN empty?

End Sub




'write out data to REG-file, merge into registry, delete REG-file
Sub WriteREG (strOut)

Dim strFN : strFN = strFPTF & "\PFROf.reg"
Dim oREGFi : Set oREGFi = Fso.CreateTextFile (strFN, TRUE)

oREGFi.WriteLine "REGEDIT4" & vbCRLF & vbCRLF &_
 "[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager]" &_ 
 vbCRLF & DQ & "PendingFileRenameOperations" & DQ & "=hex(7):" & strOut

oREGFi.Close : Set oREGFi=Nothing

Wshso.Run strFPWF & "\regedit.exe /s " & DQ & strFN & DQ,0,TRUE

Fso.DeleteFile strFN, TRUE

End Sub




'R00, 2004-12-03

'R01
'changed name, modified append indicator to ">>"

'R02
'modified header, added "Main Menu" to window title

'R03
'added Vista as allowed OS, removed WSH download location for W98/NT4,
'added instructions for Vista elevated command prompt, added
'vbSystemModal attribute to all message boxes

'R04
'modified OS version error e-mail address

'R05
'added relaunch via Shell.Application with runas

'R06
'used CheckAccess instead of WHOAMI to determine Admin status, added
'Wn8 compatibility, changed sub nesting

'** Update Revision Number on line #15 **