Flasher
|
 Posted: Sat Aug 26, 2017 15:33 Post subject: |
 |
|
Nick
Второй пункт противоречит первому.
Если файл находится где-нибудь в середине или в конце выделенного списка, то в какой последовательности записывать?
Сделал в той же (от первого).
| Code: | '••••••••••••••••••••••••••••• VBS ••••••••••••••••••••••••••••
' Бинарное соединение файлов, выделенных в активной панели ТC
'
' Параметры: %WL
' Дополнительные (иначе дозапись осуществляется в первый файл):
' "<путь получателя при создании>" <режим записи> "<имя файла>"
'
' Режим записи принимает следующие значения:
' 0 = перезаписывать существующий файл; (по умолчанию)
' 1 = не создавать файл при существовании;
' 2 = добавлять счётчик к имени нового файла.
'
' Ключ для удаления исходных файлов: /del
'
' Примеры: %WL /del | %WL "%T" 2 | %WL "%P" 0 %N
'••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••
Option Explicit: Dim Mode, Del, C, List, Name, Path, Er, Rgx,_
Col, Dic, FSO, FP, BN, Ext, i, Fi, N, Num, Fl, Arr, FMem, Buff
With WSH.Arguments
Mode = 0 : Del = .Named.Exists("del")
C = .UnNamed.Count : If C = 0 Then WSH.Quit
List = .Item(0) : If C = 4 Then Name = .Item(3)
If C > 1 Then Path = .Item(1) : Mode = .Item(2)
End With
If C = 3 Then
Set Rgx = New RegExp : Rgx.Pattern = "[""/*\\:|?<>]"
While Rgx.Test(Name) Or IsEmpty(Name)
If Not IsEmpty(Name) Then Er = Space(38) & "Некорректное имя!"
Name = RTrim(InputBox(String(3, vbCr) & Er & vbCr & vbCr &_
"Введите имя нового файла:", " Соединение файлов", Name))
Wend : If Name = "" Then WSH.Quit
End If
Set Col = CreateObject("Scripting.Dictionary")
Set Dic = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
If C > 1 Then
FP = FSO.BuildPath(Path, Name)
If Len(FP) > 259 Then FP = "\\?\" & FP : Path = "\\?\" & Path
If Mode = 1 Then
If FSO.FileExists(FP) Or FSO.FolderExists(FP) Then WSH.Quit
ElseIf Mode = 2 Then
BN = FSO.GetBaseName(Name) : Ext = FSO.GetExtensionName(FP)
If Len(Ext) Then Ext = "." & Ext
While FSO.FileExists(FP) Or FSO.FolderExists(FP)
i = i + 1 : FP = FSO.BuildPath(Path, BN & " (" & i & ")" & Ext)
Wend
End If
End If
Set List = FSO.OpenTextFile(List,,,-1)
Do : Fi = List.ReadLine
If Len(Fi) > 259 Then Fi = "\\?\" & Fi
If FSO.FileExists(Fi) Then Col.Add Fi, "" : _
Num = FSO.GetFIle(Fi).Size : If Num Then Dic.Add Fi, Num
Loop Until List.AtEndOfStream : List.Close : N = 0
Num = Dic.Count : If Num = 0 Then WSH.Quit
Arr = Col.Keys : If C = 1 Then FP = Arr(0)
List = Dic.Keys : If Num = 1 And FP = List(0) Then WSH.Quit
If Not FSO.FileExists(FP) Then FSO.CreateTextFile(FP).Close
Set Fl = FSO.GetFile(FP) : If C = 1 And Dic.Exists(FP) Then N = 1
With CreateObject("SAPI.SpFileStream")
If Dic.Exists(FP) And FP <> List(0) Then _
.Open FP, 2 : .Read FMem, Fl.Size :_
.Close : Fl.OpenAsTextStream(2).Close
For i = N To Num - 1
Fi = List(i) : C = 0 : If Left(Fi, 1) = "\" Then C = 2
If FP = Fi Then Buff = FMem : FMem = "" Else _
.Open Fi, C : .Read Buff, Dic.Item(Fi) : .Close
.Open FP, 1 : .Seek Fl.Size : .Write Buff : Buff = "" : .Close
Next
End With
If Del Then For Each i in Arr :_
If i <> FP Then FSO.DeleteFile i, 1 End If : Next
CreateObject("WScript.Shell").PopUp _
"Файлы соединены!", 0.6, " Соединение файлов", 4160 |
[+] Отладил работу при наличии пустых файлов.
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
