Total Commander

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

'============================================================================= 
' Замена в именах выделенных элементов списка в активном каталоге ТС
' с удалением имеющихся элементов с аналогичными присвоенными именами

' Условие: путь запуска - пустой

' Параметры:
' 1) %WL
' 2) "<искомая строка>" (если нет, ввод в окне)
' 3) "<новая строка>" (если нет, ввод в окне - * в качестве пустой строки)
'============================================================================= 
With WScript.Arguments
  C = .Count : If C = 0 Then WScript.Quit
  List = .Item(0)
  If C > 1 Then Find = .Item(1) Else Chek Find, "заменяемый"
  If C > 2 Then Repl = .Item(2) Else Chek Repl, "новый"
End With : Dir = CreateObject("WScript.Shell").CurrentDirectory & "\"
On Error Resume Next
With CreateObject("Scripting.FileSystemObject") 
  For Each F in Split(.GetFile(List).OpenAsTextStream(1, -1).ReadAll, vbNewLine)
    If F <> "" Then
      If .FolderExists(F) Then
        Set FF = .GetFolder(F)
        If Find <> "" And InStr(FF.Name, Find) Then
          NewName = Replace(FF.Name, Find, Repl) : NewF = Dir & NewName
          If .FolderExists(NewF) Then .DeleteFolder NewF
        End If
      ElseIf .FileExists(F) Then
        BN = .GetBaseName(F)
        If Find <> "" And InStr(BN, Find) Then
          Set FF = .GetFile(F)
          NewName = Replace(BN, Find, Repl) & "." & .GetExtensionName(F)
          NewF = Dir & NewName : If .FileExists(NewF) Then .DeleteFile NewF
        End If
      End If : FF.Name = NewName
    End If
  Next : Set FF = Nothing
End With : CreateObject("WScript.Shell").SendKeys "^R"

Sub Chek(Text, Word)
  Text = InputBox(String(5, vbnewline) & "Введите " & Word & " текст:", Space(10) & _
  "Замена имён выделенных файлов и папок", 3) : If Len(Text) = 0 Then WScript.Quit
  If Trim(Text) = "*" Then Text = ""
End Sub

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

'=============================================================================
' Замена в базовых именах файлов структуры активного диска или всех дисков
' с удалением имеющихся файлов с аналогичными присвоенным именами

' Условие: путь запуска - пустой

' Параметры:
' 1) <активный диск / все диски: 1/2>
' 2) "<искомая строка>" (если нет, ввод в окне)
' 3) "<новая строка>" (если нет, ввод в окне - * в качестве пустой строки)

' Автор: Flasher ©
'=============================================================================

With WScript.Arguments
  C = .Count
  If C = 0 Then MsgBox "Не задан первый параметр!", 48 : WScript.Quit : End If
  If C > 1 Then Search = .Item(1) Else Msg Search, "заменяемый"
  Disks = .Item(0) : If C > 2 Then NewStr = .Item(2) Else Msg NewStr, "новый"
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH : Set WSH = CreateObject("WScript.Shell")
If Disks = 1 Then
  Drive = FSO.GetDriveName(WSH.CurrentDirectory) & ""
  ForDrive Drive, Search, NewStr
ElseIf Disks = 2 Then
  For Each D in FSO.Drives : ForDrive D, Search, NewStr : Next
End If : WSH.SendKeys "^R" : WSH.Popup "Файлы переименованы!", 2, "    Результат", 64 
Set WSH = Nothing : Set FSO = Nothing : WScript.Quit

Sub Msg(Text, Word)
  Text = InputBox(String(5, vbnewline) & "Введите " & Word & " текст:", Space(10) & _
  "Замена имён файлов и папок", 3) : If Len(Text) = 0 Then WScript.Quit
  If Trim(Text) = "*" Then Text = ""
End Sub

Sub ForDrive(Drv, Find, Repl)
  DT = FSO.GetDrive(Drv).DriveType : Set DFiles = FSO.GetFolder(Drv).Files
  If DT > 0 And DT < 4 Then
    If DFiles.Count > 0 Then ForFile DFiles, Find, Repl, Drv
    ForFolder Drv, Find, Repl
  End If
End Sub

Sub ForFolder(Fold, Find, Repl)
  Set SubF  = FSO.GetFolder(Fold).SubFolders
  If SubF.Count > 0 Then
    For Each Folder in SubF
      ForFolder Folder, Find, Repl
      Set FF = Folder.Files
      ForFIle FF, Find, Repl, Folder & ""
    Next
  End If
End Sub

Sub ForFile(DFil, Find, Repl, Dir)
  On Error Resume Next
  For Each File in DFil
    BN = FSO.GetBaseName(File)
    If Find <> "" And InStr(BN, Find) Then
      NewName = Replace(BN, Find, Repl) & "." & FSO.GetExtensionName(File)
      NewF = Dir & NewName : If FSO.FileExists(NewF) Then FSO.DeleteFile NewF
      File.Name = NewName
    End If
  Next
End Sub

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

TOTALCMD#BAR#DATA
%COMMANDER_PATH%\Utils\TCFS2\TCFS2.exe
/ef "tcm(2046, 1) tcm(3302, 1) delay(500) tem(`em_MRT_Translit`, 1) delay(500) send(`{ENTER}`, findwnd(`TMultiRename`)) delay(500) send(`{ESC}`, findwnd(`TMultiRename`)) tcm(540, 1)"
wcmicons.dll,70
В выделенном мультипереименовать все файлы пользовательской командой em_MRT_Translit


-1