Total Commander

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

' {создаваемый файл} [{минимальное количество цифр номера}]
'==========================================================

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

Option Explicit
'====== Изменяемые параметры ==============================
Const IsQuestion = True 'Запрос на создание 

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

' {создаваемый файл} [{минимальное количество цифр номера}]
'

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

'============= VBS =============
' Создание файла c BOM для UTF-8
' Параметр: %N
' Условие: Путь запуска — пустой
'===============================
If WSH.Arguments.Count Then Name = WSH.Arguments(0) :_
If InStr(Name, ".") = 0 Then Name = Name & ".txt"
Name = InputBox(String(5, vbCr) & "Введите имя редактируемого файла:", " Создание файла", Name,,_
(CreateObject("htmlfile").parentwindow.self.screen.Height-18240/CreateObject("WScript.Shell")._
RegRead("HKCU\Control Panel\Desktop\WindowMetrics\AppliedDPI"))*7.5)
If Trim(Name) = "" Then WSH.Quit
With New Regexp
  .Pattern = "[\*/?"":|<>]" : If .Test(Name) Then _
  S = Split(": ? * "" \ / | < >") :_
  R = Array(-230,-225,-246,698,-24,-24,-24,706,707) :_
  For i = 0 To 8 : Name = Replace(Name, S(i), ChrW(R(i))) : Next
  .Pattern = "(.+) \((\d+)\)\.\w+$"
  If .Test(Name) Then Set Exec = .Execute(Name)(0) :_
  BN = Exec.SubMatches(0) : c = Exec.SubMatches(1)
End With
With CreateObject("Scripting.FileSystemObject")
  If Len(BN) = 0 Then BN = .GetBaseName(Name) : c = 1
  Ext = .GetExtensionName(Name)
  If Len(Ext) Then Ext = "." & Ext
  While .FileExists(Name) Or .FolderExists(Name)
    c = c + 1 :  Name = BN & " (" & c & ")" & Ext
  Wend
End With
With CreateObject("ADODB.Stream")
  .Charset = "UTF-8" : .Open : .WriteText Empty : .SaveToFile Name, 2 : .Close
End With
With CreateObject("WScript.Shell")
  .Run """%COMMANDER_EXE%"" /A /O /S /L=""" & .CurrentDirectory & "\" & Name & """",, 1
  .SendKeys "{F4}"
End With