Total Commander

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

'=====================================================
' Переход на сменные накопители и переключение между ними
' Авторcтво: по мотивам скрипта Batya
'=====================================================
Option Explicit
Dim FSO, WSH, D, Disk, TCPath, Drive
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Drive   = UCase(FSO.GetDriveName(WSH.CurrentDirectory))
For Each D In FSO.Drives
  If D<>"A:" And D.DriveType=1 And UCase(D.Path)<>Drive Then
      Disk = D.Path & "\"
     Exit For
  End If
  On Error GoTo 0
Next
  TCPath  = WSH.ExpandEnvironmentStrings("%Commander_Path%")_
 & "\totalcmd.exe"
WSH.Run """" & TCPath & """ /S /O /L=""" & Disk & """", 1, True
Set D   = Nothing
Set WSH = Nothing
Set FSO = Nothing
WScript.Quit 0

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

'========================================================
' Последовательное переключение между дисками

' Параметры скрипта:
' [{Тип дисков}]
' Здесь {Тип дисков} может принимать значения:
' 1 - тома сменных накопителей;
' 2 - тома жёстких дисков;
' 3 - сетевые диски;
' 4 - оптические приводы;
' 5 - виртуальные диски.

' Авторcтво: Flasher, Batya
'========================================================
Option Explicit
'================ Изменяемые параметры ==================
Const DefaultDriveType = 1 'Тип дисков по умолчанию
'========================================================
Dim FSO, WSH, D, Drive, Flag, DriveType
Set FSO   = CreateObject("Scripting.FileSystemObject")
Set WSH   = CreateObject("WScript.Shell")
DriveType = DefaultDriveType
If WScript.Arguments.Count > 0 Then _
  DriveType = CInt(WScript.Arguments(0))
Drive = UCase(FSO.GetDriveName(WSH.CurrentDirectory))
Flag  = False
For Each D In FSO.Drives
  If Flag Then
    If CheckDrive Then
      GoToDrive(D.Path & "\")
      Quit
    End If
  Else
    Flag = (UCase(D.Path) = Drive)
  End If
Next
'Если текущий диск последний, начнём сначала
For Each D In FSO.Drives
  If CheckDrive Then
    GoToDrive(D.Path & "\")
    Quit
  End If
Next

'Подходящих по условиям дисков нет. Выходим
Quit

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

Function CheckDrive
  CheckDrive = ((D <> "A:") And D.IsReady And (D.DriveType = DriveType) And (UCase(D.Path) <> Drive))
End Function

Sub GoToDrive(pDrive)
  Dim TCPath
  TCPath = WSH.ExpandEnvironmentStrings("%Commander_Path%")
  WSH.Run """" & TCPath & "\totalcmd.exe"" /S /O /L=" & pDrive, 1, True
End Sub