helb
|
 Posted: Mon Nov 03, 2014 20:42 Post subject: |
 |
|
Часто требуется быстренько добавить префикс к именам группы файлов. Для того чтобы делать это быстрее чем встроенным групповым переименованием и не мусорить в его истории по-мелочам, а главное с именем файла под курсором в качестве шаблона. Выделяем нужное, опционально ставим курсор на файл, уже содержащий нужный текст, запускаем (к примеру, Ctrl+Shift+M), правим текст/вводим новый.
Можно добавлять как префикс так и суффикс, вместе и по отдельности — разделитель ‹:›
affix-rename.vbs:
| Code: |
'===============================================================
' Affix rename (by helb)
' Add prefix and/or suffix to each file/dir in a list (UTF-16 encoded):
' ‘:’ — prefix-suffix separator (e.g. “:suffix” or “prefix:suffix”)
' Добавляет префикс и/или суффикс к каждому файлу/папке в списке
' ‘:’ — разделитель префикса и суффикса
'
' Parameters: <listfile (UTF-16)> [<suggestion>]
' Total Commander parameters: %WL "%O"
'===============================================================
Option Explicit
dim FSO, F, fobj, name, prefix, suffix, list, confirmed
set FSO = CreateObject("Scripting.FileSystemObject")
if WScript.Arguments.length = 0 then
WScript.Echo("No parameters specified")
WScript.Quit
end if
if FSO.FileExists(WScript.Arguments(0)) then
List = WScript.Arguments(0)
else
WScript.Echo("No list")
WScript.Quit
end if
if WScript.Arguments(1) <> "" then name = WScript.Arguments(1)
name = InputBox("Enter affix (use ‘:’ to denote suffix)", "Rename", name)
if name = "" then WScript.Quit
name = Split(name, ":")
prefix = name(0)
if Ubound(name) < 1 then suffix = "" else suffix = name(1)
for each F in Split(FSO.OpenTextFile(List, 1, false, -1).ReadAll, vbNewLine)
if F <> "" then
set fobj = getObj(F)
if not fobj is nothing then
name = fobj.ParentFolder.Path & "\" & prefix & FSO.GetBaseName(F) & suffix & "." & FSO.GetExtensionName(F)
if objExists(name) > 0 and confirmed = Empty then
confirmed = MsgBox("Name conflict. Overwrite all? (“No” to skip all)" & vbCrLf & "Note: overwriting folders will delete contents", vbExclamation + vbYesNoCancel, "Confirm")
if confirmed = vbCancel then exit for
end if
if objExists(name) > 0 and confirmed = vbYes or objExists(name) = 0 then
if objExists(name) > 0 then getObj(name).Delete
fobj.Move(name)
end if
end if
end if
next
WScript.Quit
function getObj(fl)
if FSO.FileExists(fl) then
set getObj = FSO.GetFile(fl)
elseif FSO.FolderExists(fl) then
set getObj = FSO.GetFolder(fl)
else
set getObj = nothing
end if
end function
'0=not exists, 1=is file, 2=is folder
function objExists(name)
if FSO.FileExists(name) then
objExists = 1
elseif FSO.FolderExists(name) then
objExists = 2
else
objExists = 0
end if
end function
function getNewName(name)
if Right(name, Len(ext)) = ext then getNewName = Left(name, Len(name) - Len(ext)) else getNewName = name & ext
end function
|
|
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
