[решено] Контекстное меню -> Новый текстовый документ. [Версия для КПК]

Показать полную графическую версию : [решено] Контекстное меню -> Новый текстовый документ.

Sta1917

30-10-2011, 00:44

Здравствуйте. Вот здесь (http://forum.oszone.net/post-1784063-120.html) набросок твика реестра для добавления пункта в контекстное меню "Новый txt" можно сделать его без окон командной строки, добавить открытие в блокноте (или асоциированном для txt приложении) и запрос на действие если файл с таким именем уже существует? Спасибо.

OSArev

30-10-2011, 02:50

Ты этого хочеш? Call CreateFile
Function CreateFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
sFile = inputbox("Введите название:","Создание текстового документа.",,000,000)
If Len(sFile) = 0 Then
sFile = WScript.Quit
End If

Set objRegExp = new regexp
objRegExp.Pattern = "[\*\\\/\?\<\>\:\""\|]"
If objRegExp.Test(sFile) Then
R = MsgBox("ОШИБКА!!! " & vbCrLf & _
"Введены недопустимые символы в имени файла." & vbCrLf & _
"Попробуйте снова", 64+5 , "Создание текстового документа.")
Select Case R
Case vbRetry
Call CreateFile
Case vbCancel
WScript.Quit
End Select
Else
'Путь для создания
'Определяем,где находимся(только для контекстного меню)
If WScript.Arguments.Count = 1 Then
PathName = WScript.Arguments.Item(0)
End if
'Создание
If FSO.FileExists(PathName & "\" & sFile & ".txt") Then
B=WshShell.Popup("Документ "&Chr(34)& PathName & "\" & sFile & ".txt"&Chr(34)&" - уже существует."& vbCrLf & _
"Выберие,рекомендуемое действие!"& vbCrLf & vbCrLf & _
"Отмена - выход из программы."& vbCrLf & _
"Повторить - вернуться к выбору имени."& vbCrLf & _
"Продолжить - продолжение программы.", 33,"Создание текстового документа.", 512 + 6 + 64)
Select Case B
Case -1
WshShell.Popup "Время ожидания истекло."& vbCrLf & _
"Нажмите ОK для выхода из программы." ,,"Создание текстового документа.",64
Case 2
Wscript.Quit
Case 10
Call CreateFile
Case 11
N=WshShell.Popup("Хотите ли Вы перезаписать существующий файл?"& vbCrLf & vbCrLf & _
"ДА - перезапись существующего файла."& vbCrLf & _
"Нет - переименование старого и создание нового файлов."& vbCrLf & _
"Отмена - выход из программы.", 33,"Создание текстового документа.", 256 + 3 + 64)
Select Case N
Case -1
WshShell.Popup "Время ожидания истекло."& vbCrLf & _
"Нажмите ОK для выхода из программы." ,,"Создание текстового документа.",64
Case 6
FSO.DeleteFile PathName & "\" & sFile & ".txt"
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
Case 7
Ren=Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
InFile =PathName & "\" & sFile & ".txt"
OutFile=PathName & "\" & sFile & "_" & Ren & ".txt"
FSO.MoveFile InFile, OutFile
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
Case 2
Wscript.Quit
End Select
End Select
Else
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
End if
End if
End Function
Скрипт только для контекстного меню. Впридачу REG-файл:Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Directory\Background\shell\Создать документ TXT]
"icon"="shell32.dll,-152"

[HKEY_CLASSES_ROOT\Directory\Background\shell\Создать документ TXT\command]
@="WScript C:\\Windows\\ТВОЯ\\ПАПКА\\ИМЯ_ФАЙЛА.vbs \"%V\""

Sta1917

30-10-2011, 13:42

Не совсем. Можно чтобы файл создавался с определенным именем (Readme, например) И было только второе окно про перезапись,N=WshShell.Popup("Хотите ли Вы перезаписать существующий файл?"& vbCrLf & vbCrLf & _
"ДА - перезапись существующего файла."& vbCrLf & _
"Нет - переименование старого и создание нового файлов."& vbCrLf & _
"Отмена - выход из программы.", 33,"Создание текстового документа.", 256 + 3 + 64) »
Чтобы переименовывался новый файл, а не старый, и при переименовании прибавлялась единица (как при обычном создании), а не четырех-значное число.

OSArev

31-10-2011, 11:41

Чтобы переименовывался новый файл, а не старый »
Call CreateFile

Function CreateFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
sFile = "Readme"

If WScript.Arguments.Count = 1 Then
PathName = WScript.Arguments.Item(0)
End if

If FSO.FileExists(PathName & "\" & sFile & ".txt") Then

N=WshShell.Popup("Документ "&Chr(34)& PathName & "\" & sFile & ".txt"&Chr(34)&" - уже существует."& vbCrLf & _
"Хотите ли Вы перезаписать существующий файл?"& vbCrLf & vbCrLf & _
"ДА - перезапись существующего файла."& vbCrLf & _
"Нет - к имени нового файла будет добавлено числовле значение."& vbCrLf & _
"Отмена - выход из программы.", 33,"Создание текстового документа.", 256 + 3 + 64)
Select Case N
Case -1
WshShell.Popup "Время ожидания истекло."& vbCrLf & _
"Нажмите ОK для выхода из программы." ,,"Создание текстового документа.",64
Case 6
FSO.DeleteFile PathName & "\" & sFile & ".txt"
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
Case 7
Ren=Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
fso.CreateTextFile(PathName & "\" & sFile & "_" & Ren & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & "_" & Ren & ".txt")
Case 2
Wscript.Quit
End Select
Else
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
End if
End Function

Как добавлять порядковый номер не знаю, самому интересно...

Iska

31-10-2011, 15:31

Как добавлять порядковый номер не знаю, самому интересно... »
Как обычно: начинать перебор с файла без номера, затем со второго до теоретически достижимого, наращивая номер. Как только файла с очередным номером в каталоге не окажется — значит мы нашли искомое свободное имя файла.

OSArev

31-10-2011, 20:22

Доброго времени...
Iska, нашёл скрипт SendMessagehttp://forum.oszone.net/post-1718295-2.html, через текстовый документ. Убрав проверку даты получил:Call CreateFile

Function CreateFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")

sFile = "Readme"

If WScript.Arguments.Count = 1 Then
PathName = WScript.Arguments.Item(0)
End if

If FSO.FileExists(PathName & "\" & sFile & ".txt") Then

N=WshShell.Popup("Документ "&Chr(34)& PathName & "\" & sFile & ".txt"&Chr(34)&" - уже существует."& vbCrLf & _
"Хотите ли Вы перезаписать существующий файл?"& vbCrLf & vbCrLf & _
"ДА - перезапись существующего файла."& vbCrLf & _
"Нет - к имени нового файла будет добавлено числовле значение."& vbCrLf & _
"Отмена - выход из программы.", 33,"Создание текстового документа.", 256 + 3 + 64)
Select Case N
Case -1
WshShell.Popup "Время ожидания истекло."& vbCrLf & _
"Нажмите ОK для выхода из программы." ,,"Создание текстового документа.",64
Case 6
FSO.DeleteFile PathName & "\" & sFile & ".txt"
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
Case 7
CheckFile = "d:\check.txt"
Newfile = PathName & "\" & sFile & "_" & SetNumberFile(CheckFile) & ".txt"
fso.CreateTextFile(Newfile)
WshShell.Run("%windir%\notepad " & Newfile)
Case 2
Wscript.Quit
End Select
Else
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
End if
End Function

Function SetNumberFile(f)
Dim arrCheck
Dim CountArchk
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(f) Then
arrCheck = Split(objFSO.OpenTextFile(f).ReadLine, "#", 2)
CountArch = arrCheck(1) + 1
End If
If Not objFSO.FileExists(f) Then CountArch = 1
objFSO.OpenTextFile(f, 2, True).Write "#" & CountArch
SetNumberArchive = CountArch
End FunctionВсё работает, но хотелось бы узнать, как это сделать без помощи текстовика.Как обычно: начинать перебор с файла без номера, затем со второго до теоретически достижимого »Это для меня - лес дремучий, вчера голова кипела. Будь добр, как будет свободное время напиши, пожалуйста, пример.Спасибо...

Iska

01-11-2011, 01:56

Это для меня - лес дремучий, вчера голова кипела. Будь добр, как будет свободное время напиши, пожалуйста, пример.Спасибо... »
Кусок макроса для Far Manager устроит?
%i = 1;

$While (1)
%sFolderName = "000" + string(%i);
%sFolderName = substr(%sFolderName, len(%sFolderName) - 3, 3);

$If (!fexist(APanel.Path + "\\" + %sFolderName))
F7 CtrlY
print(%sFolderName)
CtrlK Enter
Enter

$Exit
$End

%i = %i + 1;
$End
Шучу.

Прототип кода может выглядеть примерно так:
Option Explicit

Dim strPath
Dim i
Dim strName

strPath = "c:\Temp"

With WScript.CreateObject("Scripting.FileSystemObject")

i = 0

Do
i = i + 1

If i = 1 Then ' По аналогии с Windows
strName = "Текстовый документ.txt"
Else
strName = "Текстовый документ" & " (" & CStr(i) & ").txt"
End If

If Not .FileExists(.BuildPath(strPath, strName)) Then
WScript.Echo strName

' Здесь создаём текстовый файл с именем «strName»

Exit Do
End If
Loop
End With

WScript.Quit 0
Либо вовсе вынести определение имени в функцию:
Option Explicit

WScript.Echo GetNextName("c:\Temp", "Текстовый документ.txt")

' Здесь создаём текстовый файл с возвращённым функцией именем

WScript.Quit 0

Function GetNextName(strPath, strTemplateName)
Dim i
Dim strName
Dim strBaseName
Dim strExtension

With WScript.CreateObject("Scripting.FileSystemObject")
If .FolderExists(strPath) Then
strBaseName = .GetBaseName(strTemplateName)
strExtension = .GetExtensionName(strTemplateName)

i = 0

Do
i = i + 1

If i = 1 Then
strName = .BuildPath(strPath, strBaseName & "." & strExtension)
Else
strName = .BuildPath(strPath, strBaseName & " (" & CStr(i) & ")." & strExtension)
End If

If Not .FileExists(strName) Then
Exit Do
End If
Loop
Else
WScript.Echo "Folder [" & strPath & "] not found"

Err.Raise 76
End If
End With

GetNextName = strName
End Function

OSArev

01-11-2011, 13:09

Iska Спасибо огромное!!! Обалдеть!!! "А, ларчик просто открывался..." Я вчера в такие дебри залез, ух...
Спасибо еще раз!

Sta1917

08-11-2011, 23:16

А, ларчик просто открывался... » а, можно для чайников все в скирпт собрать?

OSArev

09-11-2011, 01:56

все в скирпт собрать? »Option Explicit

Call CreateFile

WScript.Quit 0

Function CreateFile
Dim FSO, WshShell, sFile, PathName, i, strName, N

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

sFile = "Readme"

'Определяем,где находимся(только для контекстного меню)
If WScript.Arguments.Count = 1 Then
PathName = WScript.Arguments.Item(0)
End if

'Создание
If FSO.FileExists(PathName & "\" & sFile & ".txt") Then

N=WshShell.Popup("Документ "&Chr(34)& PathName & "\" & sFile & ".txt"&Chr(34)&" - уже существует."& vbCrLf & _
"Хотите ли Вы перезаписать существующий файл?"& vbCrLf & vbCrLf & _
"ДА - перезапись существующего файла."& vbCrLf & _
"Нет - к имени нового файла будет добавлен последующий порядковый номер."& vbCrLf & _
"Отмена - выход из программы.", 33,"Создание текстового документа.", 256 + 3 + 64)
Select Case N
Case -1
WshShell.Popup "Время ожидания истекло."& vbCrLf & _
"Нажмите ОK для выхода из программы." ,,"Создание текстового документа.",64
Case 6
'Для кн."ДА"
FSO.DeleteFile PathName & "\" & sFile & ".txt"
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
Case 7
'Для кн."НЕТ"
With FSO
i = 0
Do
i = i + 1
If i <> 0 Then strName = sFile & " _" & CStr(i) & ".txt"
If Not .FileExists(.BuildPath(PathName, strName)) Then
fso.CreateTextFile(PathName & "\" & strName)
Exit Do
End If
Loop
End With
WshShell.Run("%windir%\notepad " & PathName & "\" & strName)
Case 2
Wscript.Quit
End Select

Else
'Если ещё нет файла с ук.названием
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
End if
End Function

Sta1917

09-11-2011, 12:50

Спасибо, то что надо.

Sta1917

29-01-2012, 15:32

Можно убрать запрос на перезапись, чтоб было как в Windows, просто добавление номера? Спасибо.

OSArev

29-01-2012, 22:24

Sta1917, послушайте, в предыдущем примере всё расписано. Неужели так трудно, подумав удалить ненужные строки?

Option Explicit

Call CreateFile

WScript.Quit 0

Function CreateFile
Dim FSO, WshShell, sFile, PathName, i, strName, N

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

sFile = "Readme"

'Определяем,где находимся(только для контекстного меню)
If WScript.Arguments.Count = 1 Then
PathName = WScript.Arguments.Item(0)
End if

'Создание
If FSO.FileExists(PathName & "\" & sFile & ".txt") Then

With FSO
i = 0
Do
i = i + 1
If i <> 0 Then strName = sFile & " _" & CStr(i) & ".txt"
If Not .FileExists(.BuildPath(PathName, strName)) Then
fso.CreateTextFile(PathName & "\" & strName)
Exit Do
End If
Loop
End With
WshShell.Run("%windir%\notepad " & PathName & "\" & strName)

Else
'Если ещё нет файла с ук.названием
fso.CreateTextFile(PathName & "\" & sFile & ".txt")
WshShell.Run("%windir%\notepad " & PathName & "\" & sFile & ".txt")
End if
End Function

Sta1917

31-01-2012, 00:11

OSArev, я совсем далек даже простейшего программирования. Попробовал методом тыка убрать строки, получилось создание только первого файла, вот и обратился к профи.

OSArev

01-02-2012, 20:08

Sta1917, я далеко не профи, сам многому учусь, разбирая скрипты старейшин этого форума. Им огромноё, человеческое спасибо!

denis19

26-12-2023, 20:17

Хотите ли Вы перезаписать существующий файл?"& vbCrLf & vbCrLf & _
"ДА - перезапись существующего файла."& vbCrLf & _
"Нет - к имени нового файла будет добавлено числовле значение. »
Скрипты почти то что искал, чтоб окошечко с предложением замены, либо нового. Но можно ли в него добавить функцию, чтоб при создании добавлялся текст, который в буфере обмена? Вот тот мой скрипт с добавлением, с ним бы объединить ваш.
Dim FSO, MyFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
clipboard = CreateObject("HTMLFile").parentWindow.clipboardData.getData("text")
Randomize()
FileName=Inputbox("Введите имя:","FolderCreator","Введите имя")

'Проверка на существование файла и создание.
'Добавил открытие файла
If FSO.FileExists(FileName & ".txt") Then
WScript.Echo "Документ ''"& FileName & ".txt" & "'' - уже существует."
WshShell.Run("Explorer" &" " & FileName & ".txt")
WScript.Quit 0
Else
End If
set oFile = CreateObject("Scripting.FileSystemObject").OpenTextFile("" & FileName & ".txt", 2, True)
ofile.WriteLine(clipboard)