Total Commander

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

'•••••••••••••••••••••••••••••••• VBS •••••••••••••••••••••••••••••••••
' Назначение: Смонтировать выбранные образы дисков на виртуальные диски
'             Отсоединить все подключённые программой виртуальные диски
'
' Поддерживаемые форматы:
'  00n, AFD, AFF, AFM, BIN, DD, E01, IMG, ISO, NRG, S01, SDI, VHD, VMDK
'
' Условия:
' 1) В папке программы должны находиться папки OSFMount\ и OSFMount64\,
' в каждой из которых файлы: OSFMount.com, OSFMount.exe, OSFMount.sys.
' 2) Наличие "%COMMANDER_EXE%" в поле "Команда:" после пути к скрипту.
'
' Параметры: 2) <отмонтировать всё/монтировать/переподключить: 0/1/2>
'            3) <свободная буква c начала/конца: 0/1>
'            4) <список путей к образам через пробел>
' Ключи:
' /n       — не сообщать о демонтировании дисков (2-й параметр = 0)
' /r       — переподключать по именному счётчику (2-й параметр = 1)
' /o:<1/2> — открыть подключённые диски в активной/пассивной панели
' /p:%P/%T — только при наличии /o: "%P" при /o:1 или "%T" при /o:2

' Примеры:   0   |   0 /n   |   2 0 %V   |   1 1 %P%S /r /o:2 /p:"%T"
'
Option Explicit
'•••••••••••• Путь к папке с OSFMount относительно корня TC •••••••••••
Const RPath = "Utils\OSFMount"
'••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••

Dim A, C, P, P1, P2, Title, FSO, S1, WSS, SF, DN, OCom, BN, OP, F, S, S2, Dr, M
Set A = WSH.Arguments.UnNamed : C = A.Count : If C = 0 Then Msg(1)
P = "a" : P1 = "й" : If C > 5 Then P = "ов" : P1 = "е" : P2 = "и"
Title = " Монтирование образ" & P & " на виртуальны" & P1 & " диск" & P2 & "     "
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(A(0)) Then Msg(2) Else _
If Left(CreateObject("Shell.Application").NameSpace(0).ParseName(A(0))._
ExtendedProperty("FileDescription"), 15) <> "Total Commander" Then Msg(2)
If A(1) = 1 And C < 4 Then Msg(3)
If A(1) = 0 Then Title = " Отключение годных виртуальных дисков      "
S1 = "е" : Set WSS = CreateObject("WScript.Shell")
If WSS.Environment("System")("PROCESSOR_ARCHITECTURE") <> "x86" Then SF = 64
OP = FSO.BuildPath(FSO.GetParentFolderName(A(0)), RPath) & "\OSFMount" & SF & ""
DN = "OSFMount": OCom = OP & DN & ".com": If C > 2 Then BN = FSO.GetBaseName(A(3))
For Each F in Array(OP & DN & ".exe", OCom, OP & DN & ".sys")
  If Not FSO.FileExists(F) Then S = S & vbCr & F
Next : If InStrRev(S, vbCr) > 1 Then S1 = "ю" : S2 = "ы:"
P = WSH.Arguments.Named("o") : If Not IsEmpty(S) Then Msg(5)

If A(1) = 0 Then
  For Each Dr In FSO.Drives
    If WSS.Run("""" & OCom & """ -l -m " & Dr, 0, 1) = 0 Then _
       WSS.Run """" & OCom & """ -D -m " & Dr, 0, 1
  Next : If Not WSH.Arguments.Named.Exists("n") Then _
  WSS.Popup "Виртуальные диски отключены!", 2, Title
ElseIf A(1) = 1 Then
  Dim Check : If C = 4 And WSH.Arguments.Named.Exists("r") Then Rewire Check
  If IsEmpty(Check) Then
    Dim D, i : D = "DEFGHIJKLMNOPQRSTUVWXYZ"
    For Each Dr In FSO.Drives : D = Replace(D, Dr.DriveLetter, "") : Next
    For i = 3 To C - 1
      If Not IsImage(A(i)) Then
        Msg(4)
      Else
        If A(2) Then Dr = Right(D, 1) Else Dr = Left(D, 1)
        WSS.Run """" & OCom & """ -a -t file -f """ & A(i) & """ -m " & Dr & ":", 0, 1
        Select Case P
          Case Empty If A(2) Then S = Dr & " " & S Else S = S & " " & Dr & ":"
          Case 1 OpenDrive Dr & ":", "L" : Case 2 OpenDrive Dr & ":", "R"
        End Select
        D = Replace(D, Dr, "")
      End If
    Next
    If P = Empty Then
      If C > 4 Then P = "ы"
      WSS.Popup "Выбранны" & P1 & " образ" & P & " смонтирован" &_
      P & " на диск" & P2 & ": " & Trim(S), 2, Title
    End If
  End If
ElseIf A(1) = 2 And C = 4 And IsImage(A(3)) And Not (Len(BN) = 1 And Not IsNumeric(BN)) Then Rewire 1
End If : WSH.Quit

Function IsImage(Name)
  IsImage = Eval(InStr("|00N|AFD|AFF|AFM|BIN|DD|E01|IMG|ISO|NRG|S01|SDI|VHD|VMDK|",_
  "|" & UCase(FSO.GetExtensionName(Name)) & "|") > 0)
End Function

Sub Rewire(Mess)
  Dim Ptrn, RExp, BNm, BNx, Drives, TF, TempFile, NN, Exc1, Exc2, Chk, Sep1, Sep2, Sym1, Sym2
  Set RExp = New RegExp : Ptrn = "([ _.–—\-\t\u2012\u2015\u2212]*)([a-z]|\d+)$"
  RExp.Pattern = Ptrn : BNm = RExp.Replace(BN, "") : RExp.Pattern = "([.^[\]()\-$])"
  RExp.Global  = True : BNx = RExp.Replace(BNm, "\$1") : RExp.Pattern = "^" & BNx & Ptrn
  For Each Dr in FSO.Drives
    If Dr.DriveType > 3 Then Drives = Dr & " " & Drives
  Next
  TF = FSO.GetSpecialFolder(2) & "" & FSO.GetTempName
  For Each Dr in Split(RTrim(Drives))
    WSS.Run "%ComSpec% /u /c cd /d " &OP& "&for /f ""delims="" %# in ('OSFMount.com -l -m " &Dr& "^|findstr " &_
    "/rec:""\" & BNx & ".*\." & FSO.GetExtensionName(A(3)) & """') do echo " & Dr & "^|%#>>""" & TF & """", 0, 1
  Next
  If IsEmpty(Mess) Then If Not FSO.FileExists(TF) Then Exit Sub
  If FSO.GetFile(TF).Size = 0 Then If Mess Then Msg(6) Else Exit Sub
  Set TempFile = FSO.OpenTextFile(TF,,,-1) : Set Exc2 = RExp.Execute(BN)
  If Exc2.Count Then Sep2 = Exc2(0).Submatches(0) : Sym2 = Exc2(0).Submatches(1)
  Do : F = TempFile.Readline
    If F <> "" Then
      If Mid(F, 20) = A(3) Then Mess = 0 : Exit Do
      Dr = Left(F, 2) : NN = FSO.GetBaseName(F) : Set Exc1 = RExp.Execute(NN)
      If Exc1.Count Then Sep1 = Exc1(0).Submatches(0) : Sym1 = Exc1(0).Submatches(1)
      If NN = BN Then Mess = 0 : Exit Sub Else If InStr(NN, BNm) = 1 Then _
      If Not ((Sep1 = "" And Sym1 <> "") And (Sep2 <> "" And Sym2 <> "")) Then _
      If (Sep1 = "" And Len(Sep2) > 0) Or Sep1 = Sep2 Then If Sym1 = "" Or Sym1 <> Sym2 Then _
      If NumOrSym(Sym1, Sym2) Then _
      WSS.Run """" & OCom & """ -D -m " & Dr, 0, 1 : Chk = 1 :_
      WSS.Run """" & OCom & """ -a -t file -f """ & A(3) & """ -m " & Dr, 0, 1 : Exit Do
    End If
  Loop Until TempFile.AtEndOfStream : TempFile.Close : FSO.DeleteFile TF, 1
  If Chk Then Mess = 0 Else If Mess Then Msg(6) Else Exit Sub
  Select Case P
    Case Empty WSS.Popup "Выбранный образ смонтирован на диск " & Dr & " !", 2, Title
    Case 1 OpenDrive Dr, "L" : Case 2 OpenDrive Dr, "R"
  End Select
End Sub

Function NumOrSym(X, Y)
  Dim IN1, IN2, Alp : IN1 = IsNumeric(CStr(X)) : IN2 = IsNumeric(CStr(Y))
  If IN1 And IN2 Then
    If X + 1 <> CInt(Y) Then Exit Function
    WIth New RegExp
      .Pattern = "^0+" :  If .Test(X) Or .Test(Y) Then _
      If Not ((X = "9" Or X = "09") And Y = "10") Then _
      If Len(X) <> Len(Y) Then Exit Function
    End With : NumOrSym = True
  ElseIf Not IN1 And Not IN2 Then
    If Len(X) > 1 Or Len(Y) > 1 Then Exit Function
    If X = "" And Y = "a" Then NumOrSym = True : Exit Function
    Alp = "abcdefghiyklmnopqrstuvwxyz"
    If Mid(Alp, InStr(Alp, X) + 1, 1) = Y Then NumOrSym = True
  ElseIf X = "" And CInt(Y) = "1" Then NumOrSym = True
  End If
End Function

Sub OpenDrive(Drive, Pl)
  Dim T : If StrComp(FSO.GetDriveName(WSH.Arguments.Named("p")), Drive, 1) <> 0 Then T = " /T"
  If FSO.GetDrive(Drive).IsReady Then WSS.Run """" & A(0) & """ /O /S" & T & " /" & Pl & "=" & Drive
End Sub

Sub Msg(D)
  Select Case D
    Case 1 M = "Укажите требуемые параметры!"
    Case 2 M = "Укажите ""%COMMANDER_EXE%"""_
    & " в поле Команда: после пути к скрипту!"
    Case 3 M = "Укажите не менее 4-х параметров!"
    Case 4 M = "Данный тип файла не поддерживается!"
    Case 5 M = "Отсутству" & S1 & "т файл" & S2 & S
    Case 6 M = "Имя файла не подходит для перемонтажа!"
  End Select : MsgBox M, 4144, Title : WScript.Quit
End Sub