Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)
-   -   [решено] Контекстное меню -> Новый текстовый документ. (http://forum.oszone.net/showthread.php?t=219245)

Sta1917 30-10-2011 00:44 1784678
Контекстное меню -> Новый текстовый документ.
 
Здравствуйте. Вот здесь набросок твика реестра для добавления пункта в контекстное меню "Новый txt" можно сделать его без окон командной строки, добавить открытие в блокноте (или асоциированном для txt приложении) и запрос на действие если файл с таким именем уже существует? Спасибо.

OSArev 30-10-2011 02:50 1784739
Ты этого хочеш?
Код:
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 1784892
Не совсем. Можно чтобы файл создавался с определенным именем (Readme, например) И было только второе окно про перезапись,
Цитата:
Цитата OSArev
N=WshShell.Popup("Хотите ли Вы перезаписать существующий файл?"& vbCrLf & vbCrLf & _
"ДА - перезапись существующего файла."& vbCrLf & _
"Нет - переименование старого и создание нового файлов."& vbCrLf & _
"Отмена - выход из программы.", 33,"Создание текстового документа.", 256 + 3 + 64) »
Чтобы переименовывался новый файл, а не старый, и при переименовании прибавлялась единица (как при обычном создании), а не четырех-значное число.

OSArev 31-10-2011 11:41 1785574
Цитата:
Цитата Sta1917
Чтобы переименовывался новый файл, а не старый »
Код:
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 1785758
Цитата:
Цитата OSArev
Как добавлять порядковый номер не знаю, самому интересно... »
Как обычно: начинать перебор с файла без номера, затем со второго до теоретически достижимого, наращивая номер. Как только файла с очередным номером в каталоге не окажется — значит мы нашли искомое свободное имя файла.

OSArev 31-10-2011 20:22 1786008
Доброго времени...
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
Как обычно: начинать перебор с файла без номера, затем со второго до теоретически достижимого »
Это для меня - лес дремучий, вчера голова кипела. Будь добр, как будет свободное время напиши, пожалуйста, пример.Спасибо...

Iska 01-11-2011 01:56 1786192
Цитата:
Цитата OSArev
Это для меня - лес дремучий, вчера голова кипела. Будь добр, как будет свободное время напиши, пожалуйста, пример.Спасибо... »
Кусок макроса для 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 1786411
Iska Спасибо огромное!!! Обалдеть!!! "А, ларчик просто открывался..." Я вчера в такие дебри залез, ух...
Спасибо еще раз!

Sta1917 08-11-2011 23:16 1791255
Цитата:
Цитата OSArev
А, ларчик просто открывался... »
а, можно для чайников все в скирпт собрать?

OSArev 09-11-2011 01:56 1791336
Цитата:
Цитата 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

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 1791542
Спасибо, то что надо.

Sta1917 29-01-2012 15:32 1846883
Можно убрать запрос на перезапись, чтоб было как в Windows, просто добавление номера? Спасибо.

OSArev 29-01-2012 22:24 1847201
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 1848002
OSArev, я совсем далек даже простейшего программирования. Попробовал методом тыка убрать строки, получилось создание только первого файла, вот и обратился к профи.

OSArev 01-02-2012 20:08 1849539
Sta1917, я далеко не профи, сам многому учусь, разбирая скрипты старейшин этого форума. Им огромноё, человеческое спасибо!

denis19 26-12-2023 20:17 3021949
Цитата:
Цитата OSArev
Хотите ли Вы перезаписать существующий файл?"& 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)


Время: 10:06.

Время: 10:06.
© OSzone.net 2001-