Total Commander

Код: Выделить всё

function setParams(){
  FSO = new ActiveXObject("Scripting.FileSystemObject");
 }
 
 function newFolder(){
  var newFolderName, newFolderName_n, counter, folderCreated; 
  newFolderName = "TEST";
  newFolderName_n = "TEST";
  counter = 0;
  folderCreated = false;
  while (! folderCreated){
    if (FSO.FolderExists(newFolderName)) {
     counter++
     newFolderName = newFolderName_n+"("+counter+")";
    } 
    else {
     FSO.CreateFolder(newFolderName);
     folderCreated = true; 
     var test = new ActiveXObject("WScript.shell");
     test.run(newFolderName, 1, false); // открывает в проводнике
    }
  }
 }

 setParams();
 newFolder();

Код: Выделить всё

' Расширенное создание папок
' Параметры "%P" (в кавычках) 

' ============================
' Изменяемые в VBS параметры:
  DelTire = 1 ' удаление " - " (пробел тире пробел) в конце имен папок, 0 - нет, 1 - да
' ============================

On Error Resume Next
set FSO = createobject ("Scripting.FileSystemObject")
DateNow = Year(Date) & "." & Right(0 & Month(Date), 2) & "." & Right(0 & Day(Date), 2) & " - "
Fld = Inputbox("Введите имя папки" & vbnewline & vbnewline & "   * (звездочка) - создание папок по списку из буфера обмена" & vbnewline & "   ** (две звездочки) - то же, но с сохранением порядка", "Расширенное создание папок", DateNow)
if IsEmpty(Fld) then Wscript.Quit

' ===== Обработка буфера обмена
if Fld="*" Or Fld="**" then 
  If Fld="**" then num = 1 else num = 0
  Fld = CreateObject("HTMLFile").parentWindow.clipboardData.getData("Text")
  CrLfArr = Array(vbnewline, chr(13), chr(10), "||")
  For Each a In CrLfArr
    Fld = replace(Fld, a, "|")
  Next
  Fld = replace(Fld, Chr(9) & "|", "|")
  Fld = replace(Fld, Chr(9), " - ")
  Fld = replace(Fld, """", "")
End If

' ===== замена запрещенных символов
Sym = "/\*?"":<>" 
For i = 1 To Len(Sym)
  Fld = Replace(Fld, Mid(Sym, i, 1), "_")
Next
For i=1 to 100
  Fld = replace(Fld, "  ", " ")
  Fld = replace(Fld, "- -", "-")
Next
Fld = replace(Fld, " - |", "|")

' ===== Основная обработка создания папок
For Each FldName In Split(Fld, "|")
  QuantityFlds = QuantityFlds + 1 ' общий счет количества создаваемых папок
  If num = 1 then 
    k = k + 1
    number = right("000" & k, 4) & ". "
  End If 
  Err.Number = 0
  if right(FldName, 3) = " - " and DelTire = 1 then FldName=left(FldName, len(FldName) - 3)
  FullpathNewFolder = WScript.Arguments(0) & number & Trim(FldName) 
  If FldName <> "" then FSO.CreateFolder FullpathNewFolder 
  If Err.Number <> 0 then ErrText = ErrText & vbnewline & "•  " & number & Trim(FldName)
Next

' ===== сообщение об ошибке при создании папок
If ErrText <> "" then 
  msgbox "Ошибка создания папок, возможны следующие причины:" & vbnewline & "  1) Папки уже существуют" _
    & vbnewline & "  2) Вы пытаетесь создать папки с одинаковыми именами" & vbnewline _
    & "  3) Превышение максимальной длины пути" & vbnewline & ErrText
  Wscript.Quit
end if

' ===== если созданная папка ОДНА, то автоматический вход в нее в ТС
If QuantityFlds = 1 then  
  Set WshShell = CreateObject("WScript.Shell")
  TCP = WshShell.ExpandEnvironmentStrings("%commander_path%")
  WshShell.run """" & TCP & "\TOTALCMD.EXE"" /O /S """ & FullpathNewFolder & """"
End If

Код: Выделить всё

Set WshShell = CreateObject("WScript.Shell")
  TCP = WshShell.ExpandEnvironmentStrings("%commander_path%")
  WshShell.run """" & TCP & "\TOTALCMD.EXE"" /O /S """ & FullpathNewFolder & """"

Код: Выделить всё

' Создать папку TEST и войти в нее
' Параметры "%P" (в кавычках) 

On Error Resume Next
NewFolder="TEST"
FullpathNewFolder=WScript.Arguments(0) & "" & NewFolder
set FSO = createobject ("Scripting.FileSystemObject")
FSO.CreateFolder FullpathNewFolder 
Set WshShell = CreateObject("WScript.Shell")
TCP = WshShell.ExpandEnvironmentStrings("%commander_path%")
WshShell.run """" & TCP & "\TOTALCMD.EXE"" /O /S """ & FullpathNewFolder & """"

Код: Выделить всё

' Создать папку TEST и войти в нее
' Параметры "%P" (в кавычках)

On Error Resume Next
NewFolder="TEST"
FullpathNewFolder=WScript.Arguments(0) & "\" & NewFolder
set FSO = createobject ("Scripting.FileSystemObject")
FSO.CreateFolder FullpathNewFolder
Set WshShell = CreateObject("WScript.Shell")
WshShell.run "C:\totalcmd\TOTALCMD64.EXE /O /S """ & FullpathNewFolder & """"

Код: Выделить всё

' Создать папку TEST и войти в нее, если существует, то добавить счетчик
' Параметры "%P" (в кавычках)

On Error Resume Next
NewFolder="TEST"
set FSO = createobject ("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
FullpathNewFolder=WScript.Arguments(0) & "\" & NewFolder
Do while FSO.FolderExists(FullpathNewFolder)
  i=i+1
  FullpathNewFolder=WScript.Arguments(0) & "\" & NewFolder & "_" & i
Loop
FSO.CreateFolder FullpathNewFolder
TCP = WshShell.ExpandEnvironmentStrings("%commander_exe%")
WshShell.run """" & TCP & """ /O /S """ & FullpathNewFolder & """"