' VB Script Document
Option Explicit

' если не сказано иное, то 1 значит "включено", 0 - "выключено"

Dim log2console, log2file, logrez2file, interactive
log2console = 1 ' вывод информации в консоль (1/0)
log2file = 1    ' вывод информации в файл (1/0)
logrez2file = 1 ' вывод результата проверки в файл (1/0)
interactive = 1 ' включить запросы пользователю? (1/<>1)

Dim Path2CopyFrom, Path2CopyTo, CompLogFile, CompRezLogFile, DelFiles, ForceDel
Path2CopyFrom = "c:\!2Burn\2.2" ' папка-источник
Path2CopyTo = "d:\"  ' папка назначения
CompLogFile = "c:\!2Burn\compare.log" ' логфайл
CompRezLogFile =  "c:\!2Burn\compare_result.csv" ' результат сравнения
DelFiles = 0  ' очистка исходной папки
              ' 0 - не очищать
              ' 1 - очищать от удачно записанных файлов
              ' 2 - очищать только при удачной записи ВСЕХ файлов
ForceDel = 0  ' принудительное удаление файлов и папок (1/0)
  

Dim ReadSize 
ReadSize = 10 ' Mb, порция при чтении файлов для сравнения - при очень маленькой 
              ' диск иногда останавливается(чтение из буфера) => потери времени
              ' на повторных раскрутках диска

' общее описание работы:
' 1. индексируется содержимое исходной и конечной папки (данные заносятся в 
'    массивы SrcFileNames() и TargtFileNames())              
' 2. проверяется наличие файлов и их размеров (результаты заносятся в массив 
'    SrcFileNames())
' 3. если размеры совпадают, то проверяется сходность содержимого -
'    читается по куску из каждого файла и сравнивается (результаты заносятся в 
'    массив SrcFileNames())
' 4. далее в зависимости от настроек производится очистка исходной папки от тех
'    файлов что прошли проверку и от пустых папок

' результат работы представлен в виде массива
' "путь" - относительный
'i: 0         1         2         3             4             5
'=======================================================================
' path |filename   |  Size  |  IsOnDisk  | IsSameSize  | IsSameContent |
'=======================================================================
' ASJ  |filename1  |  123b  |     1      |       1     |          1    |
'------|-----------|--------|------------|-------------|---------------|
' ASJ  |filename2  |  123b  |     1      |       1     |          1    |
'------|-----------|--------|------------|-------------|---------------|
' ASJ  |filename3  |  123b  |     1      |       1     |          1    |
'------|-----------|--------|------------|-------------|---------------|
' ASJ  |filename4  |  123b  |     1      |       1     |          1    |
'=======================================================================

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const f_ASCII = 0, f_Unicode = -1, f_Default = -2 

Dim TotalTimerStart
TotalTimerStart = timer ' засекаем общее время выполнения

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

Dim oCompLogFile, oCompRezLogFile

check_params() ' проверяем исходные пути

Dim SrcFileNames(), TargtFileNames() ' объявляем динамические массивы для папок
' в Dim не даёт указать размер с переменной, а безразмерный массив в цикле 
' не заполняется. поэтому:
ReDim SrcFileNames(6,0), TargtFileNames(6,0) ' задаём предварительный размер
' массив получается транспонированый по сравнению с табличкой в пояснении, т.к.
' ReDim переразмеривает только последний размер

If CheckSession(Path2CopyFrom, Path2CopyTo) = true Then
    call MakeLog("Проверка завершена. Запись была успешна.")

    If DelFiles = 2 Then
      MakeLog("Включена очистка исходной папки от файлов. Начинаю очистку.")
      call ClearPath1(SrcFileNames, Path2CopyFrom, DelFiles)
    End If

  Else

    call MakeLog("Проверка завершена. Часть файлов записались не корректно.")

    If DelFiles = 1 Then
      MakeLog("Включена очистка исходной папки от удачно записанных файлов. Начинаю очистку.")
      If interactive = 1 Then
          Dim a
          a = MsgBox("Включена очистка папки-источника! Подтверждаете необходимость очистки?", vbYesNo + vbExclamation, "ВНИМАНИЕ!!!")
          Select Case a
            case 6 
              call ClearPath1(SrcFileNames, Path2CopyFrom, DelFiles)
            case 7
              MakeLog("Очитка исходной папки отменена пользователем.")
          End Select
        Else
          call ClearPath1(SrcFileNames, Path2CopyFrom, DelFiles)
      End If
    End If
end If
call MakeLog("Общее время проверки: " & Round(timer - TotalTimerStart, 2) & " сек.")

If logrez2file = 1 Then
  call print_arr(SrcFileNames, 1)
end If

'*******************************************************************************
'********************** Проверка результатов записи ****************************
'*******************************************************************************
Function CheckSession(path1, path2) ' path1 - источник, path2 - копия

  ' сначала индексируем папку-источник
  Call EnumFolderContent(path1, SrcFileNames, 0, true)  
  If log2console = 1 Then
    Call print_arr(SrcFileNames, 0)
  End If

  Call MakeLog("<=========================================================================>")

  ' потом индексируем болванку (целевую папку)
  Call EnumFolderContent(path2, TargtFileNames, 0, false) 
  If log2console = 1 Then
    Call print_arr(TargtFileNames, 0)
  End If
  
  ' получили два массива содержащих относительный путь, имя файла и его размер
  ' теперь нужно сравнить содержимое исходной и конечной папки
  If FolderComp(SrcFileNames, TargtFileNames) = true Then ' сравним содержимое папок(массивов)
    CheckSession = true
    Else
    CheckSession = false
  End If
End Function

'*******************************************************************************
'********************** Сравнение содержимого папок ****************************
'*******************************************************************************
Function FolderComp(ByRef arr1(), ByRef arr2())
'call MakeLog("--------------------------------------------------------------------------------")
'call MakeLog("size1 = " & ubound(SrcFileNames,2) & "; size2 = " & ubound(TargtFileNames,2))
  
' сравниваем файлы
  Dim j, s3, s4, s5
  s3 = 0 ' сумма по столбцу IsOnDisk
  s4 = 0 ' сумма по столбцу IsSameSize
  s5 = 0 ' сумма по столбцу IsSameContent
  ' если сумма не совпадёт с числом строк, то при записи были ошибки

  Dim err1, i
  err1 = 0  

  For i = 0 to ubound(arr1, 2)-1 ' листаем папку-источник
    call MakeLog("--------------------------------------------------------------------------------")
    For j=0 to ubound(arr2, 2)-1 ' листаем папку-приёмник
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' проверяем по именам файлов
      If arr1(0,i) = arr2(0,j) and arr1(1,i) = arr2(1,j)  Then
        call MakeLog("[" & arr1(0,i) & "\" & arr1(1,i) & "] на болванке найден...")
        arr1(3,i) = 1 ' проверка пройдена успешно
  '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  ' проверяем по размерам файлы с совпадающими именами      
          If arr1(2,i) = arr2(2,j) Then
            call MakeLog("... размер совпадает")
            arr1(4,i) = 1 ' проверка пройдена успешно
    '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    ' сравниваем побайтово
    Dim f1, f2
        f1 = ClearPath(Path2CopyFrom) & "\" & arr1(0,i) & "\" & arr1(1,i)
        f2 = ClearPath(Path2CopyTo) & "\" & arr2(0,j) & "\" & arr2(1,j)
              If FilesComp(f1, f2, ReadSize*1024*1024) = true Then
                  call MakeLog("Файлы идентичны")
                  arr1(5,i) = 1 ' проверка пройдена успешно
                  Exit For
                Else
                  call MakeLog("Файлы различаются")
                  arr1(5,i) = 0 ' просто чтобы не было пустот :)
                  Exit For
              End If
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<              
            Else
              arr1(4,i) = 0 ' проверка размера не пройдена
              call MakeLog("... размер не совпадает")
              arr1(5,i) = 0 ' просто чтобы не было пустот :)
              Exit For  
          End If
  '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        Else
          arr1(3,i)=0
      End If   
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Next

  s3 = s3 + arr1(3,i)
  s4 = s4 + arr1(4,i)
  s5 = s5 + arr1(5,i)
  Next
    call MakeLog("================================================================================")
    If s3 = ubound(arr1, 2) and s4 = ubound(arr1, 2)  and s5 = ubound(arr1, 2) Then
        call MakeLog("Проверка завершена: на болванке присутствуют все файлы, размеры файлов правильны, содержание идентично равны.")
        FolderComp = true
      ElseIf s3 < ubound(arr1, 2) and s4 = ubound(arr1, 2)  and s5 = ubound(arr1, 2) Then
        call MakeLog("Проверка завершена: на болванке присутствуют не все файлы из источника.")
      ElseIf s3 = ubound(arr1, 2) and s4 < ubound(arr1, 2)  and s5 = ubound(arr1, 2) Then
        call MakeLog("Проверка завершена: часть файлов на болванке имеет размер отличный от источника.")
      ElseIf s3 = ubound(arr1, 2) and s4 = ubound(arr1, 2)  and s5 < ubound(arr1, 2) Then
        call MakeLog("Проверка завершена: часть файлов на болванке имеет содержание отличное от источника.")
      Else
        call MakeLog("Проверка завершена: в результатах записи выявлены различные ошибки.")
    End If

End Function


'*******************************************************************************
'********************* "Побайтовое" сравнение файлов ***************************
'*******************************************************************************
Function FilesComp(file1, file2, ReadPortionSize) ' размер передаётся в байтах

  Dim fo1, fo2, fsize, step_size
    Set fo1=fso.OpenTextFile(file1, ForReading, f_ASCII) 'только чтение, формат 
    fsize = fso.GetFile(file1).size   ' размер оригинального файла
                                      ' по задумке - ранее файлы оказались равного размера
    step_size = ReadPortionSize / fsize ' относительный размер куска при чтении 
                                        ' длинное
  call MakeLog("Размер файла = " & Round(fsize/1024/1024, 2) & "Mb")
  'call MakeLog("Размер куска = " & ReadPortionSize/1024/1024 & "Mb")
  'call MakeLog("Размер куска = " & ReadPortionSize & " символов" ' совпадает с числом байтов)
  'call MakeLog("Относительный размер куска = " & CStr(Round(step_size * 100, 2)) & "%")
    Set fo2=fso.OpenTextFile(file2, ForReading, f_ASCII) 'только чтение, формат
    
    
  Dim Str1, Str2, i, cur_size, ReadIt
    Str1 = ""
    Str2 = ""
    i = 0
    cur_size = 0
    call MakeLog("Начинаю сравнение:")
  Dim StartTime, EndTime, StepStartTime
    StartTime = Timer ' засекаем общее время выполнения сравнения
    Do While Not fo1.AtEndOfStream   
      StepStartTime = Timer ' засекаем время выполнения шага
      If cur_size * 1024 * 1024 + ReadPortionSize < fsize Then
          ReadIt = ReadPortionSize
        Else
          ReadIt = fsize - cur_size * 1024 * 1024
      End If
        Str1 = fo1.Read(ReadIt)
        Str2 = fo2.Read(ReadIt)
        
      If StrComp(Str1, Str2, vbBinaryCompare) = 0 Then 
          i = i + 1
          cur_size = cur_size + ReadIt/1024/1024
          call MakeLog(i & ". " & Percent2Str(cur_size*1024*1024/fsize) & " @ dT=" & Round(Timer - StepStartTime, 2) & "c => OK. Done " & Round(cur_size,2) & "Mb from " & Round(fsize/1024/1024, 2) & "Mb")
          FilesComp = true
        Else
          call MakeLog(Percent2Str(cur_size*1024*1024/fsize) & " @ dT=" & Round(Timer - StepStartTime, 2) & "c => файлы не совпадают")
          FilesComp = false
          Exit Do
      End If
' ограничитель цикла (для отладки - поставить нужное положительное)
      If i = -200 Then
        Exit Do
      End If
    Loop
  EndTime = Timer
  call MakeLog("Затраченное время: " & EndTime - StartTime & " сек.")  
End Function
'*******************************************************************************
'********************** формирование строки процентов **************************
'*******************************************************************************
Function Percent2Str(number)
' вдруг захочется ещё отформатировать вывод :) - чтобы править в одном месте
  Percent2Str = FormatPercent(number, 2, -1)
End Function


'*******************************************************************************
'********************** Формирование списка фалов ******************************
'*******************************************************************************
Sub EnumFolderContent(path2enum, ByRef arr(), i, IsPath1)
' параметры в порядке следования:
' путь для обработки(строка)
' массив для заполнения(сюда название)
' последний индекс файла (для сквозной нумерации для вывода в консоль)(целое)
' признак папки-источника или конечной папки - для "сборки" полного пути к файлу(булево)


' заполняем массив, описывающие содержимое папки поля:
' 0 - путь относительно корневой папки(Path2CopyFrom или Path2CopyTo)
' 1 - имя файла
' 2 - размер файла(байт)
' 3, 4, 5 - заполняются при сравнении файлов
path2enum = ClearPath(path2enum) ' чистим путь

  Dim fldr, files, folders
  Set fldr = fso.GetFolder(path2enum)
  Set files = fldr.Files ' список файлов
  Set folders = fldr.SubFolders ' список подпапок
  ReDim Preserve arr(6, UBound(arr, 2) + files.count) ' "раздвигаем" массив под
                                                      ' новую порцию файлов

  Dim File
  For Each File in files
    If IsPath1 = true Then ' отделяем относительный путь к файлу
      arr(0,i) = ClearPath(Right(ClearPath(fldr.Path), Len(ClearPath(fldr.Path)) - Len(ClearPath(Path2CopyFrom))))
      Else
      arr(0,i) = ClearPath(Right(ClearPath(fldr.Path), Len(ClearPath(fldr.Path)) - Len(ClearPath(Path2CopyTo))))
    End If

    arr(1,i) = File.Name  ' имя файла
    arr(2,i) = File.Size  ' размер в байтах
    i = i + 1 ' просто порядковый номер файла для вывода в консоль
  Next
  Dim Folder
  For Each Folder in folders
    Call EnumFolderContent(Folder, arr, i, IsPath1) ' рекурсия :)
  Next
End Sub
'*******************************************************************************
'***************************** Чистка "пути" ***********************************
'*******************************************************************************
Function ClearPath(PathString)
' чистим путь от слэшей в конце и начале (чтобы исключить зависимость от ввода) 
' и направляем их в одну сторону :)
  ClearPath = Trim(PathString)
  ClearPath = Replace(ClearPath, "/", "\") ' меняем прямые на обратные
  ClearPath = Replace(ClearPath, "\\", "\") ' избавляемся от двойных слэшей
  If Left(ClearPath, 1) = "\" Then    ' убираем слэш слева
    ClearPath = Right(ClearPath, Len(ClearPath)-1)
  End If
  If Right(ClearPath, 1) = "\" Then   ' убираем слэш справа
    ClearPath = Left(ClearPath, Len(ClearPath)-1)
  End If
End Function

'*******************************************************************************
'*********************** Вывод содержимого массива *****************************
'*******************************************************************************
sub print_arr(ByRef arr(), is2Save)
' 2Save - если 1, то сохраняем в файл. если 0 - выводим на экран
  Dim m
  for m=0 to ubound(arr,2) - 1
    If log2console = 1 and is2Save = 0 Then
      wscript.echo m & ";" & arr(0,m) & ";" & arr(1,m) & ";" & arr(2,m) & ";" & arr(3,m) & ";" & arr(4,m) & ";" & arr(5,m)
    End If
    If logrez2file = 1  and is2Save = 1 Then
      oCompRezLogFile.WriteLine(arr(0,m) & ";" & arr(1,m) & ";" & arr(2,m) & ";" & arr(3,m) & ";" & arr(4,m) & ";" & arr(5,m))
    End If
  next 
end sub
'*******************************************************************************
'******************** Информирование о ходе процесса ***************************
'*******************************************************************************
sub MakeLog(MessageString)
  If log2console = 1 Then
    wscript.echo MessageString
  End If
  If log2file = 1 Then
    oCompLogFile.WriteLine(MessageString)
  End If
end sub

'*******************************************************************************
'*********************** Очистка папки-источника *******************************
'*******************************************************************************
Sub ClearPath1(ByRef arr(), RootPath, ClearMode)
' arr - массив с результатами проверки
' RootPath - Path2CopyFrom
' ClearMode - режим чистки
' проверяем массив - если все 6-ые равны 1, значит можно тереть всё
' проходим по массиву - если 6-ой элемент равен 1 (удачная проверка)

Dim f, j, DelRez, fold
For j = 0 to ubound(arr, 2)-1
  If arr(5,j) = 1 Then
    MakeLog("Удаляю файл: " & ClearPath(RootPath & "\" & arr(0,j) & "\" & arr(1,j)))
    On Error Resume Next
    If ForceDel = 1 Then
        'DelRez = 
        fso.DeleteFile ClearPath(RootPath & "\" & arr(0,j) & "\" & arr(1,j)), true
      Else
        'DelRez = 
        fso.DeleteFile ClearPath(RootPath & "\" & arr(0,j) & "\" & arr(1,j)), false
    End If
    
    Select Case Err.Number
      Case 70
        MakeLog("Не удалось удалить файл [" & ClearPath(RootPath & "\" & arr(0,j) & "\" & arr(1,j)) & "]: Permission denied.")
      Case 53
        MakeLog("Не удалось удалить файл [" & ClearPath(RootPath & "\" & arr(0,j) & "\" & arr(1,j)) & "]: File not found.")
      Case 0
        MakeLog("Done.")
      Case Else
        MakeLog("Не удалось удалить файл [" & ClearPath(RootPath & "\" & arr(0,j) & "\" & arr(1,j)) & "] по причине НЕХ, код ошибки: " & Err.Number)
    End Select
    Else
    MakeLog("Файл был не корректно записан(удалён не будет): " & ClearPath(RootPath & "\" & arr(0,j) & "\" & arr(1,j)))
  End If
Err.Clear
next
MakeLog("**************************************************************************")
' проходим папки - если пустые, трём
Dim fldr, fldr_path, fldr_path_last
fldr_path = "" ' текущий путь
fldr_path_last = "" ' последний использованный путь
For j = ubound(arr, 2)-1 to 0 step -1 ' начинаем с самых глубоких папок
      fldr_path = ClearPath(RootPath & "\" & arr(0,j))
' корневую папку не трогаем, ранее обработанную пропускаем(и на всякий случай проверяем наличие)
  If StrComp(fldr_path, ClearPath(RootPath), 1) <> 0 and _
    fso.FolderExists(fldr_path) and _
    StrComp(fldr_path_last, fldr_path, 1) <> 0 Then 
    set fldr = fso.GetFolder(fldr_path) ' получаем ссылку на папку
    MakeLog("Папка пустая(" & fldr_path & "). Удаляю.")
    If ForceDel = 1 Then
        fso.DeleteFolder fldr_path, true
      Else
        fso.DeleteFolder fldr_path, false
    End If
    fldr_path_last = fldr_path
    Select Case Err.Number
      Case 70
        MakeLog("Не удалось удалить папку [" & ClearPath(RootPath & "\" & arr(0,j)) & "]: Permission denied.")
      Case 76
        MakeLog("Не удалось удалить папку [" & ClearPath(RootPath & "\" & arr(0,j)) & "]: Path not found.")
      Case 0
        MakeLog("Done.")
      Case Else
        MakeLog("Не удалось удалить папку [" & ClearPath(RootPath & "\" & arr(0,j)) & "] по причине НЕХ, код ошибки: " & Err.Number)
    End Select
  End If
Err.Clear
next
End Sub
'*******************************************************************************
'*********************** Проверка исходных данных *****************************
'*******************************************************************************
sub check_params()
  wscript.echo "Начинаю проверку исходных данных для скрипта..."
  Dim tmp1, tmp2, chkerr
  chkerr = 0
  tmp1 = ClearPath(left(ClearPath(CompLogFile), InStrRev(ClearPath(CompLogFile), "\", -1, vbTextCompare)))
  ' проверяем папку для лог-файла
  If not fso.FolderExists(tmp1) Then
      wscript.echo "=> Папка для лог-файла не найдена! Проверьте переменную CompLogFile."
      chkerr = chkerr + 1 
    Else
      ' открываем(создаём) файл для записи:
      If log2file = 1 Then
'          Dim oCompLogFile
          Set oCompLogFile = fso.OpenTextFile(CompLogFile, ForWriting, true, -2)
      End If
      MakeLog("папка для лог-файла обнаружена...")
      tmp2 = 1
  End If
  ' проверяем папку для файла вывода результатов проверки
  tmp1 = ClearPath(left(ClearPath(CompRezLogFile), InStrRev(ClearPath(CompRezLogFile), "\", -1, vbTextCompare)))
  If not fso.FolderExists(tmp1) Then
      If tmp2 = 0 Then
          wscript.echo "====> Папка для файла с результатом проверки не найдена! Проверьте переменную CompRezLogFile."
        Else
          MakeLog("====> Папка для файла вывода результатов проверки не найдена! Проверьте переменную CompRezLogFile.")
      End If
      chkerr = chkerr + 1
    Else
      If logrez2file Then
'          Dim oCompRezLogFile
          Set oCompRezLogFile = fso.OpenTextFile(CompRezLogFile, ForWriting, true, -2)
      End If
      If tmp2 = 0 Then
          wscript.echo "папка для файла вывода результатов проверки обнаружена..."
        Else
          MakeLog("папка для файла вывода результатов проверкиобнаружена...")
      End If
  End If
  ' проверяем папку-источник
  If not fso.FolderExists(ClearPath(Path2CopyFrom)) Then
      If tmp2 = 0 Then
          wscript.echo "====> Исходная папка не найдена! Проверьте переменную Path2CopyFrom."
        Else
          MakeLog("====> Исходная папка не найдена! Проверьте переменную Path2CopyFrom.")
      End If
      chkerr = chkerr + 1
    Else
      If tmp2 = 0 Then
          wscript.echo "исходная папка обнаружена..."
        Else
          MakeLog("исходная папка обнаружена...")
      End If
  End If
  ' проверяем папку-приёмник
  If not fso.FolderExists(ClearPath(Path2CopyTo)) Then
      If tmp2 = 0 Then
          wscript.echo "=> Конечная папка не найдена! Проверьте переменную Path2CopyTo."
        Else
          MakeLog("=> Конечная папка не найдена! Проверьте переменную Path2CopyTo.")
      End If
      chkerr = chkerr + 1
    Else
      If tmp2 = 0 Then
          wscript.echo "конечная папка обнаружена..."
        Else
          MakeLog("конечная папка обнаружена...")
      End If
  End If
  If chkerr <> 0 Then
      If tmp2 = 0 Then
          wscript.echo ""
          wscript.echo "Часть параметров задана не верно. Исправьте значения и запустите скрипт ещё раз."
        Else
          MakeLog("")
          MakeLog("Часть параметров задана не верно. Исправьте значения и запустите скрипт ещё раз.")
      End If
      wscript.quit
    Else
      MakeLog("All OK.")
      MakeLog("Начинаю проверку...")
  End If
end sub

        //
        // Set the verification level
        //
        IBurnVerification burnVerification = (IBurnVerification)discFormatData;
        burnVerification.BurnVerificationLevel =
            (IMAPI_BURN_VERIFICATION_LEVEL)m_verificationLevel;

' This script adds data files from a single directory tree to a
' disc (a new session is added, if the disc already contains data)

' Copyright (C) Microsoft Corporation. All rights reserved.

Option Explicit

' *** CD/DVD disc file system types
Const FsiFileSystemISO9660 = 1
Const FsiFileSystemJoliet  = 2
Const FsiFileSystemUDF102  = 4

' *** IFormat2Data Write Action Enumerations
Const IMAPI_FORMAT2_DATA_WRITE_ACTION_VALIDATING_MEDIA      = 0
Const IMAPI_FORMAT2_DATA_WRITE_ACTION_FORMATTING_MEDIA      = 1
Const IMAPI_FORMAT2_DATA_WRITE_ACTION_INITIALIZING_HARDWARE = 2
Const IMAPI_FORMAT2_DATA_WRITE_ACTION_CALIBRATING_POWER     = 3
Const IMAPI_FORMAT2_DATA_WRITE_ACTION_WRITING_DATA          = 4
Const IMAPI_FORMAT2_DATA_WRITE_ACTION_FINALIZATION          = 5
Const IMAPI_FORMAT2_DATA_WRITE_ACTION_COMPLETED             = 6
const IMAPI_FORMAT2_DATA_WRITE_ACTION_VERIFYING             = 7

' IMAPI_BURN_VERIFICATION_LEVEL Enumeration
Const IMAPI_BURN_VERIFICATION_NONE                          = 0
Const IMAPI_BURN_VERIFICATION_QUICK                         = 1
Const IMAPI_BURN_VERIFICATION_FULL                          = 2 

WScript.Quit(Main)

Function Main
    Dim Index                ' Index to recording drive.
    Dim Recorder             ' Recorder object
    Dim Path                 ' Directory of files to add
    Dim Stream               ' Data stream for burning device
    
    Index = 0                ' First drive on the system
    Path = "c:\!2Burn\2"      ' Files to add to the disc

    ' Create a DiscMaster2 object to connect to optical drives.
    Dim DiscMaster
    Set DiscMaster = WScript.CreateObject("IMAPI2.MsftDiscMaster2")

    ' Create a DiscRecorder2 object for the specified burning device.
    Dim UniqueId
    set Recorder = WScript.CreateObject("IMAPI2.MsftDiscRecorder2")
    UniqueId = DiscMaster.Item(Index)
    Recorder.InitializeDiscRecorder(UniqueId)

    ' Create a DiscFormat2Data object and set the recorder
    Dim DataWriter
    Set DataWriter = CreateObject ("IMAPI2.MsftDiscFormat2Data")
    DataWriter.Recorder = Recorder
    DataWriter.ClientName = "IMAPIv2 TEST"

    ' Set the verification level
' а вот тут-то и затык

    ' Create a new file system image object
    Dim FSI
    Set FSI = CreateObject("IMAPI2FS.MsftFileSystemImage")

    ' Import the last session, if the disc is not empty, or initialize
    ' the file system, if the disc is empty
    If Not DataWriter.MediaHeuristicallyBlank _
    Then
        On Error Resume Next
        ' !!!
        FSI.MultisessionInterfaces = DataWriter.MultisessionInterfaces
        If Err.Number <> 0 _
        Then
            WScript.Echo "Multisession is not supported for this disc"
            Main = 1
            Exit Function
        End If
        On Error Goto 0

        WScript.Echo "Importing data from the previous session..."
        FSI.ImportFileSystem()
    Else 
        FSI.ChooseImageDefaults(Recorder)
    End If

    ' Add the directory and its contents to the file system 
    WScript.Echo "Adding " & Path & " directory to the disc..."
    FSI.Root.AddTree Path, false

    ' Create an image from the file system image object
    Dim Result
    Set Result = FSI.CreateResultImage()
    Stream = Result.ImageStream
'###############################################################################
    ' Attach event handler to the data writing object.
    WScript.ConnectObject  dataWriter, "dwBurnEvent_"
'###############################################################################
    
    ' Write stream to disc using the specified recorder
    WScript.Echo "Writing content to the disc..."
    DataWriter.Write(Stream)

    WScript.Echo "Finished writing content."
    Main = 0
End Function

SUB dwBurnEvent_Update( byRef object, byRef progress )
    DIM strTimeStatus
    strTimeStatus = "Time: " & progress.ElapsedTime & _
        " / " & progress.TotalTime
   
    SELECT CASE progress.CurrentAction
    CASE IMAPI_FORMAT2_DATA_WRITE_ACTION_VALIDATING_MEDIA
        WScript.Echo "Validating media " & strTimeStatus

    CASE IMAPI_FORMAT2_DATA_WRITE_ACTION_FORMATTING_MEDIA
        WScript.Echo "Formatting media " & strTimeStatus
        
    CASE IMAPI_FORMAT2_DATA_WRITE_ACTION_INITIALIZING_HARDWARE
        WScript.Echo "Initializing Hardware " & strTimeStatus

    CASE IMAPI_FORMAT2_DATA_WRITE_ACTION_CALIBRATING_POWER
        WScript.Echo "Calibrating Power (OPC) " & strTimeStatus

    CASE IMAPI_FORMAT2_DATA_WRITE_ACTION_WRITING_DATA
        DIM totalSectors, writtenSectors, percentDone
        totalSectors = progress.SectorCount
        writtenSectors = progress.LastWrittenLba - progress.StartLba
        percentDone = FormatPercent(writtenSectors/totalSectors)
        WScript.Echo "Progress:  " & percentDone & "  " & strTimeStatus

    CASE IMAPI_FORMAT2_DATA_WRITE_ACTION_FINALIZATION
        WScript.Echo "Finishing the writing " & strTimeStatus
    
    CASE IMAPI_FORMAT2_DATA_WRITE_ACTION_COMPLETED
        WScript.Echo "Completed the burn."

    CASE IMAPI_FORMAT2_DATA_WRITE_ACTION_VERIFYING
        WScript.Echo "Verifying the data."

    CASE ELSE
        WScript.Echo "Unknown action: " & progress.CurrentAction
    END SELECT
END SUB