Создание файла с содержимым буфера обмена
Содержание
- 1 vbs-скрипт, использующий Script Helper
- 2 Создание файла с циклической проверкой его существования
- 3 Создание txt-файла в кодировке UTF-8 без ВОМ с опцией октрытия или перехода в панели
- 4 Оптимизированный скрипт создания папки или файла с именем строки буфера по заданному номеру
- 5 Кнопочные решения
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
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