LonerD
|
 Posted: Fri May 01, 2015 17:07 Post subject: |
 |
|
Вот такой ещё скрипт есть.
| Code: | '================================================================
' Универсальное создание файлов
'================================================================
' 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 |
_________________
Windows 11 | TC DreamLair eternal pre-α |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
