1

Тема: VBScript: IMAPI + IBurnVerification Interface

Добрый день.

Для начала задача: запись мультисессионных дисков из консоли с контролем результата записи(скидывать ежедневные бэкапы). Другими словами нужна замена для nerocmd.exe.

Волею судьбы наткнулся в MSDN на практически готовое решение средствами IMAPI(находка уже полезная, надо лишь доработать напильником). Приведённый ниже код это объединение Creating a Multisession Disc(непосредственно запись мультисессионного диска) и Monitoring Progress With Events(вывод в консоль сообщений о процессе записи - отсюда взята SUB + ConnectObject в функцию).

Единстенное что не нашел - пример как включить проверку записи(остальное работает, по крайней мере на CD-RW).
За проверку отвечает интерфейс IBurnVerification, но сложность в том, что "No corresponding object", т.е. напрямую к нему обратиться я не могу. Есть подсказка - "The IBurnVerification interface inherits from the IDispatch interface.", но мои познания в програмировании не позволяют мне понять как связать эти интерфейсы и как потом эту связку использовать.

Кстати в форумах МС также давались советы и по другим связываниям:
topic#1

You need to cast MsftDiscFormat2Data to IBurnVerification, and only after that call IBurnVerificationPtr.BurnVerificationLevel =BurnVerificationLevel.Full;

topic#2

Eric is correct that IBurnVerification interface derives from IUnknown and not from IDispatch, which could be contributing to your issue.

Подскажите, пожалуйста, как же включить проверку записи в VB?
Также буду очень благодарен на ссылку по которой можно почитать "в теории", а ещё лучше с примерами о работе VB6 с COM объектами, особенно про упомянутые "связывания". Конечно желательно на русском. Возможна ссылка на бумажную книгу(попробую найти в продаже).

' 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

На всякий случай приведу ссылку на проект с IMAPI(к сожалению на C#, познания в котором у меня ограничиваются необходимостью ставить ";" в конце строки ). В этом коде проверка есть, но не зная синтаксиса C# переделать нужный кусок в VB6(VBScript) я не могу. В Яндекс-Гугл(да и Bing тоже) все найденные ссылки опять таки вели к решению проблем в сишном коде.

2

Re: VBScript: IMAPI + IBurnVerification Interface

Ну, в общем, из topic#2 ясно, что в документации ошибка и на самом деле IDispatch там нет. А без него из скрипта этот интерфейс не задействовать. Про VB6 ничего не могу сказать, для меня это то же, что для Вас Си.

3

Re: VBScript: IMAPI + IBurnVerification Interface

YMP пишет:

Ну, в общем, из topic#2 ясно, что в документации ошибка и на самом деле IDispatch там нет. А без него из скрипта этот интерфейс не задействовать. Про VB6 ничего не могу сказать, для меня это то же, что для Вас Си.

В конце своего первого поста забыл приложить ссылку на сишный проект Burning and Erasing CD/DVD/Blu-ray Media with C# and IMAPI2. Вот конкретный кусок(я так понимаю, что если откуда-то IBurnVerification здесь и тянется, то точно не из IDispatch):

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

discFormatData это объект MsftDiscFormat2Data, который в скрипте работает. Что-то мне подсказывает что всё таки из скрипта как-то добраться до IBurnVerification всё таки можно. Вот только я не понимаю что конкретно приведённый кусок кода делает(в терминах которые с помощью гугла помогут мне в поиске решения).

Ну а ошибки в докуменации к сожалению бывают.

4

Re: VBScript: IMAPI + IBurnVerification Interface

На MSDN документацию подправили. Теперь:

The IBurnVerification interface inherits from the IUnknown interface.

С IUnknown в VBScript что-нибудь для решения задачи сделать возможно или этот интерфейс в среде VBScript недоступен?

5

Re: VBScript: IMAPI + IBurnVerification Interface

Да, недоступен. При создании объекта VBScript использует его IUnknown, чтобы подключиться к IDispatch, дальше вся работа идёт через последний. Если IDispatch отсутствует, объект в скрипте бесполезен.

6

Re: VBScript: IMAPI + IBurnVerification Interface

Печально - а счастье было так близко
Значит придётся придумывать альтернативные способы теста результатов записи (по md5 или даже побайтово сравнивать), по крайней мере пишущая часть скрипта работает и это уже хорошо.

Спасибо за ответы.

P.S. всегда остаётся надежда что в следующей версии IMAPI появится наконец возможность вызова проверки в скриптах...

7 (изменено: BeS Yara, 2010-02-23 14:27:06)

Re: VBScript: IMAPI + IBurnVerification Interface

"...мыши плакали, кололись, но продолжали есть кактус..."

Собственно что прояснилось за время прошедшее с последнего моего поста:
1. С Майкрософт ответили(подтвердив сказанное YMP):

Unfortunately the IBurnVerification interface cannot be used within a VB Script. The issue here is that IBurnVerification inherits from IUnknown, which is not compatible with OLE Automation.
Your feedback is appreciated. This information will be added to the IBurnVerification documentation in an upcoming release.

2. В МСДН статья по IBurnVerification Interface пополнилось очень интересной заметкой "Scripting languages limitation and workaround", самое приятное что следует из которой - во-первых, в дальнейших релизах ограничения будут сняты("This limitation will be fixed in next IMAPI release."), во-вторых, есть предложение как включить проверку сейчас - создать и зарегестрировать собственный COM(подробнее в самой заметке) и вызвать проверку через него. Что примечательно - в праздники как раз отладил проверялку результатов записи, когда обнаружил это обновление...

3. Перешел к тестированию на DVD, в результате чего выяснились некоторые особенности:
3.1. При использовании Пакет Windows Feature Pack for Storage 1.0 невозможно записать мультисессионный DVD с UDF (т.е. записывать файлы более 2Гб). Как вариант предлагается установка более старой версии IMAPI(link(отсутствует поддержка RW, BR, UDF только 1.02). Обещают что фикс будет в Vista SP2 и семёрке, а вот появится ли он для XP - это вопрос.
3.2. Видимо в связи с предыдущим пунктом на DVD+RW вторая сессия не пишется, но в отличии от +R-ки ошибка говорит от том что диск закрыт, хотя это и не так

В итоге имеется два варианта - первый это сделать COM и жать бэкапы не одним файлом а с ограничением на кусок(чтобы писать не в UDF). Второй - ждать фиксов и тем временем всё равно бить бэкапы на мелньшие куски и писать без UDF(и пользоваться самопальной проверкой результата записи).

P.S. Если это будет полезно, то могу позже приложить свой вариант проверки записи(сначала вычистить хочу от лишних выводов в консоль, и возможно приделать вывод в логфайл ). Алгоритм простой - сверяется список файлов в исходной папке и на оптическом диске. Если по списку и размеру всё сходится, делается сравнение файлов (чтение + StrComp).

8

Re: VBScript: IMAPI + IBurnVerification Interface

BeS Yara, конечно полезно и интересно.

OFF: я, оказывается, делал первый подход еще около года назад, загрузив и установив KB932716 (v2), но, то ли забыл, то ли не сумел… В общем, забыл и забросил; дело закончилось ничем. А тут, после Вашего первого сообщения в этой теме я заинтересовался, начал смотреть только что появившиеся примеры на MSDN, а, главное, попутно нашёл основное, что меня интересовало — быстрое и удобное программное создание ISO: Creating ISO files with vbscript possible???. Так что — конечно, выкладывайте, коллега!

9 (изменено: BeS Yara, 2010-02-25 14:29:58)

Re: VBScript: IMAPI + IBurnVerification Interface

Вот скрипт на проверку записи. Кода правда вышло несколько больше десятка строк, но функционала прикрепления файла я не наблюдаю(наверное прав маловато ), а на файлопомойку заливать смысла не вижу (~23k в чистом виде или ~6k в зипе).

Краткое описание: делает список содержимого двух папок, потом сверяет их размеры. Если всё сошлось, читает попарно файлы из обоих папок и сравнивает по содержимому (порция считываемая за раз настраивается - думаю не сильно ошибусь если скажу что число байт соответствует числу символов в ASCII). Результаты сравнения сводит в таблицу(можно экспортировать в файл с разделителем ";"). В зависимости от настроек, по результатам проверки чистит исходную папку от удачно записанных файлов(по умолчанию отключено).

Лог файлы перезаписываются(если нужно дописывать, просто надо поменять режим открытия ссответсвующего файла в функции check_params - дополнительные параметры под это вводить не стал).

Все настройки в начале файла до описания работы. Коментариев возможно многовато, но писал так чтобы потом сам мог вспомнить что здесь и как

' 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