'=========================================================================
' 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 |