[Iska]

NibelungXXX, на WSH:

читать дальше »

Код:

Option Explicit

Dim strSourceFolder
Dim strDestFolder

Dim objFSO

Dim strComputer

Dim objSWbemLocator
Dim objSWbemServicesEx
Dim objSWbemSink


strSourceFolder = "E:\Песочница\0334\Source"
strDestFolder   = "E:\Песочница\0334\Destination"

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(strSourceFolder) Then
	If objFSO.FolderExists(strDestFolder) Then
		strComputer = "."
		
		Set objSWbemLocator    = WScript.CreateObject("WbemScripting.SWbemLocator")
		Set objSWbemServicesEx = objSWbemLocator.ConnectServer(strComputer, "root\cimv2")
		Set objSWbemSink       = WScript.CreateObject("WbemScripting.SWbemSink", "Sink_")
		
		With objSWbemServicesEx.Get("Win32_Directory.Name='" & Replace(strDestFolder & "\.", "\", "\\") & "'")
			objSWbemServicesEx.ExecNotificationQueryAsync objSWbemSink, _
				"SELECT * FROM __InstanceOperationEvent WITHIN 1 WHERE " & _
				"TargetInstance ISA 'CIM_DataFile' AND " & _
				"TargetInstance.Drive = '" & .Drive & "' AND " & _
				"TargetInstance.Path = '"  & .Path  & "'"
			
			Do
				WScript.Sleep 100
			Loop
			
			objSWbemSink.Cancel
			
			Set objSWbemSink       = Nothing
			Set objSWbemServicesEx = Nothing
			Set objSWbemLocator    = Nothing
		End With
	Else
		WScript.Echo "Destination folder [" & strDestFolder & "] not found."
		WScript.Quit 2
	End If
Else
	WScript.Echo "Source folder [" & strSourceFolder & "] not found."
	WScript.Quit 1
End If

Set objFSO = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub Sink_OnObjectReady(objSWbemObjectEx, objSWbemAsyncContext)
	Const intMaxCount = 5
	
	Dim intCount
	Dim objFile
	
	If objSWbemObjectEx.Path_.Class = "__InstanceDeletionEvent" Then
		If objFSO.GetFolder(strDestFolder).Files.Count = 0 Then
			intCount = 0
			
			For Each objFile In objFSO.GetFolder(strSourceFolder).Files
				objFile.Move strDestFolder & "\"
				
				intCount = intCount + 1
				
				If intCount >= intMaxCount Then
					Exit For
				End If
			Next
		End If
	End If
End Sub
'=============================================================================

Есть ряд тонкостей.

Поскольку критерием инициации процесса было задано отсутствие файлов во второй папке, и в скрипте используется подписка на события удаления файлов из второй папки, то первая тонкость такова: если в момент запуска скрипта вторая папка была уже пуста — нужно создать в ней/скопировать в неё какой-либо файл и затем сразу удалить его. Вторая тонкость: если в момент работы скрипта обе папки окажутся пустыми, то он никак не отреагирует на добавление файлов в первую папку, и опять понадобится проделать ту же самую операцию — создать во второй папке/скопировать в неё какой-либо файл и затем сразу удалить его.

Чтобы избавиться от подобных «тараканов», нужно в столовой, где я работаю, взять полпорции суточных щей… изменить техзадание, и следить не только за состоянием второй папки (события удаления файла), но и за состоянием первой, исходной папки (события создания файлов).