| View previous topic :: View next topic |
| Author |
Message |
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
 (Separately) Posted: Mon Jul 26, 2010 18:06 Post subject: Кнопка открытия текущего каталога в плагине NTFS4TC |
 |
|
Есть кнопка: | Code: | 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), соответственно, последовательность нарушится. Кто что может подсказать? |
|
| Back to top |
|
 |
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Wed Aug 04, 2010 07:18 Post subject: |
|
|
Поскольку с переменными средами ничего не наклёвывается, приходится искать решение в WSH. | Code: | 'Открыть текущий каталог в плагине 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, присвоенного по счётчику плагином. Ну, предположительный сценарий:
| Code: | If i.FileSystem = "NTFS" & i.DriveLetter = "C" Then ID=0
End If
If i.FileSystem = "NTFS" & i.DriveLetter = "D" Then ID=1
End If
... |
Не знаю, как проверять, какой диск открыт в файловой панели в таком случае. Просьба помочь с реализацией идеи. |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Wed Aug 11, 2010 18:22 Post subject: |
|
|
Сегодня решил продолжить поиск решения. Написал-таки что-то поразумнее, но не знаю как всю эту петрушку (отделено знаками вопроса) зациклить.
Уважаемая просьба откликнуться и написать тем, кому есть что сказать по сему вопросу!
Volniy, Batya, LocKtaR-o-DarK, Tol'k, Lev, sa, будут любые соображения, пишите; если даже решение не проглядывается, просьба пояснить в чём сложность реализации, и есть ли смысл искать способ.
| Code: | 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() |
|
|
| Back to top |
|
|
Tol!k
Joined: 01 Apr 2008
Posts: 1727
Location: Арзамас
|
| (Separately) Posted: Wed Aug 11, 2010 19:39 Post subject: |
|
|
М.б. поможет
Буквы дисков с NTFS | Code: | wmic logicaldisk where (FileSystem="NTFS") get Name /value |
Метки дисков с NTFS | Code: | wmic logicaldisk where (FileSystem="NTFS") get VolumeName /value |
|
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Wed Aug 11, 2010 20:01 Post subject: |
|
|
Tol!k
Я немножко не понял, ты предлагаешь на основании wmic написать батник, а потом привернуть его к скрипту? Пытаясь сходу разобраться в смысле предложенных строк, пока не представляю, как оно может мне помочь в создании цикла для присвоения номера(числового значения) диска с конкретной файловой системой. Проясни, пожалуйста. |
|
| Back to top |
|
|
Tol!k
Joined: 01 Apr 2008
Posts: 1727
Location: Арзамас
|
| (Separately) Posted: Wed Aug 11, 2010 20:16 Post subject: |
|
|
| Я не спец по VBS, но мне кажется разобрать и пронумеровать уже отфильтрованный по типу ФС список проще и красивее, чем то, что ты написал между строками '???????????????????????????? |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Wed Aug 11, 2010 20:36 Post subject: |
|
|
Tol!k
То, что у меня между знаками "?" - это вообще жуть, потому что с каждой новой буквой кол-во условий растёт с геометрической прогрессией.  Только в том то и дело, что я представления не имею, как создать цикл, в которым будет пронумеровываться полученный список доступных NTFS-дисков. |
|
| Back to top |
|
|
Tol!k
Joined: 01 Apr 2008
Posts: 1727
Location: Арзамас
|
| (Separately) Posted: Wed Aug 11, 2010 21:58 Post subject: |
|
|
| Quote: | | как создать цикл, в которым будет пронумеровываться полученный список |
| Code: | wmic logicaldisk where (FileSystem="NTFS") get Name /value >ntfs.txt |
— это обрабатываемый список
| Code: | 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 |
|
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Thu Aug 12, 2010 10:43 Post subject: |
|
|
Flasher
Примерно так:
| Code: | '=====================================================
' Открытие в 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
|
Полностью проверить не могу - плагин не установлен.
_________________
Нет, я не сплю. Я просто медленно моргаю.
Last edited by Batya on Thu Aug 12, 2010 15:36; edited 2 times in total |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Thu Aug 12, 2010 12:19 Post subject: |
|
|
Tol!k
Спасибо за труд! Вчера посмотрел что получается, всё таки два лишних файла к красоте не отнести  , я уже было накидал цикл для списка томов вместо предложенного wmic >> | Code: | 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 строку: Индекс выходит за пределы допустимого диапазона.
Добавлено: Нашёл кое-что странное >> | Batya wrote: | | Code: | NewPath = "\\\NTFS\ID"..... |
|
Я так понимаю, тут D на конце убрать надо? |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Thu Aug 12, 2010 13:01 Post subject: |
|
|
Flasher
Поправил.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Thu Aug 12, 2010 13:09 Post subject: |
|
|
Batya
| Flasher wrote: | | ругается на 14 строку: Индекс выходит за пределы допустимого диапазона. |
Остаётся в силе. |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Thu Aug 12, 2010 13:54 Post subject: |
|
|
Flasher
А ты %P%N в параметрах вызова скрипта прописал?
Курсор на чём стоит, когда скрипт вызываешь?
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Thu Aug 12, 2010 14:21 Post subject: |
|
|
| Batya wrote: | А ты %P%N в параметрах вызова скрипта прописал?
Курсор на чём стоит, когда скрипт вызываешь? |
О, слона-то я и не приметил! Файлы открывать плагин не умеет, поэтому выполнять вход будет с ошибкой. Оставил %P. Теперь вход в тома с NTFS осуществляет грамотно, но несколько медленней, чем, как в моём варианте с cm_EditPath. Можно поставить проверку максимум до 24 томов?
Теперь вот какая задача: посмотри я там, где Tol'k'у отвечал, в цикле поставил ограничения на проверку дисководов(FDD, CD/DVD). Если я открываю твоим скриптом на виртуальных дисках, резаках /(сетевых нет, проверить не могу), то либо ТС падает, либо входит в конструкцию ///NTFS/I. Надо где-то ещё условия добавить. И не помешало бы что-то наподобие этой строки: | Code: | If FS <> "NTFS" Then MsgBox "Файловая система не поддерживается!", WScript.Quit() |
|
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Thu Aug 12, 2010 15:37 Post subject: |
|
|
Flasher
Поправил.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
