====== Примеры скриптов Windows Scripting Host (WSH) ======
===== Мапирование сетевых дисков =====
<code VB>
'*************************************************
' File: MapDrives.vbs
'
' Mapping network drives 
'*************************************************

Option Explicit

Dim oWshShell, oWshNetwork, oDrives

Dim MapList, i
Dim Drv1, Drv2, Drv3, Drv4
Dim Share1, Share2, Share3, Share4
Dim Srv

' Script parameters ===========
Drv1 = "X:"
Share1 = "SHARE"
Srv = "\\SRV.DOMAIN.DOM\"
' ===============================

MapList = vbCrLf & "Your drives mapping:" & vbCrLf & "====================" & vbCrLf & vbCrLf
           
SetCScript ()

Set oWshNetwork = WScript.CreateObject("WScript.Network")
Set oDrives = oWshNetwork.EnumNetworkDrives

' Remove required only drive letter
On Error Resume Next
oWshNetwork.RemoveNetworkDrive Drv1,true,true
ErrCheck Err.Number

' Remove all drives letters
'For i = 0 To oDrives.Count - 1 Step 2
'    oWshNetwork.RemoveNetworkDrive oDrives.Item(i), true, true
'    ErrCheck Err.Number
'Next

' Map drives
oWshNetwork.MapNetworkDrive Drv1, Srv & Share1
ErrCheck Err.Number

Set oDrives = oWshNetwork.EnumNetworkDrives
For i = 0 To oDrives.Count - 1 Step 2
    If oDrives(i) <> " " Then
        MapList = MapList & oDrives(i) & " --> " & oDrives(i+1) & vbCrLf
    End If
Next

WScript.Echo MapList

' Set cscript as default WSH shell
Sub SetCScript ()
    Dim iPosition
    iPosition = InStr( LCase(WScript.FullName) , "cscript.exe" )
    If iPosition = 0 Then 
        Set oWshShell = CreateObject("WScript.Shell")
        oWshShell.Run "cmd.exe /k cscript.exe //nologo " & """" & WScript.ScriptFullName & """"
        WScript.Quit(0)
    End If
End Sub

' Show error
Sub ErrCheck(nr)
    Select Case nr
        Case 0
            ' No error
        Case -2147024829 
            WScript.Echo "Error: Network resource doesn't exist"
        Case -2147024811 
            WScript.Echo "Error: Drive already mapped"
        Case Else
            WScript.Echo "Error: " & CStr(nr)
    End Select
End Sub

</code>

===== Очистка файлообменника =====

http://nexusnotes.ru/2009/12/right-clean-exchange/

  - при запуске скрипт перемещает файлы и каталгоги с датой модификации старее 7 дней в каталог deletion_queue.
  - из каталога deletion_queue удаляется все что старее 10 дней
  - если создать каталог dont_delete, олн не будет очищаться

<code VB>
'==========================================================================
' File: clear_common_v2s.vbs
'
' AUTHOR: Konstantin Timokhin [k.timokhin@gmail.com]
' DATE  : 14.05.2006
'
' COMMENT: clear common exchange folders
'
'==========================================================================
On Error Resume Next 
'================================
'preinitialization
'================================
Set args = WScript.Arguments

if args.Count = 0 Then
   WScript.Echo "Usage: [CScript | WScript] clear_exchange.vbs <exchangefolderspoint>"
   WScript.Quit 1
end if
'================================
'defining global values
'================================

ExchangeFoldersPoint = args.Item(0) 'main point of exchange folders
DeletionQueueFolderName = "_deletion_queue_"   'folder inside each exchange folders like stored "deleted file"
LeaveOutFolders = Array("")                    'do not disturb folders
SkipedFiles = Array("exchange_folder_information.txt")              'touch-me-not files inside exchange folders
SkipedFolders = Array(DeletionQueueFolderName, "donotdelete") 'touch-me-not folders inside exchange folders 
											   'DeletionQueueFolderName must be permanently included in this list
DeletionQueueDaysOld = 10 'days past since last file modification sufficiently for deleting
ExchangeDaysOld = 7       'days past since last file modification sufficiently for moving to deletion queue

'================================
' functions library
'================================

'----common functions-----

Function InArray(Arr, SearchIt)
  arr_temp = Filter(Arr, SearchIT, True, 1)
  InArray = false
  For Each element In arr_temp
  	If UCase(element) = UCase(SearchIt) Then InArray = true
  Next
End Function

Function FixAp(body)
	FixAp=Replace(body, "'", "\'")
End Function

'----files and folders operations----

Function DeleteFolder(Folderpath)
    DeleteFolder = 53
	Set colFolders = objWMIService.ExecQuery("Select * from Win32_Directory where Name = '" & FixAp(Replace(Folderpath, "\", "\\")) & "'")
	For Each objFolder in colFolders
    	errResults = objFolder.Delete
	Next
	DeleteFolder = errResult
    'objFSO.DeleteFolder(Folderpath)
End Function

Function MoveFolder(SourcePath, DestinationPath, Foldername)
    MoveFolder = 53
	Set colFolders = objWMIService.ExecQuery("Select * from Win32_Directory where Name = '" & FixAp(Replace(SourcePath & "\" & Foldername, "\", "\\")) &"'")
	For Each objFolder in colFolders
    	errResults = objFolder.Rename(DestinationPath & "\" & Foldername)
	Next
	MoveFolder = errResults
End Function

Function DeleteFile(Filepath)
    DeleteFile = 53
	Set colFiles = objWMIService.ExecQuery("Select * from CIM_Datafile where Name = '" & FixAp(Replace(Filepath, "\", "\\")) & "'")
	For Each objFile in colFiles
		errResults = objFile.Delete
	Next
	DeleteFile = errResults
End Function

Function MoveFile(SourcePath, DestinationPath, Filename)
    MoveFile = 53
	Set colFiles = objWMIService.ExecQuery("Select * from CIM_Datafile where Name = '" & FixAp(Replace(SourcePath & "\" & Filename, "\", "\\")) & "'")
	For Each objFile in colFiles
		errResults = objFile.Rename(DestinationPath & "\" & Filename)
	Next
	MoveFile = errResult
End Function

Function DeleteFolders(SourcePath, ExcludedDirs)
	Set objFolder = objFSO.GetFolder(SourcePath)
	Set colSubfolders = objFolder.Subfolders
	For Each objSubfolder in colSubfolders
	    If Not InArray(ExcludedDirs, objSubfolder.Name) Then DeleteFolder(SourcePath & "\" & objSubfolder.Name)
	Next
End Function

Function MoveFolders(SourcePath, DestinationPath, ExcludedDirs)
	Set objFolder = objFSO.GetFolder(SourcePath)
	Set colSubfolders = objFolder.Subfolders
	For Each objSubfolder in colSubfolders
		If Not InArray(ExcludedDirs, objSubfolder.Name) Then MoveFolder SourcePath, DestinationPath, objSubfolder.Name
	Next
End Function

Function DeleteFiles(SourcePath, ExcludedFiles)
  Set Folder = objFSO.GetFolder(SourcePath)
  For Each file In Folder.Files
    If Not InArray(ExcludedFiles, Mid(file, Len(SourcePath)+2)) Then DeleteFile(file)
  Next
End Function

Function MoveFiles(SourcePath, DestinationPath, ExcludedFiles)
  Set Folder = objFSO.GetFolder(SourcePath)
  For Each file In Folder.Files
    If Not InArray(ExcludedFiles, Mid(file, Len(SourcePath)+2)) Then MoveFile SourcePath, DestinationPath, Mid(file, Len(SourcePath)+2)
  Next
End Function

'================================
'initiallization
'================================

strComputer = "."
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

'================================
'processing
'================================

Function deleteOldFiles(Folderpath, DaysOld)
'first processing all subfolders
  deleteOldFiles = False
  For Each Subfolder In objFSO.GetFolder(Folderpath).SubFolders
     sPath = Subfolder.Path
     If Not deleteOldFiles(Subfolder.Path, DaysOld) Then
     	DeleteFolder sPath
     Else
     	deleteOldFiles = True
     End If	
  Next
'next proccessing old files
  For Each File In objFSO.GetFolder(Folderpath).Files
	 If File.DateLastModified < (Date() - DaysOld) Then
		If DeleteFile(File) Then deleteOldFiles = True
	 Else
	 	deleteOldFiles = True
	 End If
  Next  
End Function

filesIsMoved = 0

Function moveOldFiles(Folderpath, DaysOld, ExcludedFolders, ExcludedFiles)
'first processing all subfolders
  moveOldFiles = 1
  For Each Subfolder In objFSO.GetFolder(Folderpath).SubFolders
     sPath = Subfolder.Path
     If Not InArray(ExcludedFolders, Subfolder.Name) Then
        If moveOldFiles(Subfolder.Path, DaysOld, ExcludedFolders, ExcludedFiles) Then
     	  DeleteFolder sPath
     	Else
     	  moveOldFiles = 0
     	End If
     Else
     	moveOldFiles = 0
     End If	
  Next
'next proccessing old files
  structureCreated = False
  curFolder = Mid(FolderPath, Len(ExchangeFoldersPoint) + 2)
  curDFolder = ExchangeFoldersPoint + "\" + DeletionQueueFolderName + "\" + curFolder
  For Each File In objFSO.GetFolder(Folderpath).Files
	 If Not InArray(ExcludedFiles, Mid(file, Len(Folderpath)+2)) And File.DateLastModified < (Date() - DaysOld) Then
	 	If Not structureCreated Then
	 	    If Not objFSO.FolderExists(curDFolder) Then
	 	        tArr = Split(curFolder, "\")
	 	        cDir = ""
				For Each DirName In tArr
				  If cDir = "" Then 
				  	cDir = DirName
				  Else
				  	cDir = cDir & "\" & DirName
				  End If
				  tDir = ExchangeFoldersPoint + "\" + DeletionQueueFolderName + "\" & cDir
  	 	    	  If Not objFSO.FolderExists(tDir) Then objFSO.CreateFolder(tDir)
  	 	    	Next
	 	    End If
	 		structureCreated = 1
	 	End If
		MoveFile FolderPath, curDFolder, Mid(File, Len(FolderPath)+2)
	 Else
	 	moveOldFiles = 0
	 End If
  Next
End Function

Function ProcessExchangeFolder(Folderpath)
'checking existing deletion queue folder and creating it on necessary
 If not objFSO.FolderExists(Folderpath & "\" & DeletionQueueFolderName) Then
   objFSO.CreateFolder(Folderpath & "\" & DeletionQueueFolderName)
 Else
 	deleteOldFiles Folderpath & "\" & DeletionQueueFolderName, DeletionQueueDaysOld
 End If
 moveOldFiles Folderpath, ExchangeDaysOld, SkipedFolders, SkipedFiles
End Function

'For Each Subfolder in objFSO.GetFolder(ExchangeFoldersPoint).SubFolders
'   If not InArray(LeaveOutFolders, Subfolder.Name) Then 
'     currentExchangeFolder = Subfolder.Name
'   	 ProcessExchangeFolder(Subfolder.Path)
'   End If
'Next

ProcessExchangeFolder(ExchangeFoldersPoint)

</code>

===== Установка пароля администратора =====
<code VB>
'*************************************************
' File: Set.LocalAdmin.Password.vbs
'
' Set password for local administrator 
'*************************************************

On Error Resume Next

strPasswd = "AdMiNi$tRaT0r"

Set Network = WScript.CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")

strServer = Network.ComputerName

strWQLquery = "SELECT * FROM Win32_UserAccount WHERE domain = '" & strServer & "'"

Set colAllSysUsers = objWMIService.ExecQuery( strWQLquery )

For Each User In colAllSysUsers
    RID = Right( User.SID ,3)
  
    If RID = "500" Then
       Set objUser = GetObject("WinNT://" & strServer & "/" & User.Name & ",user")
       objUser.Setpassword strPasswd
       objUser.SetInfo 
       Exit For 
    End If

Next
</code>