Ultimate Decom Script

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Ultimate Decom Script

Logged in as: Guest

arrSession:exec spGetSession 2,16,59298

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Ultimate Decom Script
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Ultimate Decom Script - 4/18/2008 2:49:25 PM

TomRiddle

Posts: 90
Score: 0
Joined: 2/7/2008
Status: offline

This is what we run on our old workstations prior to doing a security erase.
I have called it the "Ultimate Decom Script" but I have no doubt that some of you gurus here could make it better and far simpler.

' Script by TomRiddle 2008
' Ultimate DECOM Script
' UDS.VBS
' v1.17

' Backup user Created data prior to HD wipe. 
' Designed for corporate workstations, running an SOE and roaming profiles, XP Service Pack2, No firewalls, Local admin access required. 
' Will backup local or Remote computers

' Usage - Run script by double clicking it or pass optional command line argument, "TargetMachine"

' Unlike most scripts that backup specific files, this one backs up all files and folders, except ones on an exclude list. 
' No need to second Guess where or what a user will save on the hard drive. 
' Operating System and Program Files folders are excluded because users should not be able to add files there. 
' Documents and settings folder is also excluded because profiles are replicated to server. 
' Additionally you can optionally specify files and folders to include which are buried within excluded folders.

Option explicit

Dim ExcludeF, ExcludeD, IncludeD, IncludeF, strDrive, ArchiveServerUNC, ZC, DBK
   Dim args, num, objNet, strComputer
   Dim ExFa, ExFaU, ExDa, ExDaU
   Dim IncFa, IncFaU, IncDa, IncDau
   Dim SS, XcopyCSize, FinishedMessage, answer
   Dim ZAC, ZAU, y
   Dim XcopyArray(1024,1024)
   Dim IsReachable 
   Dim objShell, return

'Enter files and folders in the ROOT of the drive you wish to include/exclude from backup. No slash on end of folders. Separate by comma only. 
   ExcludeF = "IO.SYS,MSDOS.SYS,NTDETECT.COM,NTLDR,AUTOEXEC.BAT,BOOT.INI,CONFIG.SYS,hiberfil.sys,pagefile.sys,SMSSETUP.LOG,Workstation.log,Workstation.sdb"
   ExcludeD = "SPL,SMSADMIN,OSDLogs,quarantine,myworks,Documents and Settings,I386,Program Files,RECYCLER,recycled,System Volume Information,Windows"

IncludeF = "windows\WindowsUpdate.log,WINDOWS\security\logs\winlogon.log"       'Just a couple of example files, specify full path but no drive letter
   IncludeD = "Program Files\Dragon Systems"                                                                   'Dragon Dictate program stupidly stores data here

'Other configuration options                     
   strDrive = "c"                                                           'Drive letter being backed up. Specify just drive letter i.e. "C" or "D" etc. Drive must have an administrative share on root of drive, i.e. c$ or D$
   ArchiveServerUNC = "\\Server\transfer\decom\"   'Server path where backups will be stored. Slash on end.
   ZC = 3000                                                                'Maximum size in Mb script will try to backup before Script complains. 
   DBK = 5                                                                    'Days Kept - Each time script is run it will look for old backups to delete first.

'--------------------------------------------------------------

'Start - Determine computer to be backed up. 
   Set args = WScript.Arguments
   num = args.Count
   if num = 0 then
      'On Error Resume Next 
      Set objNet = CreateObject("WScript.NetWork") 
      strComputer = objNet.ComputerName
      strComputer = inputbox("Enter machine name of computer to backup", "Backup Script", strComputer)
      Reachable strComputer
      If IsReachable = "YES" then
	 'continue
      else
         Msgbox strComputer & " is not reachable"
         wscript.quit
      end if
   else
      strComputer = args.Item(0)
      Reachable strComputer
      If IsReachable = "YES" then
         'continue
      else
         Msgbox strComputer & " is not reachable"
         wscript.quit
      End if
   end if   
   Set args = Nothing

if strComputer = "" then 
      PLAYFILE "c:\windows\media\Windows XP Hardware Fail.wav"
      wscript.quit
   end if

'Build array of files to exclude
   ExFa = split(ExcludeF, ",") : ExFaU = UBound(ExFa)
   ExDa = split(ExcludeD, ",") : ExDaU = UBound(ExDa)

'Build array of Files to include
   IncFa = split(IncludeF, ",") : IncFaU = UBound(IncFa)
   IncDa = split(IncludeD, ",") : IncDaU = UBound(IncDa)

'Launch main functions   
   ArchiveCleanup                     'Function- Delete old backups in archive share.
   ListFiles strDrive&":\"            'Function- Process files in Root of drive.
   ListFolders strDrive&":\"       'Function- Process subfolders in root of the drive.
   ListExtras                              'Function- Include specific files and folders that are in excluded folder structures.

'Determine size of files selected for backup. 
   ZAU = ZAC-1
   for y = 0 to ZAU 
      XcopyCSize = XcopyCSize+XcopyArray(y,1)
   next
   if XcopyCSize/1024/1024 < 1 then
      XcopyCSize=round(XcopyCSize/1024/1024,3)
   else
      XcopyCSize=round(XcopyCSize/1024/1024)
   end if

'Display warning if problem with backup size detected.  
   ShareSize ArchiveServerUNC

if abs(XcopyCSize+1000) > abs(SS) then
      PLAYFILE "c:\windows\media\Windows XP Hardware Fail.wav"
      answer = msgbox ("Warning"&vbcrlf&"Backup Archive Server:-"&vbcrlf&ArchiveServerUNC&" Is nearly full. "&vbcrlf&"BackUp Files "&XcopyCSize&"Mb - FreeSpace "&SS&"Mb"&vbcrlf&"Click OK to continue...", 1, "Continue Backup?")
      if answer <> 1 then wscript.quit
   end if
 
   if XcopyCSize > ZC then
      PLAYFILE "c:\windows\media\Windows XP Hardware Fail.wav"
      answer = msgbox("Workstation drives are not for corporate data storage."&vbcrlf&XcopyCSize&"Mb will take a long time to backup. "&vbcrlf&"Click OK to continue...", 1, "Continue Backup?")
      if answer <> 1 then wscript.quit
   else
      msgbox "Backing Up "&XcopyCSize&"Mb Files on "&strComputer
   end if

'Xcopy up the files
   ZAU = ZAC-1
   for y = 0 to ZAU 
      XcopyUp XcopyArray(y,0)
   next

'Finished
   if instr(XcopyCSize, ".") then
      FinishedMessage = "Finished backing up "&strComputer&". "&vbcrlf&"Less than 1 Megabyte copied."
   else
      FinishedMessage = "Finished backing up "&strComputer&". "&vbcrlf&XcopyCSize&" Megabytes copied."
   end if

PLAYFILE "c:\windows\media\tada.wav"
   
   Set objShell = CreateObject("WScript.Shell") 
   return = objShell.Run ("explorer "&ArchiveServerUNC&strComputer, 1, false)

MsgBox FinishedMessage

Wscript.quit

'--------------------------------------------------------------

Function ListFiles(xxx)

'List all files in the root of the drive

Dim objWMIService, colFileList, objFile

Set objWMIService = GetObject("winmgmts:" _
       & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	
   Set colFileList = objWMIService.ExecQuery _
       ("ASSOCIATORS OF {Win32_Directory.Name='"&xxx&"'} Where " _
           & "ResultClass = CIM_DataFile")
	
   For Each objFile In colFileList
       filep objFile.Name
   Next

end Function

'--------------------------------------------------------------

Function ListFolders(xxx)

'List all folders in the root of the drive

Dim objWMIService, colSubfolders, objFolder

Set objWMIService = GetObject("winmgmts:" _
       & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colSubfolders = objWMIService.ExecQuery _
       ("Associators of {Win32_Directory.Name='"&xxx&"'} " _
           & "Where AssocClass = Win32_Subdirectory " _
               & "ResultRole = PartComponent")

For Each objFolder in colSubfolders
       folderp objFolder.Name           
   Next

end Function

'--------------------------------------------------------------

Function FolderP(xxx)

'Check Directory is not on excluded list and add to array

Dim zzz, yyy, x, objFSO, objFolder
  
   for x=0 to ExDaU 
     'msgbox ucase(ExDa(x)) &vbcrlf& ucase(xxx)
      if ucase(strDrive&":\"&ExDa(x)) = ucase(xxx) then
        'msgbox "Skiping "&xxx  
         exit Function
      end if
   next

zzz = replace(xxx, strDrive&":", "\\"&strComputer&"\"&strDrive&"$")
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFSO.GetFolder(zzz)
   yyy = objFolder.Size
   XcopyArray(ZAC,0) = xxx&"\"
   XcopyArray(ZAC,1) = yyy  
   ZAC=ZAC+1

end Function

'--------------------------------------------------------------

Function FileP(xxx)

'Check File is not on excluded list and add to array

Dim zzz, yyy, x, objFSO, objFile

for x=0 to ExFaU 
     'msgbox ucase(strDrive&":\"&ExFa(x)) &vbcrlf& ucase(xxx)
      if ucase(strDrive&":\"&ExFa(x)) = ucase(xxx) then 
        'msgbox "Skiping "&xxx  
         exit Function
      end if
   next

zzz = replace(xxx, strDrive&":", "\\"&strComputer&"\"&strDrive&"$")
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFile = objFSO.GetFile(zzz)
   yyy = objFile.Size
   XcopyArray(ZAC,0) = xxx
   XcopyArray(ZAC,1) = yyy         
   ZAC=ZAC+1

end Function

'--------------------------------------------------------------

Function ListExtras

Dim x

for x=0 to IncFaU 
      ExtrasF IncFa(x)
   next

for x=0 to IncDaU 
      ExtrasD IncDa(x)
   next

End Function

'---------

Function ExtrasF(xxx)

Dim zzz, yyy, objFSO, objFile

xxx = strDrive&":\"&xxx

Set objFSO = CreateObject("Scripting.FileSystemObject")
   zzz = replace(xxx, strDrive&":", "\\"&strComputer&"\"&strDrive&"$")
   If objFSO.FileExists(zzz) Then
      Set objFile = objFSO.GetFile(zzz)
      yyy = objFile.Size
      XcopyArray(ZAC,0) = xxx
      XcopyArray(ZAC,1) = yyy         
      ZAC=ZAC+1
   End If

End Function

'---------

Function ExtrasD(xxx)

Dim zzz, yyy, objFSO, objFolder

xxx = strDrive&":\"&xxx

Set objFSO = CreateObject("Scripting.FileSystemObject")
   zzz = replace(xxx, strDrive&":", "\\"&strComputer&"\"&strDrive&"$")
   If objFSO.FolderExists(zzz) Then
      Set objFolder = objFSO.GetFolder(zzz)
      yyy = objFolder.Size
      XcopyArray(ZAC,0) = xxx&"\"
      XcopyArray(ZAC,1) = yyy         
      ZAC=ZAC+1
   End If

End Function

'--------------------------------------------------------------

Function XcopyUp(XXX)

'XcopyUp Function - Xcopy copies up xxx files to Archive Server.

Dim zzz, yyy, zzzc, strxlen, strxPos, RunCMD, objShell

xxx=replace(xxx, strDrive&":", "\\"&strComputer&"\"&strDrive&"$")

if len(xxx) = instrrev(xxx, "\") then
      strxlen = len(xxx)
      xxx= left(xxx,strxlen-1)
      strxPos=instr(xxx, "\"&strDrive&"$")+4
      RunCMD = "xcopy /E /C /H /R /Y /I "&chr(34)&xxx&chr(34)&" "&chr(34)&ArchiveServerUNC&strComputer&"\"&right(xxx, strxlen-strxPos)&chr(34) 
   else
      strxlen = len(xxx)
      strxPos = instr(xxx, "\"&strDrive&"$")+3
      zzz = right(xxx, strxlen-strxPos)
      zzzC = instrrev(zzz, "\")
      zzz = left(zzz, zzzc)
      RunCMD = "xcopy /C /H /R /Y /I "&chr(34)&xxx&chr(34)&" "&chr(34)&ArchiveServerUNC&strComputer&"\"&zzz&chr(34) 
   end if

Set objShell = CreateObject("WScript.Shell") 
   objShell.Run RunCMD, 0, true

End Function

'--------------------------------------------------------------

Sub ShareSize(drvPath)

'Determine target share free space
.
   Dim fs, d

Set fs = CreateObject("Scripting.FileSystemObject") 
   Set d = fs.GetDrive(fs.GetDriveName(drvPath)) 
   SS = FormatNumber((d.FreeSpace/1024/1024),0,,,0)

End Sub

'--------------------------------------------------------------

Function ArchiveCleanup

'Scan and list all backup folders in archive share.

Dim objFSO, objFolder, colSubfolders, objSubfolder

Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFSO.GetFolder(ArchiveServerUNC)
   Set colSubfolders = objFolder.Subfolders

For Each objSubfolder in colSubfolders
      DelArch objSubfolder.Name 
   Next

on error resume next
   objFSO.DeleteFolder(ArchiveServerUNC&strComputer)
   on error goto 0

End Function

'---------

sub DelArch(xxx)

'Delete all old backup folder(s) in archive share if kept days old is exceeded.

Dim objFSOs, objFolders, DateLastModified, FileAge

Set objFSOs = CreateObject("Scripting.FileSystemObject")
   Set objFolders = objFSOs.GetFolder(ArchiveServerUNC&xxx)
   DateLastModified = objFolders.DateLastModified
   FileAge = (DateDiff("d",DateLastModified,now))
   If FileAge=>DBK then
      objFSOs.DeleteFolder(ArchiveServerUNC&xxx)
   end if
   set objFSOs = nothing

end sub

'--------------------------------------------------------------

sub reachable(xxx)

' Ping remote machine for script robustness

Dim wmiQuery, objWMIService, objPing, objStatus 
  
  wmiQuery = "Select * From Win32_PingStatus Where Address = '" & xxx & "'" 
  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") 
  Set objPing = objWMIService.ExecQuery(wmiQuery) 
  
  For Each objStatus in objPing 
      If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then 
          IsReachable = "NO"
      Else 
          IsReachable = "YES"
      End if
  Next

end sub

'--------------------------------------------------------------

Function PLAYFILE(MEDIA_FILE_PATH)

'Play a wav file in script instead of boring beep.

Dim objPlayer

Set objPlayer = CreateObject("WMPlayer.OCX.7" )
   objPlayer.URL = MEDIA_FILE_PATH
      while objPlayer.playstate = 9 OR objPlayer.playstate = 3
         wscript.sleep 500
      wend

End Function

'--------------------------------------------------------------