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: Как скопировать несколько файлов в один? 
Author Message
Batya



PostPosted: Fri Jan 11, 2008 15:58    Post subject: Reply with quote

doRn
С добавлением всех проверок и собственной сортировки по возрастанию номера в расширении получилось чуть больше 20 строк Smile
Только crc-сумму я не проверяю.
Code:
'=================================================================================
' Склеивание выделенных файлов.
' Два режима работы скрипта:

' 1. Склеиваются только файлы с цифровым расширением.
' Если после отбрасывания цифрового расширения у файлов останется какое-либо
'   расширение, то оно будет у итогового файла, иначе - расширение out:
' (*.001,...,*.999) -> *.out; (*.ext.001,...,*.ext.999) -> *.ext
' Папка (существующая) формирования итоговых файлов указывается вторым параметром.
' Параметры вызова из TC:
' %L "%T"
' или
' %L "%P"

' 2. Склеиваются все файлы в один, если вторым параметром указан файл, а не папка.
' Такой файл не должен существовать.
' Параметры вызова из TC:
' %L {путь итогового файла}
' Пример:
' %L "%Tresult.txt"
'=================================================================================
Option Explicit
' Проверяем число параметров
Dim Title
Title = "Склеивание выделенных файлов"
If WScript.Arguments.Count < 2 Then
  MsgBox "Неправильно заданы параметры!", _
    vbOKOnly + vbCritical, Title
  WScript.Quit
End If

Dim FSO, Out, Mode
Set FSO = CreateObject("Scripting.FileSystemObject")
Out = WScript.Arguments(1)
If FSO.FolderExists(Out) Then
  Mode = 1
Else
  If FSO.FileExists(Out) Then
    MsgBox "Файл " & Out & " уже существует!" & vbNewLine &_
           "Работа скрипта будет прервана.", _
           vbOKOnly + vbCritical, Title
    Set FSO = Nothing
    WScript.Quit
  Else
    Mode = 2
  End If
End If

Dim List, ListArr, WSH, L, Line
List = FSO.OpenTextFile(WScript.Arguments(0), 1).ReadAll
ListArr = Split(List, vbNewLine)

Set WSH = CreateObject("WScript.Shell")
Select Case Mode
  Case 1 Mode1Proc
  Case 2 Mode2Proc
End Select

Set WSH = Nothing
Set FSO = Nothing
WScript.Quit

Sub Mode1Proc
  Dim ListDic, Name, Ext, ExtOut, FileOut, PathOut, k
  Set ListDic = CreateObject("Scripting.Dictionary")
  For Each L In ListArr
    Ext = FSO.GetExtensionName(L)
    If IsNumeric(Ext) Then
      Name = FSO.GetBaseName(L)
      ExtOut = FSO.GetExtensionName(Name)
      If ExtOut = "" Then
        ExtOut = "out"
      Else
        Name = FSO.GetBaseName(Name)
      End If
      FileOut = Name & "." & ExtOut
      PathOut = Out & FileOut
      If FSO.FileExists(PathOut) Then
        WSH.Popup "Файл " & PathOut & " уже существует." & vbNewLine &_
                  "Склеивание в этот файл не будет выполнено!", _
                  1, Title, vbOKOnly + vbCritical
      Else
        If Not ListDic.Exists(PathOut) Then
          Set ListDic.Item(PathOut) = CreateObject("Scripting.Dictionary")
        End If
        ListDic(PathOut).Add CInt(Ext), L
      End If
    End If
  Next
  For Each L In ListDic.Keys
    Line = ""
    For k = 1 To 999
      If ListDic(L).Exists(k) Then
        Line = Line & "+""" & ListDic(L)(k) & """"
      End If
    Next
    Line = Mid(Line, 2)
    WSH.Run "%ComSpec% /c copy /b " & Line & " """ & L & """", 7, True
  Next
  Set ListDic = Nothing
End Sub

Sub Mode2Proc
  Line = ""
  For Each L In ListArr
    If FSO.FileExists(L) Then
      Line = Line & "+""" & L & """"
    End If
  Next
  Line = Mid(Line, 2)
  WSH.Run "%ComSpec% /c copy /b " & Line & " """ & Out & """", 7, True
End Sub


Добавлено: Переделал скрипт - теперь склеивать можно не только текстовые файлы.
_________________
Нет, я не сплю. Я просто медленно моргаю.
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group