Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: Создать по тексту буфера папку с первой строкой и TXT-файл 
Author Message
Flasher



PostPosted: Sun Jan 22, 2017 23:49    Post subject: Reply with quote

Code:
'=========================================================================
' Cоздание в активной панели папки и файла в ней с тем же именем, взятым
' из первой строки буфера обмена, и содержимым в нём текстом (при наличии)

' Параметры: "<путь назначения>" <расширение текстового файла>
' Пример:    "%P" txt
'=========================================================================
Set Par = WScript.Arguments
If Par.Count <> 2 Then MsgBox "Укажите 2 параметра!", 4144 : WSH.Quit
Set WSS = CreateObject("WScript.Shell")
R = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
On Error Resume Next
A = WSS.RegRead(R) : If A > 0 Or Err.Number <> 0 Then WSS.RegWrite R, 0, "REG_DWORD"
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
If A > 0 Then WSS.RegWrite R, A, "REG_DWORD"
On Error Goto 0
If IsNull(Clip) Or Trim(Clip) = "" Then WSH.Quit
R = Array(-230,-225,-246,698,894,-24,-24,-24,706,707)
S = Split(": ? * "" ; \ / | < >")
With New Regexp
  .Pattern = "^\s*([^\r\n]+)\s*" : Name = .Execute(Clip)(0).SubMatches(0)
  .Pattern = "[^ !-‚-›\u0080-\u00FF\u0400-\u04FF\u20A0-\u20CF\u2100-\u214F\w‘’–—]"
  .Global = True : If .Test(Clip) Then Enc = True Else Enc = False
End With : For i = 0 To 9 : Name = Replace(Name, S(i), ChrW(R(i))) : Next
With CreateObject("Scripting.FileSystemObject")
  Folder = .BuildPath(Par.Item(0), Name) & "\" : Ext = Par.Item(1)
  If Len(Folder) > 260 Then Folder = "\\?\" & Folder : T = 1
  If Not .FolderExists(Folder) Then .CreateFolder Folder
  F = Folder & .GetBaseName(Name) : FN = F & "." & Ext
  If T = "" And Len(FN) > 259 Then F = "\\?\" & F : FN = "\\?\" & FN
  While .FileExists(FN) Or .FolderExists(FN)
    i = i + 1 : FN = F & " (" & i & ")" & "." & Ext
  Wend : .CreateTextFile(FN,,Enc).Write Clip : WSS.SendKeys "^r"
End With

_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group