Total Commander Knowledge Base

Есть вопрос?

Поищите ответ в самой большой русскоязычной базе знаний по Total Commander!

Создание файла с содержимым буфера обмена

vbs-скрипт, использующий Script Helper

Q: Нужно, чтобы при нажатии Ctrl+V в активной панели, в том случае, если в буфере обмена содержится текст, создавать файл с именем descript.ion и содержимым буфера обмена. Опционально можно выдавать запрос.
A: Вот VBS-скрипт, использующий Script Helper:
'=======================================================
' Создание текстового файла с содержимым буфера обмена
'=======================================================
 
Option Explicit
Dim FileName
'========== Изменяемые параметры =======================
FileName = "descript.txt" 'Имя создаваемого файла
'=======================================================
Dim TCS, Clip, Btn, FSO, OTL, Mess, Title
Set TCS = CreateObject("TCScript.Helper")
Clip = TCS.GetTextFromClip
Set TCS = Nothing

If Len(Clip) > 0 Then
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Mess = "Буфер обмена содержит текст." & vbNewLine & _
"Заменить содержимое файла " & FileName & _
" текстом из буфера обмена?" & vbNewLine
Title = "Замена содержимого файла"
Else
Mess = "Буфер обмена содержит текст." & vbNewLine & _
"Создать файл " & FileName & _
" с содержимым буфера обмена?" & vbNewLine
Title = "Создание текстового файла"
End If
Btn = MsgBox(Mess, vbYesNo + vbQuestion, Title)
If Btn = 7 Then 'Кнопка No
Set FSO = Nothing
WScript.Quit
End If
Else
WScript.Quit
End If
 
Set OTL = FSO.OpenTextFile(FileName, 2, True)
OTL.Write Clip
OTL.Close
 
Set OTL = Nothing
Set FSO = Nothing
WScript.Quit

Batya

A: На форуме поступало несколько похожих запросов. Объединяю решения здесь:

Создание файла с циклической проверкой его существования

'====================================================================================== 
' Назначение: cоздание в активной панели файла с текстом из буфера обмена (при наличии) 
' Условие:    пустой путь запуска 
'====================================================================================== 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Dim WSH : Set WSH = CreateObject("WScript.Shell") 
R = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407" 
On Error Resume Next
A = WSH.RegRead(R) : If A > 0 Or Err.Number <> 0 Then WSH.RegWrite R, 0, "REG_DWORD"
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
If A > 0 Then WSH.RegWrite R, A, "REG_DWORD"
On Error Goto 0
If IsNull(Clip) Or Trim(Clip) = "" Then Quit 
NL = vbNewLine : Box Name, NL, File 
If Trim(Name) <> "" Then 
  Do While FSO.FileExists(File) 
    Msg = MsgBox("Такой файл уже существует!" & NL & "Повторите попытку!",_ 
    49, "    Создание файла с текстом из буфера обмена") 
    If Msg = 2 Then Quit 
    Box Name, NL, File : If Trim(Name) = "" Then Quit 
  Loop : FSO.OpenTextFile(File, 2, True).Write Clip 
End If : Quit 
Sub Box(N, L, F) 
  N = InputBox(L&L&L&L&L&"Введите имя файла:", "        Создание " &_ 
  "файла с текстом из буфера обмена", "NewFile.txt") 
  F = WSH.CurrentDirectory & "\" & N 
End Sub 
Sub Quit : Set WSH = Nothing : Set FSO = Nothing : WScript.Quit : End Sub

Создание txt-файла в кодировке UTF-8 без ВОМ с опцией октрытия или перехода в панели

'======================================================================================== 
' Назначение: создание в активной панели файла (UTF-8 без ВОМ) с текстом из буфера обмена
' с последующим к нему переходом или открытием в редакторе
' Условие:    пустой путь запуска
' Параметр:   "<Путь к редактору>"  (необязательный)
'========================================================================================
T = Replace(Time, ":", ".") : If InStr(T, ".") = 2 Then T = 0 & T
Name = Year(Date) & "." & Left(Date, 5) & "_" & T & ".txt"
R = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
With CreateObject("WScript.Shell")
  On Error Resume Next
  A = .RegRead(R) : If A > 0 Or Err.Number <> 0 Then .RegWrite R, 0, "REG_DWORD"
  Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
  If A > 0 Then .RegWrite R, A, "REG_DWORD"
  On Error Goto 0
  If IsNull(Clip) Or Trim(Clip) = "" Then WScript.Quit
  Path = .CurrentDirectory & "\" & Name
  With CreateObject("ADODB.Stream")
    .Open : .CharSet = "UTF-8" : .WriteText Clip
    .Position = 0 : .Type = 1 : .Position = 3 : Buff = .Read
    .Close : .Open : .Write Buff : .SaveToFile Path, 2 : .Close
  End With
  If WScript.Arguments.Count Then .Exec WScript.Arguments(0) & " """ & Path & """" Else _
  .Exec "%COMMANDER_EXE% /A /S /O /L=""" & Path & """"
End With

Flasher
12.11.2014

Оптимизированный скрипт создания папки или файла с именем строки буфера по заданному номеру

'=====================================================================================
' Cоздание папки/файла c именем заданной строки из буфера c возможностью записи в файл

' Условие: путь запуска в кнопке/пользовательской команде - пустой

' Возможные параметры:
'  1) <не/переходить к элементу: 0/1>
'  2) <номер строки> (при отсутствии вводится в диалоге)
'  3) <не/удалять в имени концевые символы, отличные от цифр и лат./кирил. букв: 0/1>
'  4) <расширение файла> (при отсутствии создаётся папка)
'  5) <записывать в файл: 1>

' Примеры: <пусто>  |  1  |  1 5  |  0 "" 1  |  1 "" 0 lst  |  1 1 1 txt 1

' Автор: Flasher ©
'=====================================================================================

With WScript.Arguments
  C = .Count : If C > 0 Then Jump = .Item(0)
  If C > 1 Then Num = .Item(1)
  If Num = "" Then Max = 0 : Call Nums(Num, "")
  If C > 2 Then Del = .Item(2)
  FType = "файла" : If C > 3 Then Ext = .Item(3)
  If Ext = "" Then FType = "папки"
  Title = "Создание " & FType & " из буфера обмена"
  If C > 4 And Ext <> "" Then Write = .Item(4)
End With : On Error Resume Next
P = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
With CreateObject("WScript.Shell")
  A = .RegRead(P) : CD = .CurrentDirectory & "\"
  If A > 0 Or Err.Number <> 0 Then .RegWrite P, 0, "REG_DWORD"
  C = Trim(CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text"))
  If A > 0 Then .RegWrite P, A, "REG_DWORD"
End With : On Error Goto 0

If C <> "" Then
  Set FSO = CreateObject("Scripting.FileSystemObject")
  If InStr(C, vbLf) > 0 Then
    Arr = Split(C, vbNewLine) : Max = Ubound(Arr) + 1
    BN = Trim(Arr(Nums(Num, Arr) - 1))
  Else BN = C
  End If : S = Split(""" | : ; \ / < > ? *") : R = Split("''|-| -|,|_|_|-|-| | ","|")
  If Del = 1 Then
    With New RegExp
      .IgnoreCase = True : .Global = True
      .Pattern = "^[^А-я\w]*|[^А-я\w]*$" : BN = .Replace(BN, "")
    End With
  Else : LB = Left(BN, 1)
    If Ubound(Filter(S, LB)) >= 0 Or Ubound(Filter(R, LB)) >= 0 Then BN = LTrim(Mid(BN, 2))
  End If : For i = 0 To 9 : BN = Replace(Trim(BN), S(i), R(i)) : Next
  If BN = "" Then BN = "NewFolder" : If Len(Ext) Then BN = "NewFile"
  B = BN : Const M = 1
  If Ext = "" Then
    Name = FName(B, "") : FSO.CreateFolder(Name)
  Else
    Name = FName(B & "." & Ext, "." & Ext)
    If Write = 1 Then FSO.CreateTextFile(CD & Name,,True).Write C Else _
    FSO.CreateTextFile CD & FName(Name, "." & Ext),,True
  End If
  With CreateObject("WScript.Shell")
    If Jump = 1 Then .Exec """%COMMANDER_EXE%"" /A /O /S /L=""" & CD & Name & """" Else .SendKeys "^r"
  End With
End If

Function Nums(N, Ar)
  Do
    ErrType = "!" : NL = vbLf : LN = "" : If Max = 0 Or C1 = 2 Then _
    N = Trim(InPutBox(Errors & String(5 - C1 - C2, vbLf) &_
    "Введите номер строки с именем " & FType & ":", Space(20) & Title, 1))
    C2 = 0 : If N = "" Then WScript.Quit
    If IsNumeric(N) Then
      If Max = 0 And CLng(N) > 0 Then Exit Do
      If Max >= CLng(N) Then
        If CLng(N) > 0 Then
          If Replace(Trim(Ar(N - 1)), Tab, "") = "" Then ErrType = ": пустая строка." &_
          vbCr & Space(6) : C2 = 1 Else Exit Do
        End If
      Else ErrType = ": строки № " & N & vbLf & Space(41) & "не существует!" &_
           NL & NL & Space(6) : C2 = 2 : NL = "" : LN = vbLf
      End If
    End If : C1 = 2 : Errors = NL & NL & "        Ошибка ввода" & ErrType & "  Повторите попытку." & LN
  Loop : Nums = N
End Function

Function FName(Nm, Ex)
  Do While FSO.FolderExists(CD & Nm) Or FSO.FileExists(CD & Nm)
    l = l + 1 : If l < 10^M Then PFx = Right(String(M, "0") & l, M) Else PFx = l
    Nm = BN & " (" & PFx & ")" & Ex
  Loop : FName = Nm
End Function

Flasher
29.08.2015

Кнопочные решения

A: С использование утилиты Nircmd (следует указать верный путь запуска):
Код кнопки
TOTALCMD#BAR#DATA:
nircmd execmd nircmd clipboard writefile
"%P%%date:~6%%.%%date:~3,2%%.%%date:~0,2%%_%%time:~0,2%%.%%time:~3,2%%.%%time:~6,2%%.txt" && "%%COMMANDER_EXE%%" /S /O /L="%P%%date:~6%%.%%date:~3,2%%.%%date:~0,2%%_%%time:~0,2%%.%%time:~3,2%%.%%time:~6,2%%.txt\:"
wcmicons.dll,45
Создать файл %ДАТА_ВРЕМЯ%.txt с текстом из Б/О и перейти к нему
%COMMANDER_PATH%\Utils\nircmd\

-1

Код кнопки
TOTALCMD#BAR#DATA:
nircmd execmd nircmd clipboard writefile
"%P%%date:~6%%.%%date:~3,2%%.%%date:~0,2%%_%%time:~0,2%%.%%time:~3,2%%.%%time:~6,2%%.txt" && start notepad "%P%%date:~6%%.%%date:~3,2%%.%%date:~0,2%%_%%time:~0,2%%.%%time:~3,2%%.%%time:~6,2%%.txt"
wcmicons.dll,45
Создать файл %ДАТА_ВРЕМЯ%.txt с текстом из Б/О и открыть его в Notepad
%COMMANDER_PATH%\Utils\nircmd\

-1

A: С использованием Akelpad (следует указать верный путь к редактору):
Код кнопки
TOTALCMD#BAR#DATA:
cmd /c ""%COMMANDER_PATH%\Utils\Akelpad\AkelPad.exe" /C+
"%P%%date:~6%%.%%date:~3,2%%.%%date:~0,2%%_%%time:~0,2%%.%%time:~3,2%%.%%time:~6,2%%.txt" /Command(4155) /Command(4137)""
wcmicons.dll,45
Создать файл %ДАТА_ВРЕМЯ%.txt (UTF-8 без ВОМ) в активной панели с текстом из буфера и открыть его в Akelpad

-1

Код кнопки
TOTALCMD#BAR#DATA:
cmd /c ""%COMMANDER_PATH%\Utils\Akelpad\AkelPad.exe" /show(0) /C+
"%P%%date:~6%%.%%date:~3,2%%.%%date:~0,2%%_%%time:~0,2%%.%%time:~3,2%%.%%time:~6,2%%.txt" /Command(4155) /Command(4137) /Command(4325) /quit""
wcmicons.dll,45
Создать файл %ДАТА_ВРЕМЯ%.txt (UTF-8 без ВОМ) в активной панели с текстом из буфера

-1

Flasher
12.11.2014