Разбиение/слияние тесктовых файлов с объектами

[Storkich]

Вопрос экспорта/импорта объектов как текст.


Помещаем все текстовики в папку, перетаскиваем папку на скрипт

'==========================================  Начало файла 
'Имя: glue.vbs
'Язык: VBScript 
'Описание: Собирает все текстовые файлы в один
'Использование: Перетащить папку на скрипт 
'========================================================== 
 set WshShell=WScript.CreateObject("WScript.Shell")
 Dim lngI, objArgs 
 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
 Set objArgs= WScript.Arguments 'Создаём объект WshArguments
 For lngI=0 To objArgs.Count-1  'Перебираю все папки, которые перетащили на скрипт
   FileName = objArgs(lngI)&".txt" 'Имя результируещего файла
   Set  FOut = objFSO.OpenTextFile (FileName,2,true)
    Set objFolder = objFSO.GetFolder(objArgs(lngI))
    ShowSubFolders(objFolder)   'Запускаю перебор подкаталогов
   FOut.Close
 Next 

Sub ShowSubFolders(objFolder)
 'Сначала просматриваю папки.
  Set colFolders = objFolder.SubFolders
  For Each objSubFolder In colFolders
    'WScript.Echo objSubFolder.Path     
    ShowSubFolders(objSubFolder) 
  Next
 ' Потом просматриваю файлы.
  Set colFiles = objFolder.Files
  For Each objFile In colFiles
    if Ucase(Right(objFile.Path,4))=".TXT" then
      'Set objFSO1 = WScript.CreateObject("Scripting.FileSystemObject")	
      Set  FSrc = objFSO.OpenTextFile(objFile.Path)	
      'FOut.WriteLine objFile.Path
      FOut.WriteLine(FSrc.ReadAll)
      FSrc.Close
    end if
  Next
End Sub
'==========================================  Окончание файла

Выгружаем из нава кучу объектов, а на выходе получаем каждый объект в виде текстового файла

'==========================================  Начало файла 
'Имя: SeparateObject.vbs
'Язык: VBScript 
'Описание: Разбивает объекты на отдельные файлы
'Использование: Cделать ярлык в автозагрузке, указать в качестве параметров 
'               пути к файлам, которые нужно разбивать
'========================================================== 
On Error Resume Next

set WshShell=WScript.CreateObject("WScript.Shell")
Dim lngI, objArgs, Files
Files = "("
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objArgs= WScript.Arguments 'Создаём объект WshArguments
For lngI=0 To objArgs.Count-1  'Перебираю все файлы, которые перетащили на скрипт
  IF lngI > 0 THEN Files = Files & " OR "
  Files = Files & "(TargetInstance.Name = '" & (objArgs(lngI)) & "')"
Next 
Files = Files & ")"
Files = Replace(Files,"\","\\")

Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2") 
Set objEvents = objWMIService.ExecNotificationQuery _ 
("SELECT * FROM __InstanceOperationEvent WITHIN 3 WHERE " & _ 
                    "TargetInstance ISA 'CIM_DataFile'" & _ 
                    " AND " & Files ) 
'WScript.Echo Files
Do While(True) 
  Set objReceivedEvent = objEvents.NextEvent 
  SeparateFile(objReceivedEvent.TargetInstance.Name)
Loop 
msgBox("End ")


Sub SeparateFile(FileName)
  Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
  IF objFSO.FileExists(FileName) THEN
    Do  
      Err.Clear
      WScript.Sleep  500
      Set TxtStream = objFSO.OpenTextFile(FileName)
    Loop Until(err.number = 0)
    Do While Not (TxtStream.atEndOfStream)
      Text = TxtStream.ReadLine 
      IF LEFT(TEXT,6) = "OBJECT" then
        OutFileName = Left(FileName, InStrRev(FileName,"\")) & ObjFileName(TEXT)
        IF objFSO.FileExists(OutFileName) THEN
          Set FOut = objFSO.OpenTextFile (OutFileName,2,true) 
          FileOpen = TRUE
        ELSE
          IF MsgBox("Create " & OutFileName & "?" , 4, OutFileName) = 6 THEN
            Set FOut = objFSO.OpenTextFile (OutFileName,2,true) 
            FileOpen = TRUE
          END IF
        END IF
      END IF
      IF FileOpen THEN FOut.WriteLine(Text)
      IF LEFT(TEXT,1) = "}" then
        IF FileOpen THEN 
          FOut.WriteLine("")
          FOut.Close 
        END IF
        FileOpen = FALSE
      END IF
    Loop
    TxtStream.Close
    objFSO.DeleteFile(FileName)
  END IF
END Sub 

Function ObjFileName(ObjString)
  Prefix = LCase(MID(ObjString,8,1))
  Number = MID(ObjString,InStr(8,ObjString," ")+1,LEN(ObjString))
  objName = MID(Number,InStr(1,Number," ")+1, LEN(ObjString))
  Number = LEFT(Number,InStr(1,Number," ")-1)
  ObjFileName = Prefix & Number & " - " & objName & ".txt"
END Function
'==========================================  Окончание файла

Имена файлов можете настроить под себя.