Batya

|
Posted: Sat Jun 11, 2011 14:21 Post subject: |
|
|
sergiokapone
Т.к., ещё раз повторю, указанных выше утилит у меня нет, приводимый vbs-скрипт мной не тетировался. Пиши об ошибках.
Скрипт работает по выделенным файлам или папкам или по текущим под курсором. Имена можно задать через параметры или будут использоваться значения по-умолчанию.
Code: | '=====================================================================
' Пакетное формирование djvu-файлов
'
' Параметры:
' {файл-список} [{целевое имя файла} [{имя файла 1} [{имя файла 2}]]]
'
' Примеры параметров при вызове из TC:
' %L
' %L "demo"
' %L "demo" "foreground" "background"
'=====================================================================
Option Explicit
'======== Изменяемые параметры =======================================
Const Util1 = "tifftopnm"
Const Util2 = "pnmtodjvurle"
Const Util3 = "csepdjvu"
Const DefBaseName1 = "foreground"
Const DefBaseName2 = "background"
Const DefTargetName = "demo"
Const BaseExt1 = "tif"
Const BaseExt2 = "tif"
Const TargetExt = "djvu"
Const TransitFile1 = "foreground.rle"
Const TransitFile2 = "background.ppm"
Const TransitFile3 = "output.sep"
'=====================================================================
Dim FSO, WSH, FF, F, BaseName1, BaseName2, TargetName
With WScript
If .Arguments.Count = 0 Then
MsgBox "Не заданы параметры!", vbOKOnly + vbCritical, "Пакетное формирование djvu-файлов"
.Quit
End If
FF = .Arguments(0)
If .Arguments.Count > 1 Then
TargetName = .Arguments(1)
If TargetName = "" Then TargetName = DefTargetName
Else
TargetName = DefTargetName
End If
If .Arguments.Count > 2 Then
BaseName1 = .Arguments(2)
If BaseName1 = "" Then BaseName1 = DefBaseName1
Else
BaseName1 = DefBaseName1
End If
If .Arguments.Count > 3 Then
BaseName2 = .Arguments(3)
If BaseName2 = "" Then BaseName2 = DefBaseName2
Else
BaseName2 = DefBaseName2
End If
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
With FSO.OpenTextFile(FF, 1)
Do While Not .AtEndOfStream
F = Trim(.ReadLine)
If F <> "" Then
If FSO.FolderExists(F) Then ForFolder FSO.GetFolder(F)
If FSO.FileExists(F) Then ForFile FSO.GetFile(F)
End If
Loop
.Close
End With
Set FSO = Nothing
Set WSH = Nothing
WScript.Quit
Sub ForFile(pFile)
Dim lAdd, lFile1, lFile2
If InStr(1, pFile.Name, BaseName1, 1) = 1 And LCase(FSO.GetExtensionName(pFile.Name)) = BaseExt1 Then
lAdd = Mid(FSO.GetBaseName(pFile.Name), Len(BaseName1) + 1)
lFile1 = BaseName2 & lAdd & "." & BaseExt2
lFile2 = TargetName & lAdd & "." & TargetExt
If FSO.FileExists(pFile.ParentFolder.Path & "\" & lFile1) Then
WSH.Run "cmd /c " & Util1 & " " & pFile.Name & " | " & Util2 & " > " & TransitFile1, 7, True
WSH.Run "cmd /c " & Util1 & " " & lFile1 & " > " & TransitFile2, 7, True
WSH.Run "cmd /c copy /b " & TransitFile1 & "+" & TransitFile2 & " " & TransitFile3, 7, True
WSH.Run "cmd /c " & Util3 & " " & TransitFile3 & " " & lFile2 , 7, True
End If
End If
End Sub
Sub ForFolder(pFolder)
Dim lF
For Each lF In pFolder.Files
ForFile lF
Next
For Each lF In pFolder.SubFolders
ForFolder lF
Next
End Sub |
_________________ Нет, я не сплю. Я просто медленно моргаю.
Last edited by Batya on Sun Jun 12, 2011 01:13; edited 1 time in total |
|