Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: Создание каталога соответственно имени внутреннего каталога 
Author Message
Batya



PostPosted: Wed Aug 17, 2011 15:10    Post subject: Reply with quote

DemoZluk
Новый скрипт:
Code:
'=====================================================================
' Создание папки по имени текущего файла с перемещением в неё
' выделенных файлов и папок

' Параметры:
' {файл-список} {файл, по которому формируется имя создаваемой папки}

' Примеры параметров при вызове из TC:
' %L %P%N
' %L %T%N
' %L %P%M
' %L %T%M
'=====================================================================

Option Explicit
Dim FSO, FL, FF, F, NewPath, FullPath, Flag
With WScript
  If .Arguments.Count = 0 Then
    MsgBox "Не заданы параметры!"     , vbOKOnly + vbCritical, "Внимание!"
    .Quit
  End If
  If .Arguments.Count < 2 Then
    MsgBox "Указаны не все параметры!", vbOKOnly + vbCritical, "Внимание!"
    .Quit
  End If
  FL = .Arguments(0)
  FF = .Arguments(1)
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
NewPath = FSO.GetParentFolderName(FF) & "\" & FSO.GetBaseName(FF) & "\"
If Not FSO.FolderExists(NewPath) Then FSO.CreateFolder(NewPath)

With FSO.OpenTextFile(FL, 1)
  Do While Not .AtEndOfStream
    F = Trim(.ReadLine)
    If F <> "" Then
      If FSO.FolderExists(F) Then
        If Right(F, 1) = "\" Then F = Mid(F, 1, Len(F) - 1)
        Flag     = vbYes
        FullPath = NewPath & FSO.GetFileName(F)
        If FSO.FolderExists(FullPath) Then
          Flag = MsgBox("Папка """ & FullPath & """ уже существует! Заменить?", vbYesNoCancel + vbExclamation, "Внимание!")
          If Flag = vbCancel Then Wscript.Quit
          If Flag = vbYes    Then FSO.DeleteFolder(FullPath)
        End If
        If Flag = vbYes Then FSO.MoveFolder F, NewPath
      End If
      If FSO.FileExists(F) Then
        Flag     = vbYes
        FullPath = NewPath & FSO.GetFileName(F)
        If FSO.FileExists(FullPath) Then
          Flag = MsgBox("Файл """ & FullPath & """ уже существует! Заменить?", vbYesNoCancel + vbExclamation, "Внимание!")
          If Flag = vbCancel Then Wscript.Quit
          If Flag = vbYes    Then FSO.DeleteFile(FullPath)
        End If
        If Flag = vbYes Then FSO.MoveFile F, NewPath
      End If
    End If
  Loop
  .Close
End With

Set FSO = Nothing
Wscript.Quit

_________________
Нет, я не сплю. Я просто медленно моргаю.
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group