[Iska]

irvicon, попробуйте так:

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

Код:

Option Explicit

Dim objFSO
Dim objFile
Dim objRegExp

Dim strFileSource2
Dim strFileDest

Dim objImageFileSource1
Dim objImageFileSource2
Dim objImageFileWork

Dim objImageProcess

Dim lngCount


If WScript.Arguments.Count = 2 Then
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If objFSO.FolderExists(WScript.Arguments.Item(0)) Then
		If objFSO.FolderExists(WScript.Arguments.Item(1)) Then
			Set objRegExp = WScript.CreateObject("VBScript.RegExp")
			
			With objRegExp
				.IgnoreCase = True
				.Pattern = "2011_\d{3}[13579]{1}\.jpg"
			End With
			
			lngCount = 0
			
			For Each objFile In objFSO.GetFolder(WScript.Arguments.Item(0)).Files
				If objRegExp.Test(objFile.Name) Then
					lngCount = lngCount + 1
					
					WScript.Echo "Iteration #" & CStr(lngCount)
					WScript.Echo "  Source #1:   " & objFile.Path
					
					strFileSource2 = objFSO.BuildPath( _
						objFile.ParentFolder, _
						"2011_" & Right("0000" & CStr(CLng(Right(objFSO.GetBaseName(objFile.Name), 4)) + 1), 4) & "." & _
						objFSO.GetExtensionName(objFile.Name) _
					)
					
					WScript.Echo "  Source #2:   " & strFileSource2
					
					If objFSO.FileExists(strFileSource2) Then
						Set objImageFileSource1 = WScript.CreateObject("WIA.ImageFile")
						Set objImageFileSource2 = WScript.CreateObject("WIA.ImageFile")
						
						Set objImageProcess     = WScript.CreateObject("WIA.ImageProcess")
						
						objImageFileSource1.LoadFile objFile.Path
						objImageFileSource2.LoadFile strFileSource2
						
						With objImageProcess
							' Создаём «болванку» итогового изображения посредством 
							' масштабирования первого изображения до нужного размера
							' Это работает быстрее, нежели формирование его вручную
							
							.Filters.Add .FilterInfos("Scale").FilterID
							
							With .Filters.Item(.Filters.Count).Properties
								' По первому изображению определяем, где у него «узкая» сторона
								' В ту сторону и увеличиваем изображение, влево или вниз
								If objImageFileSource1.Width / objImageFileSource1.Height >= 1 Then
									.Item("MaximumWidth")  = objImageFileSource1.Width + objImageFileSource2.Width
									.Item("MaximumHeight") = objImageFileSource1.Height
								Else
									.Item("MaximumWidth")  = objImageFileSource1.Width
									.Item("MaximumHeight") = objImageFileSource1.Height + objImageFileSource2.Height
								End If
								
								.Item("PreserveAspectRatio") = False
							End With
							
							' Получаем «болванку» изображения
							Set objImageFileWork = .Apply(objImageFileSource1)
							
							.Filters.Remove .Filters.Count
							
							
							' Накладываем на полученное изображение первое изображение
							.Filters.Add .FilterInfos("Stamp").FilterID
							
							With .Filters.Item(.Filters.Count).Properties
								.Item("ImageFile") = objImageFileSource1
								.Item("Left")      = 0
								.Item("Top")       = 0
							End With
							
							' Накладываем на полученное изображение второе изображение
							.Filters.Add .FilterInfos("Stamp").FilterID
							
							With .Filters.Item(.Filters.Count).Properties
								.Item("ImageFile") = objImageFileSource2
								
								' По первому изображению определяем, где у него «узкая» сторона
								' К той стороне и прикладываем второе изображение, слева или снизу
								If objImageFileSource1.Width / objImageFileSource1.Height >= 1 Then
									.Item("Left")      = objImageFileSource1.Width
									.Item("Top")       = 0
								Else
									.Item("Left")      = 0
									.Item("Top")       = objImageFileSource1.Height
								End If
							End With
							
							' Получаем итоговое изображение
							Set objImageFileWork = .Apply(objImageFileWork)
							
							.Filters.Remove .Filters.Count
							.Filters.Remove .Filters.Count
						End With
						
						' Сохраняем полученное итоговое изображение
						strFileDest = WScript.Arguments.Item(1) & "\2011_s" & Right("0000" & CStr(lngCount), 4) & "." & objImageFileWork.FileExtension
						
						If objFSO.FileExists(strFileDest) Then
							objFSO.DeleteFile strFileDest, True
						End If
						
						objImageFileWork.SaveFile strFileDest
						
						WScript.Echo "  Destination: " & strFileDest
						WScript.Echo
					Else
						WScript.Echo "    Can't find odd source file [" & strFileSource2 & "]"
						WScript.Echo
					End If
				Else
					' Nothing to do
				End If
			Next
			
			Set objImageProcess     = Nothing
			
			Set objImageFileSource1 = Nothing
			Set objImageFileSource2 = Nothing
			
			Set objRegExp           = Nothing
		Else
			WScript.Echo "Can't find destination folder [" & WScript.Arguments.Item(1) & "]"
		End If
	Else
		WScript.Echo "Can't find source folder [" & WScript.Arguments.Item(0) & "]"
	End If
	
	Set objFSO = Nothing
Else
	WScript.Echo "Usage: " & WScript.ScriptName & " <Source folder> <Destination folder>"
End If

WScript.Quit

Код сохранить в файл с кодировкой ANSI (win-1251) с расширением «.vbs». Исполнять, указав папку-источник и папку назначения аргументами скрипта. Например:

Код:

cscript.exe "e:\Песочница\0082\Script.vbs" "e:\Песочница\0082\Source" "e:\Песочница\0082\Destination"

Примерный результат работы

Код:

Iteration #1
  Source #1:   E:\Песочница\0082\Source\2011_0001.jpg
  Source #2:   E:\Песочница\0082\Source\2011_0002.jpg
  Destination: E:\Песочница\0082\Destination\2011_s0001.jpg

Iteration #2
  Source #1:   E:\Песочница\0082\Source\2011_0003.jpg
  Source #2:   E:\Песочница\0082\Source\2011_0004.jpg
  Destination: E:\Песочница\0082\Destination\2011_s0002.jpg

Iteration #3
  Source #1:   E:\Песочница\0082\Source\2011_0005.jpg
  Source #2:   E:\Песочница\0082\Source\2011_0006.jpg
  Destination: E:\Песочница\0082\Destination\2011_s0003.jpg