Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: Создание папки с выделенными файлами 
Author Message
helb



PostPosted: Thu Oct 09, 2014 18:20    Post subject: Reply with quote

Avada wrote:
В случае перемещения это вообще стандартный функционал TC, реализованный через инструмент группового переименования
Обычное копирование/перемещение тоже работает: F5/F6 → <имя каталога>\ → Enter.

Вообще как раз недавно слепил скрипт и повесил на Shift+F7. Создает каталог и перемещает выделенное в него. Если начать с “/” — создает в противоположной панели, если закончить на “\” — переходит в каталог, если использовать “.” вместо имени создает по текущей дате-времени. Все три опции можно сочетать. В качестве имени по умолчанию подставляется то, что под курсором.
Code:
'=====================================================================================
' TC Move to new dir (by helb)
' Creates new dir and moves selected files to it
' Usage: start new dir name with ‘/’ to create+move in opposite panel
' end dir name with ‘\’ to navigate inside after operation
' enter "." instead of name to create dir named with current date+time
' Parameters: %WL "%T" %P%N (list, target panel, suggested name+default parent dir (in case of mixed location mode))
'=====================================================================================
if WScript.Arguments.Count < 3 then
  MsgBox "Not enough parameters", vbOKOnly + vbError, "Warning!"
  Wscript.Quit
end if

dim list, FSO, fObj, fName, fPath, newDir, nav, opp, confirmed
set FSO = CreateObject("Scripting.FileSystemObject")

set fObj = getObj(WScript.Arguments(2))
newDir = InputBox("Enter name. ‘/’ as first character = opposite panel, ‘\’ as last = navigate to dir, ‘.’ = current date-time", "Move to dir", FSO.GetBaseName(fObj))
if NewDir = "" then WScript.Quit

if Right(newDir, 1) = "\" then
   nav = "L"
   newDir = Left(newDir, Len(newDir)-1)
else
   nav = ""
end if
if Left(newDir, 1) = "/" then
   opp = true
   newDir = Replace(newDir, "/", "", 1, 1)
end if
if newDir = "." then newDir = getDateTime(Now)

'wscript.echo(fObj.ParentFolder)
if opp then
   newDir = WScript.Arguments(1) & newDir
   if nav = "L" then nav = "R"
else
   newDir = fObj.ParentFolder & "\" & newDir
end if
if not FSO.FolderExists(newDir) then
   FSO.CreateFolder(newDir)
end if

set list = FSO.OpenTextFile(WScript.Arguments(0), 1, false, true)

do until list.AtEndOfStream
   fName = list.ReadLine
   set fObj = getObj(fName)
   if not fObj is nothing then
      newPath = newDir & "\" & getNameOnly(fName)
'wscript.echo(newpath)
      if objExists(newPath) > 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 do
      end if
      if objExists(newPath) = 0 then
         fObj.Move(newDir & "\")
      elseif confirmed = vbYes then
         getObj(newPath).Delete
         fobj.Move(newDir & "\")
      end if
   end if
loop

if nav <> "" then
   with CreateObject("WScript.Shell")
      .Run """%COMMANDER_EXE%"" /O /S /" & nav & "=""" & newDir & """", 0, true
      'if nav = "R" Then .SendKeys "{TAB}"
   end with
end if


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

function getNameOnly(fl)
   if Right(fl, 1) = "\" then fl = Left(fl, Len(fl)-1)
   getNameOnly = FSO.GetFileName(fl)
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 getDateTime(dt)
    s = datepart("yyyy",dt)
    s = s & "-" & RIGHT("0" & datepart("m",dt),2)
    s = s & "-" & RIGHT("0" & datepart("d",dt),2)
    s = s & "_"
    s = s & RIGHT("0" & datepart("h",dt),2)
    s = s & "-" & RIGHT("0" & datepart("n",dt),2)
    s = s & "-" & RIGHT("0" & datepart("s",dt),2)
    getDateTime = s
end function
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group