Кнопка открытия текущего каталога в плагине NTFS4TC

[Flasher]

Есть кнопка:

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

TOTALCMD#BAR#DATA
%COMMANDER_PATH%\TOTALCMD.EXE /S /O
/L=\\\NTFS\"%P"
Icons\ntfs_root.ico
NTFS (Support/Create Images)

1
-1

Нужно вместо %P написать: I0 <Диск>: (<метка>)\<Путь без буквы диска>
Есть ли возможность создать переменные окружения для идентификатора, метки и пути без буквы диска? Сначала было подумал, что идентификатор можно обозначать в соответствии с алфавитным порядком букв дисков, но понятно, что это не подойдёт для приводов и хардов/флешек в Fat(16,32), соответственно, последовательность нарушится. Кто что может подсказать?

[Flasher]

Поскольку с переменными средами ничего не наклёвывается, приходится искать решение в WSH.

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

'Открыть текущий каталог в плагине NTFS4TC
Option Explicit
Dim TCS,fso,i,ID',Metka
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
For each i In fso.Drives
	'If i.DriveType=2 Then
	'Metka=i.VolumeName
	'End If
	'Next


Set TCS = CreateObject("TCScript.Helper")
TCS.SendCommand "cm_EditPath"
TCS.SendKeystroke "{HOME}{SPACE}{RIGHT 2}{SPACE}{(}"
	'TCS.SetTextToClip(Trim(Metka))
	'TCS.SendKeystroke "^{v}"
TCS.SendKeystroke "{)}{HOME}"
TCS.SetTextToClip "\\\NTFS\I"
TCS.SendKeystroke "^{v}"
TCS.SetTextToClip(Trim(ID))    ' Помещает в буфер номер смонтированного диска
TCS.SendKeystroke "^{v}"
TCS.SendKeystroke "{ENTER}"
TCS.ClearClip
Set TCS = Nothing
WScript.Quit

В общем накидал несколько корявый скрипт. Пока закомментированные строки не актуальны: оказалось, что плагин допускает пути без метки.

Требуется помощь скриптеров: вместо ID должен стоять номер смонтированного диска с файловой системой NTFS, присвоенного по счётчику плагином. Ну, предположительный сценарий:

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

If i.FileSystem = "NTFS" & i.DriveLetter = "C" Then ID=0
End If
If i.FileSystem = "NTFS" & i.DriveLetter = "D" Then ID=1
End If
...

Не знаю, как проверять, какой диск открыт в файловой панели в таком случае. Просьба помочь с реализацией идеи.

[Flasher]

Сегодня решил продолжить поиск решения. Написал-таки что-то поразумнее, но не знаю как всю эту петрушку (отделено знаками вопроса) зациклить.
Уважаемая просьба откликнуться и написать тем, кому есть что сказать по сему вопросу!
Volniy, Batya, LocKtaR-o-DarK, Tol'k, Lev, sa, будут любые соображения, пишите; если даже решение не проглядывается, просьба пояснить в чём сложность реализации, и есть ли смысл искать способ.

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

Dim TCS,objFSO,fso,i,ID,d0,d1,d2,d3',d4,d5,d6,d7
Set TCS = CreateObject("TCScript.Helper")
Set objFSO = CreateObject("Scripting.FileSystemObject")

TCS.SendCommand "cm_CopySrcPathToClip"
Str = TCS.GetTextFromClip
Set i = objFSO.GetDrive(Left(Str,2)) 'Определяем том диска активной папки

'Объявляем диски поочерёдно
Set d0 = objFSO.GetDrive("C:")
Set d1 = objFSO.GetDrive("D:")
Set d2 = objFSO.GetDrive("E:")
Set d3 = objFSO.GetDrive("F:")
'Set d4 = objFSO.GetDrive("H:")
'Set d5 = objFSO.GetDrive("G:")
'Set d6 = objFSO.GetDrive("H:")
'Set d7 = objFSO.GetDrive("I:")
'Set d8 = objFSO.GetDrive("J:")
'при желании продолжить

If i.FileSystem <> "NTFS" Then MsgBox "Файловая система не поддерживаетя!", TCS.ClearClip, WScript.Quit()

'??????????????Присваеваем номер диску????????????????????????????????????
If i.DriveLetter = "C" Then ID = "0"
If i.DriveLetter = "D" And d0.FileSystem <> "NTFS" Then ID = "0"
If i.DriveLetter = "D" And d0.FileSystem = "NTFS" Then ID = "1"

If i.DriveLetter = "E" And d0.FileSystem <> "NTFS" And d1.FileSystem <> "NTFS" Then ID = "0"
If i.DriveLetter = "E" And d0.FileSystem <> "NTFS" And d1.FileSystem = "NTFS" Then ID = "1"
If i.DriveLetter = "E" And d0.FileSystem = "NTFS" And d1.FileSystem = "NTFS" Then ID = "2"

'На эти строки( без ' ) возникает ругань "Диск не готов". >> В чём причина?
'If i.DriveLetter = "F" And d0.FileSystem <> "NTFS" And d1.FileSystem <> "NTFS" And d2.FileSystem <> "NTFS" Then ID = "0"
'If i.DriveLetter = "F" And d0.FileSystem = "NTFS" And d1.FileSystem <> "NTFS" And d2.FileSystem <> "NTFS" Then ID = "1"
'If i.DriveLetter = "F" And d0.FileSystem <> "NTFS" And d1.FileSystem <> "NTFS" And d2.FileSystem = "NTFS" Then ID = "1"
'If i.DriveLetter = "F" And d0.FileSystem <> "NTFS" And d1.FileSystem = "NTFS" And d2.FileSystem <> "NTFS" Then ID = "1"
'If i.DriveLetter = "F" And d0.FileSystem <> "NTFS" And d1.FileSystem = "NTFS" And d2.FileSystem = "NTFS" Then ID = "2"
'If i.DriveLetter = "F" And d0.FileSystem = "NTFS" And d1.FileSystem <> "NTFS" And d2.FileSystem = "NTFS" Then ID = "2"
'If i.DriveLetter = "F" And d0.FileSystem = "NTFS" And d1.FileSystem = "NTFS" And d2.FileSystem <> "NTFS" Then ID = "2"
'If i.DriveLetter = "F" And d0.FileSystem = "NTFS" And d1.FileSystem = "NTFS" And d2.FileSystem = "NTFS" Then ID = "3"
'Условия для остальных дисков дописывать по желанию)))))
'?????????????????????????????????????????????????????????????????????????????????

path = "\\\NTFS\I" + ID + " " + i + " (" + i.VolumeName + ")" + Right(Str,(Len(Str)-2)) + "\"
TCS.SetTextToClip(path)
TCS.SendCommand "cm_EditPath"
TCS.SendKeystroke "^{v}"
TCS.SendKeystroke "{ENTER}"
TCS.ClearClip
Set TCS = Nothing
Set objFSO = Nothing
WScript.Quit()

[Tol!k]

М.б. поможет
Буквы дисков с NTFS

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

wmic logicaldisk where (FileSystem="NTFS") get Name /value

Метки дисков с NTFS

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

wmic logicaldisk where (FileSystem="NTFS") get VolumeName /value

[Flasher]

Tol!k
Я немножко не понял, ты предлагаешь на основании wmic написать батник, а потом привернуть его к скрипту? Пытаясь сходу разобраться в смысле предложенных строк, пока не представляю, как оно может мне помочь в создании цикла для присвоения номера(числового значения) диска с конкретной файловой системой. Проясни, пожалуйста.

[Tol!k]

Я не спец по VBS, но мне кажется разобрать и пронумеровать уже отфильтрованный по типу ФС список проще и красивее, чем то, что ты написал между строками '????????????????????????????

[Flasher]

Tol!k
То, что у меня между знаками "?" - это вообще жуть, потому что с каждой новой буквой кол-во условий растёт с геометрической прогрессией. Только в том то и дело, что я представления не имею, как создать цикл, в которым будет пронумеровываться полученный список доступных NTFS-дисков.

[Tol!k]

как создать цикл, в которым будет пронумеровываться полученный список

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

wmic logicaldisk where (FileSystem="NTFS") get Name /value >ntfs.txt

— это обрабатываемый список

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

Dim fso, InFile, Cnt, Str, Strngs, ts, nn, rr
Set fso = CreateObject("Scripting.FileSystemObject")

InFile = "ntfs.txt"
Set ts = fso.OpenTextFile(InFile,1)

Cnt = 0
Strngs = ""
Do Until ts.AtEndOfStream
   Str = ts.ReadLine
   rr = Split(Str, "=")
   nn = UBound(rr)
   Letter = rr(nn)
   If nn >0 Then
      Strngs = Strngs & "Disk(" & CStr(Cnt) & ")  " & Replace(Letter, Chr(0), "")
      Cnt = Cnt+1
   End If
Loop

WScript.Echo(Strngs)

ts.Close
Set ts = Nothing
Set fso = Nothing
WScript.Quit

[Batya]

Flasher
Примерно так:

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

'=====================================================
' Открытие в TC текущей папки в плагине NTFS4TC
'
' Параметры:
' "%P"
'
' Автор - Batya
'=====================================================
Option Explicit
Dim FSO, WSH, D, i, Path, NewPath, FS, TCPath, Drive
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Path    = WScript.Arguments(0)
Drive   = UCase(Left(FSO.GetDriveName(Path), 1))
i = 0
NewPath = ""
For Each D In FSO.Drives
  On Error Resume Next
  FS = D.FileSystem
  If (Err.Number = 0) And (FS = "NTFS") Then
    If UCase(D.DriveLetter) = Drive Then
      NewPath = "\\\NTFS\I" & CStr(i) & " " & D.DriveLetter & ": (" & D.VolumeName & ")" & Mid(Path, 3)
      Exit For
    End If
    i = i + 1
  End If
  On Error GoTo 0
Next
If NewPath = "" Then
  MsgBox "Файловая система не поддерживается!", vbCritical+vbOKOnly, "Ошибка"
Else
  TCPath  = WSH.ExpandEnvironmentStrings("%Commander_Path%") & "\totalcmd.exe"
  'MsgBox """" & TCPath & """ /S /O /L=""" & NewPath & """"
  WSH.Run """" & TCPath & """ /S /O /L=""" & NewPath & """", 1, True
End If

Set D   = Nothing
Set WSH = Nothing
Set FSO = Nothing
WScript.Quit 0

Полностью проверить не могу - плагин не установлен.

[Flasher]

Tol!k
Спасибо за труд! Вчера посмотрел что получается, всё таки два лишних файла к красоте не отнести , я уже было накидал цикл для списка томов вместо предложенного wmic >>

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

Dim FSO,i,x,s,n,drive
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSHShell = WScript.CreateObject("WScript.Shell")
For each x In FSO.Drives
If x.DriveType<>4 Then
If x.DriveType=1 Or 2 And i<>"A:" And x.FileSystem="NTFS" Then
drive=x.DriveLetter
n=fso.GetDrive(drive)
s = s & n & vbNewLine
End If  
End If
Next

но тут подоспела тяжёлая артиллерия.

Batya
Это самое красивое, что я видел за последние пару недель! Настолько просто и идеально выглядит скрипт, даже Хелпер и буфер не затронулись, круто!

Но пока ругается на 14 строку: Индекс выходит за пределы допустимого диапазона.

Добавлено: Нашёл кое-что странное >>

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

NewPath = "\\\NTFS\ID".....

Я так понимаю, тут D на конце убрать надо?

[Batya]

Flasher
Поправил.

[Flasher]

Batya

ругается на 14 строку: Индекс выходит за пределы допустимого диапазона.

Остаётся в силе.

[Batya]

Flasher
А ты %P%N в параметрах вызова скрипта прописал?
Курсор на чём стоит, когда скрипт вызываешь?

[Flasher]

А ты %P%N в параметрах вызова скрипта прописал?
Курсор на чём стоит, когда скрипт вызываешь?

О, слона-то я и не приметил! Файлы открывать плагин не умеет, поэтому выполнять вход будет с ошибкой. Оставил %P. Теперь вход в тома с NTFS осуществляет грамотно, но несколько медленней, чем, как в моём варианте с cm_EditPath. Можно поставить проверку максимум до 24 томов?
Теперь вот какая задача: посмотри я там, где Tol'k'у отвечал, в цикле поставил ограничения на проверку дисководов(FDD, CD/DVD). Если я открываю твоим скриптом на виртуальных дисках, резаках /(сетевых нет, проверить не могу), то либо ТС падает, либо входит в конструкцию ///NTFS/I. Надо где-то ещё условия добавить. И не помешало бы что-то наподобие этой строки:

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

If FS <> "NTFS" Then MsgBox "Файловая система не поддерживается!", WScript.Quit()

[Batya]

Flasher
Поправил.