Total Commander

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

'============================================================================================
' Создание пустого файла
' В параметрах укажите параметры
' "%P" {расширение} {редактор (в кавычках)}
' Если не указано расширение, файлу будет присвоено расширение .txt.
' Если вы пишете имя создаваемого файла вместе в расширением, второй параметр игнорируется.
' Редактор можно указывать, только если указано расширение.
' Созданный файл сразу открывается в редакторе, указанном в переменной Editor.
'============================================================================================

Dim FSO, WS
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WS = WScript.CreateObject("WScript.Shell")

if WScript.Arguments.Count = 2 then
Ext = "." & WScript.Arguments(1)
else
Ext = ".txt"
end if

if WScript.Arguments.Count = 3 then
Editor = WScript.Arguments(2)
else
Editor = "C:\Windows\Notepad.exe"
end if

FileName = InputBox("Введите имя создаваемого файла" & Ext & ":", "Создание файла", "")

if Len(FileName) = 0 then
MB = MsgBox("Не задано имя файла!", vbOKOnly + vbExclamation, "Создание файла")
WScript.Quit
end if

if Len(FSO.GetExtensionName(FileName)) > 0 then
Ext = ""
end if

FilePath = WScript.Arguments(0) & FileName & Ext

if not FSO.FileExists(FilePath) then
FSO.CreateTextFile(FilePath)
end if

'WS.Run FilePath
WS.Run """" & Editor & """ " & FilePath

Set FSO = Nothing
Set WS = Nothing
WScript.Quit

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

Option Explicit
Dim Dict : Set Dict = CreateObject("Scripting.Dictionary") : Dict.CompareMode = vbTextCompare
Dim Editor, Ext, ShowMemo, DefaultNoname, WinAssociation, OpenNewFile, Divider, DontOpen
'============================================================================================ 
' Имя: Новый файл по SHIFT+F4
' Параметры: ""%P%N""
'
'Использование (ввод в InputBox):
'[имя файла][пробел][?сокращение редактора]
'
'РЕДАКТОРЫ:
'первый параметр - сокращение редактора
'второй параметр - путь к редактору[[пробел]/расширение]
'	здесь расширение создаваемого файла
'	т.е, если в InputBox ввести "filename ?сокращение редактора", то получим
'	файл "filename.расширение
'
'Так же работет явное указание расширения (условие - неравенство имени
'файла/папки под курсором и введенного имени до ?, не зависит от регистра)
'
'Знак вопроса можно заменить на другой разделитель в конфигурации (параметр Divider)
'============================================================================================ 

'=========Конфигурация========
'РЕДАКТОРЫ
Dict.Add "default", ""
'--------
Dict.Add "np", "%SystemRoot%\Notepad.exe"
Dict.Add "em", "%COMMANDER_PATH%\PROGS\OFFICE\emed32 10.0.0\EmEditor.exe"
Dict.Add "++", "%COMMANDER_PATH%\PROGS\OFFICE\notepadpp\notepad+1+.exe"
Dict.Add "ps", "%ProgramFiles%\Adobe\Photoshop CS\Photoshop.exe /psd"
Dict.Add "aud", "%ProgramFiles%\Adobe\Adobe Audition 3.0\Audition.exe /wav"
'Dict.Add
'Dict.Add

'Редактор по умолчанию
Editor = "em"
'Расширение по умочланию
Ext = "txt"
'Показывать памятку
ShowMemo = False
'Имя файла при пустом вводе
DefaultNoname = "Untitled"
'использовать системные ассоциации (не учитывать расширения в Dict)
WinAssociation = False
'Открывать созданный файл
OpenNewFile = True
'Управляющий символ
Divider = "/"
DontOpen = "-" 'если ввести последним, то файл только создается
'================================

Dim FSO, WS, Memo, arg1, FilePath, FileName, Resp, STR

Set FSO = CreateObject("Scripting.FileSystemObject") 
Set WS = WScript.CreateObject("WScript.Shell") 

Dim i, DictKeys : DictKeys = Dict.Keys
If Dict.Count < 2 Then
	WinAssociation = True
Else
	If Dict.Count = 2 Then
		Dict.Item("default") = Trim(Split(Dict.Item(DictKeys(1)),"/")(0))
	ElseIf Dict.Exists(Editor) Then 
		Dict.Item("default") = Trim(Split(Dict.Item(Editor),"/")(0))
	End If
	Editor = Dict.Item("default")
End If

If ShowMemo Then
	AssembleMemo()
Else
	If Dict.Count > 1 Then Memo = vbCrLf & "для справки введите " & Divider & "memo" & vbCrLf
End If

'определяем путь и имя без расширения от файла/папки под курсором
If WScript.Arguments.Count = 1 Then
	arg1 = WScript.Arguments(0)
Else
	MsgBox "Неверно количество аргументов", vbExclamation, "Создание файла"
	Quit
End If

If Right(arg1,1) = "\" Then
	FileName = ""
	FilePath = arg1
Else
	FileName = FSO.GetBaseName(arg1)
	FilePath = FSO.GetParentFolderName(arg1)
	If Not Right(FilePath, 1) = "\" Then FilePath = FilePath & "\"
End If

'ввод пользователя (если используется разделитель(напрмер ?) и указано несуществующее
'сокращение редактора то цикл
STR = FileName
Dim str1, str2, editor1, str3, str4
str3 = "системная ассоциация"
arg1 = True 'как флаг
Do Until UserInput(STR) : : Loop
If OpenNewFile Then
	On Error Resume Next
	If WinAssociation Then
		WS.Run Chr(34) & Resp & Chr(34)
		If err Then	MsgBox "Нет программы" & vbCrLf & _
		"ассоциированной с расширением:" & vbCrLf & _
		str2, vbExclamation, "Cоздание файла"
	ElseIf FSO.FileExists(WS.ExpandEnvironmentStrings(Editor)) Then
		WS.Run Chr(34) & Editor & Chr(34) & " " & Chr(34) & Resp & Chr(34)
		If err Then	MsgBox "Неизвестная ошибка" , vbExclamation, "Cоздание файла"
	Else
		MsgBox "Не найден редактор:" & vbCrLf & _
		Editor, _
		vbExclamation, _
		"Создание файла"
	End If
	On Error Goto 0
End If
Quit

Sub AssembleMemo
	''собираем памятку-таблицу для InputBox (сокращение	exe'шник редактора) 
	If Dict.Count > 1 Then
		For i = 1 To Dict.Count -1 
			Memo = Memo & DictKeys(i) & Chr(9) & FSO.GetBaseName(Dict.Item(DictKeys(i))) & vbCrLf
		Next
		Memo = vbCrLf & "(filename.ext " & Divider & "alias)" & vbCrLf & Memo
	End If
End Sub

Function UserInput(Byref def_)
	UserInput = False
	If Not WinAssociation AND Dict.Count > 1 Then str3 = FSO.GetBaseName(Dict.Item("default"))
	Resp = InputBox(	"Введите имя создаваемого файла ." & Ext & ":" & vbCrlf & _
						"редактор: " & str3 & vbCrlf & _
						Memo, _
						"Создание файла", _
						def_)
	If IsEmpty(Resp) Then Quit
	
	If LCase(Resp) = Divider & "memo" Then
		Memo = ""
		AssembleMemo()
		WinAssociation = False
		Exit Function
	End If
	If Right(Resp, 1) = DontOpen Then
		OpenNewFile = False
		Resp = Left(Resp,Len(Resp)-1)
	End If
	If InStr(Resp, Divider) Then
			Dim resp1
			str1 = Split(Resp, Divider, 2)
			resp1 = Trim(str1(0))
			If (Dict.Count > 1) Then
				WinAssociation = False
				editor1 = Trim(str1(1))
				If Dict.Exists(editor1) Then 
					str2 = Dict.Item(editor1)
					If InStr(str2, Divider) Then
						str1 = Split(str2, "/", 2)
						Editor = Trim(str1(0))
						Ext = LCase(str1(1))
					Else
						Editor = str2
					End If
					arg1 = False
				Else
					STR = Resp
					Exit Function
				End If
			Else
				Exit Function
			End If
			Resp = resp1
	End If
	
	If Len(Resp) = 0 Then
		'FilePath = WS.SpecialFolders("MyDocuments") & "\"
		FileName = DefaultNoname
	ElseIf Resp = FileName Then
		'do nothing
	Else
		If Not LCase(Resp) = LCase(FileName) Then
			str2 = FSO.GetExtensionName(Resp)
			If Not Len(str2) = 0 Then 
				Ext = ""
				If (Not WinAssociation) AND arg1 AND (Dict.Count > 1) Then
					Dim i, DictKeys
					DictKeys = Dict.Keys
					For i = 1 To Dict.Count -1 
						editor1 = Dict.Item(DictKeys(i))
						If InStr(editor1, Divider) Then
							str1 = Split(editor1, "/", 2)
							If LCase(str2) = Trim(LCase(str1(1))) Then
								Editor = Trim(str1(0))
								Exit For
							End If
						End If	
					Next
				End If
			End If
		End If
		FileName = Resp
	End If
	If Not Len(Ext) = 0 Then Ext = "." & Ext
	str4 = Resp
	Resp = FilePath & FileName & Ext
	If Not FSO.FileExists(Resp) Then 
		On Error Resume Next
			FSO.CreateTextFile(Resp) 
			If err Then	
				MsgBox "Ошибка создания файла", _
				vbExclamation, _
				"Cоздание файла"
				UserInput = False
				STR = str4
				Exit Function
			End If
		On Error Goto 0
	End If
	UserInput = True
End Function

Sub Quit
	Set FSO = Nothing 
	Set WS = Nothing 
	Set Dict = Nothing
	WScript.Quit
End Sub