Total Commander

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

'================================================================
' Универсальное создание файлов
'================================================================
' 1-й параметр: имя файла
' 2-й параметр: расширение файла (если "?" - то без расширения)
' 3-й параметр: путь где создавать файлы
' 4-й параметр: количество создаваемых файлов
' 5-й параметр: диалог ввода имени с расширением
' 6-й параметр: диалог ввода количества создаваемых файлов
' 7-й параметр: формат счётчика:
'         1 - один разряд цифр (Name_1.txt, ... Name_12.txt, ...)
'         2 - два разряда цифр (Name_01.txt, ... Name_12.txt, ...)
'         3 - три разряда цифр (Name_001.txt, .. Name_012.txt, ..)
'================================================================
' "%O" "?" - файл без расширения с именем файла под курсором в C:\
' "%O" "bat" - создаётся файл .bat в C:\ ...
' "%O" "ini" "%t" - создаётся ini-файл в панели назначения
' "%O" "ini" "%t" "4" - создаётся 4 ini-файла в панели назначения
' "%O" "ini" "%t" "4" "1" "1" - создаётся 4 ini-файла в панели
'                  назначения + диалог ввода количества файлов
'                  + диалог ввода имени с расширением
'================================================================
' Script:		UniversalCreateFiles.vbs
' Author:		Аверин Андрей (запрос LonerD; модификация - LonerD)
' Build:		1.05 (2012.09.02)
' E-Mail:		Averin-And@yandex.ru
' OfSite:		http://tc-image.3dn.ru/forum/3-595-2695-16-1343552124
'================================================================
Set FSO = CreateObject("Scripting.FileSystemObject")
Name = "DreamLair" : Ext = ".txt" : Path = "C:\" : Cont = 1 : Num = 1 : lDlm = "_"

With WScript.Arguments
  Cnt = .Count
  If Cnt > 6 Then Cont = .Item(6)
  If Cnt > 5 Then DNum = .Item(5)
  If Cnt > 4 Then DName = .Item(4)
  If Cnt > 3 Then Num = .Item(3)
  If Cnt > 2 Then Path = .Item(2)
  If Cnt > 1 Then Ext = .Item(1)
  If Cnt > 0 Then Name = .Item(0)
End With

If Len(Path) = 0 Then WScript.Quit
If Right(Path, 1) <> "\" Then Path = Path & "\"
Titles = "Files Creating"

If Ext = "?" Then
  Ext = ""
  Else
  If Len(Ext) = 0 Then Ext = ".txt"
  If InStr(Ext, ".") = 0 Then Ext = "." & Ext
End If
  
If Len(DName) = 0 Then
  If Len(Name) = 0 Then Name = "DreamLair"
  NE = Name & Ext
  Else
  If DName = "1" Then
    DName = InputBox("Enter file NAME . EXT", Titles, Name & Ext)
    If Len(DName) = 0 Or IsEmpty(DName) Then WScript.Quit
  End If
  NE = DName
End If

If Len(DNum) <> 0 Then
  If DNum = 1 Then
    DNum = InputBox("Number of creating files", Titles, "1")
    If Len(DNum) = 0 Or IsEmpty(DNum) Then WScript.Quit
  End If
  Num = DNum
End If

File = Path & NE

On Error Resume Next
If Num = 1 Then
  If Not FSO.FileExists(File) Then
    CreateFile(File)
  Else
    CreateFile(NextName(File, Cont))
  End If
Else
  For i = 1 To Num
    CreateFile(NextName(File, Cont))
  Next
End If

Sub CreateFile(pFile)
  On Error Resume Next
  FSO.CreateTextFile(pFile)
End Sub
'CreateObject("WScript.Shell").Exec("%commander_path%\Plugins\exe\TCIMG\TCIMG.exe tcimg=50~~$cm540")
'CreateObject("WScript.Shell").Popup "Created " & Num & " files", 1, Titles, 64

Function NextName(pFilePath, Rank)
  Dim lPath, lName, lExt, li, lNum, lNewPath
  With FSO
    lExt = NameCheck(.GetExtensionName(pFilePath))
    lName = NameCheck(.GetBaseName(pFilePath))
    lPath = .GetParentFolderName(pFilePath)
    pFilePath = lPath  & "\" & lName & "." & lExt
    If Len(lPath) > 0 Then
      If Right(lPath, 1) <> "\" Then lPath = lPath & "\"
    End If
    If Len(lExt) <> 0 Then lExt = "." & lExt
    Do
      li = li + 1
      If li < 10^Rank Then
        lNum = Right(String(Rank, "0") & li, Rank)
      Else
        lNum = li
      End If
      lNewPath = lPath & lName & lDlm & lNum & lExt
    Loop While .FileExists(lNewPath)
  End With
  NextName = lNewPath
End Function

Function NameCheck(AnyName)
  arrStr = Array(vbNewLine, vbCr, VbCrLf, vbFormFeed, vbLf, vbTab, vbVerticalTab, Chr(13), Chr(10), "\","/","*","?","""",">","<")
  For uu = 0 To Ubound(arrStr)
    nm = InStr(AnyName, arrStr(uu))
    If nm > 0 Then AnyName = Left(AnyName, nm - Len(arrStr(uu)))
  Next
  NameCheck = AnyName
End Function