jehaz
|
 Posted: Fri Aug 17, 2007 21:16 Post subject: |
 |
|
Вот скрипт который можно повесить на кнопку с параметром %L
Копирует выделенные файлы в ту же папку добавляя нумерацию копии в скобках идентично ТС.
Облазил форум, вроде такого не было.
| Code: | '================================================================
' Параметры %L
' Создает копию выделенных файлов добавляя к имени порядковый
' номер в скобках (идентично TC). Если в имени уже присутствует
' порядковый номер в скобках, то увеличивает нумерацию до появления
' незанятого номера.
'================================================================
Option Explicit
Dim FSO, WSHArg, Argument, FileList, FileStr, FileFullName, Counter
Dim FileName, LenFileName, FileExt, FilePath, CounterLen, FileVName
Dim BetweenSkoba, OpenSkoba, BeforeSkoba, BetweenSkobaInt, TextStream
Set FSO = CreateObject("Scripting.FilesystemObject")
Set WSHArg = WScript.Arguments
If WSHArg.Count > 0 Then
Argument = WSHArg.Item(0)
Set FileList = FSO.GetFile(Argument)
Set TextStream = FileList.OpenAsTextStream(1)
FileStr = vbNullString
While Not TextStream.AtEndOfStream
FileStr = TextStream.ReadLine()
Counter = 1
FileName = FSO.GetBaseName(FileStr)
CounterLen = Len(FileName)
Do ' Работаем пока не найдется имя не занятое файлами
If Mid(FileName,Len(FileName),1) = ")" Then ' Если в конце имени файла скобка, то возможно это уже ранее созданные копии файлов. Проверяем.
Do While CounterLen <> 0
If Mid(FileName,CounterLen,1) = "(" Then ' Если находится в имени закрытая скобка, то предположим что до скобок это имя, а в скобках нумерация копий
OpenSkoba = CounterLen
BetweenSkoba = Mid(FileName,OpenSkoba+1,Len(FileName)-CounterLen-1) ' Получаем значение находящиеся между скобками
BeforeSkoba = Mid(FileName,1,OpenSkoba-1) ' Получаем предположительное имя до скобок
CounterLen = 0
Else
CounterLen = CounterLen - 1
End If
Loop
On Error Resume Next ' Отключаем ошибочку
BetweenSkobaInt = FormatNumber(BetweenSkoba,0) ' Преобразуем междускобие в числовой формат
If Err.Number = 0 Then ' Если ошибок нет, то в скобках было число
If BetweenSkoba - BetweenSkobaInt = 0 Then ' Проверяем на всякий случай вдруг в скобках десятичная дробь
FileName = BeforeSkoba ' Задаем имя как отобранное до скобок
Counter = Counter + BetweenSkobaInt - 1
End If
End If
End If
CounterLen = 0
Counter = Counter + 1
FileExt = FSO.GetExtensionName(FileStr) ' получаем расширение
FilePath = FSO.GetParentFolderName(FileStr) ' полный путь
FileVName = FileName & "(" & Counter & ")" ' делаем новое имя
If FileExt <> "" Then ' проверям на наличе расширения
FileFullName = FilePath & "\" & FileVName & "." & FileExt ' Собираем имя в кучу
Else
FileFullName = FilePath & "\" & FileVName ' Без расширения куча
End If
Loop until not (FSO.FileExists(FileFullName) or FSO.FolderExists(FileFullName))
If FSO.FileExists(FileStr) Then ' Еще раз проверяем наличие источника
FSO.CopyFile FileStr, FileFullName ' Копируем
End If
Wend
End If
WScript.Quit |
Немного подправил.
Last edited by jehaz on Mon Aug 20, 2007 16:55; edited 3 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
