Total Commander

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

12_1.jpg
12_2.jpg
aib3.jpg
alenk4.jpg
alenk5.jpg 
 

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

12_mesjatsev
aibolit
alenk_tsvetochek1
alenushka_ivanushka 

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

 
12_1.jpg
12_2.jpg
aib3.jpg   

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

@echo off &chcp 1251 >nul
setlocal enableextensions enabledelayedexpansion
::	http://forum.wincmd.ru/viewpost.php?p=92136
::	Пример параметров: "%L" "%T"

for /f "usebackq delims=" %%f in ("%~1") do (
	set "Name=%%~nf" &title "%%~nxf"
	for /l %%n in (3,1,123) do if exist "%%f" (
		set "Same=!Name:~0,%%n!" &set /a dirs=0
		for /f "delims=[]" %%d in ('dir /b/ad "%~2\!Same!*" 2^>nul ^|find /n /v ""') do set /a dirs=%%d
		if "!dirs!"=="1" for /f "delims=" %%a in ('dir /b/ad "%~2\!Same!*"') do move /y "%%f" "%~2\%%a\"
	)
)
goto :eof

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

'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Перемещение выделенных файлов в папки с тем же началом в имени,
' если под этот критерий подходит только одна папка в получателе

' Параметры:
'  1) %WL
'  2) "<путь назначения>"
'  3) <число первых совпавших символов> (при отсутствии вводим в окне)
'  4) <максимальное число символов> (0 - отключить; при отсутствии - в окне)

' Примеры:
'  1) %WL C:\Тест
'  2) %WL "%T" 3 0
'  3) %WL "%T" "" 6
'  4) %WL "%T" 5 20

' Автор - Flasher ©
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
With WScript.Arguments
  C = .Count : If C = 0 Then WScript.Quit
  On Error Resume Next
  List = .Item(0) : Path = .Item(1)
  If C < 3 Then
    Num = "" : Chek Num, ""
  Else
    Num = .Item(2) : If Len(.Item(2)) = 0 Then Chek Num, ""
  End If
  If C < 4 Then
    Max = "" : Chek Max, "МАКСИМАЛЬНОЕ "
  Else
    Max = .Item(3) : If Max = 0 Then Max = Num
  End If
  On Error Goto 0
  If C < 2 Then : MsgBox "Укажите не менее 2-ух параметров!", 4144, _
  "Рассортировка файлов по папкам" : WScript.Quit : End if
End With : If Right(Path, 1) <> "\" Then Path = Path & "\"

Sub Chek(Count, Word)
  L = vbNewline
  Do Until IsNumeric(Count)
    Count = InputBox(L&L&L&L&L& "Введите " & Word & "число первых" & _
    " символов в именах:", "Рассортировка файлов по папкам", 3)
    If Trim(Count) = "" Then WScript.Quit
  Loop
End Sub

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SbF = FSO.GetFolder(Path).SubFolders
Set NSp = CreateObject("Shell.Application").NameSpace(Path)
For Each F in Split(FSO.GetFile(List).OpenAsTextStream(1, -1).ReadAll, vbNewline)
  If F > vbNullString Then
    If FSO.FileExists(F) Then
      For i = Num to Max
        Start = Left(FSO.GetBaseName(F), i) : Set Items = NSP.Items
        Items.Filter 32, Start & "*"
        If Items.Count = 1 Then
          For Each FF in SbF
            If StrComp(Start, Left(FSO.GetFileName(FF), i), 1) = 0 Then 
              FSO.MoveFile F, FF & "\" : Exit For
            End If
          Next
        End If : Set Items = Nothing
      Next
    End If
  End If
Next : Set FSO = Nothing : Set NSP = Nothing : Set SbF = Nothing : WScript.Quit