private function GetSelectedDocuments
  LRN = ""
  for I = 0 to GetDocumentCount - 1
    LRN = LRN & GetDocument(I) & ", "
  next
  LRN = Left(LRN, Len(LRN) - Len(", "))
  GetSelectedDocuments = LRN
end function

private function GetOptionStrValue(Name)
  StoredProc.StoredProcName = "P_OPTIONS_GET_VALUES"
  StoredProc.ParamByName("sCODE").Value = Name
  StoredProc.ParamByName("nCOMPANY").Value = COMPANY
  StoredProc.ExecProc
  GetOptionStrValue = StoredProc.ParamByName("sSTR_VALUE").Value

  if IsNull(GetOptionStrValue) then
    GetOptionStrValue = ""
  end if
end function

private function GetSchemaName(ByRef SchemaName, Caption)
  SchemaName = GetOptionStrValue("WebServerSchemaName")
  GetSchemaName = Len(SchemaName) > 0
  if not GetSchemaName then
    MsgBox "Не задано значение параметра """ & "Служебная схема базы данных для работы сервера приложений" & """.", vbSystemModal or vbCritical, Caption
  end if
end function

private function LoadConvertedDataTypes(SchemaName)
  set DataTypes = CreateObject("Scripting.Dictionary")
  
  Query.SQL.Text = _
    "select ""ID"", ""Name"" from " & SchemaName & ".""TEnumerationItem$Properties"" where ""Master$N"" = 'TParusConvertedDataType'"
  Query.Open
  while not Query.Eof
    DataTypes.Add Query.FieldByName("Name").Value, Query.FieldByName("ID").Value
    Query.Next
  wend
  
  set LoadConvertedDataTypes = DataTypes
end function

private function GetFilterByDateClause(FromDate, ToDate)
  S = ""
  if not IsNull(FromDate) then
    S = S & "   and R.DBEGDATE >= :FromDate" & vbNewLine
  end if
  if not IsNull(ToDate) then
    S = S & "   and R.DENDDATE >= :ToDate" & vbNewLine
  end if
  
  GetFilterByDateClause = S
end function

private sub InternalConvertObjects(Query, FieldName, SchemaName, IsTemplates, IsHelpModules, IsFontsData)
  set LFileSystem = CreateObject("Scripting.FileSystemObject")
  set Converter = CreateObject("ParusConverterToDataBaseCache.DataBaseCacheConverter")
  'Converter.UseMillOfficeExcel = True 'по умолчанию определяется по наличию MS Excel на хосте
  
  if IsFontsData then
    Converter.CreateFontsData
  else
    while not Query.Eof
      SourceFile = Converter.CreateTempFileName
      Query.FieldByName(FieldName).SaveToFile SourceFile
      
      if IsTemplates then
        Converter.StoreTemplateFile SourceFile
      elseif IsHelpModules then
        Converter.StoreHelpFile SourceFile
      end if

      Query.Next
    wend
  end if

  set DataTypes = LoadConvertedDataTypes(SchemaName)
  
  while not Converter.Done
    IsAcquired = Converter.Acquire(CRC, FileName, DataTypeName, Position)

    if IsAcquired then
      DataType = DataTypes.Item(DataTypeName)
      
      Query.SQL.Text = _
        "declare" & vbNewLine &_
        "  Result number;" & vbNewLine &_
        "begin" & vbNewLine &_
        "  " & SchemaName & ".""TParusConverted$Add""(:ACRC, :ADataType, :AData, :ADataCRC, :APosition, Result);" & vbNewLine &_
        "end;"

      if IsNull(Position) then
        Query.ParamByName("ACRC").Value = CRC
        Query.ParamByName("ADataCRC").Value = Converter.FileCRC(FileName)
      else
        Query.ParamByName("ACRC").Value = "00000000"
        Query.ParamByName("ADataCRC").Value = CRC
      end if

      Query.ParamByName("ADataType").Value = DataType
      Query.ParamByName("AData").LoadFromFile FileName, ftOraBlob
      Query.ParamByName("APosition").Value = Position
      Query.Execute
      
      LFileSystem.DeleteFile FileName
    end if
  wend
  
  set Converter = Nothing
end sub

private sub ConvertObjects(Query, IsTemplates, IsHelpModules, IsFontsData, Caption)
  if IsTemplates then
    LFieldName = "BXLS"
  elseif IsHelpModules then
    LFieldName = "MODULE"
  elseif IsFontsData then
    LFieldName = ""
  else
    MsgBox "Не указан тип конвертации.", vbSystemModal or vbInformation, Caption
    exit sub
  end if
  
  if not GetSchemaName(SchemaName, Caption) then exit sub
  
  On Error Resume Next
    Err.Clear
    
    InternalConvertObjects Query, LFieldName, SchemaName, IsTemplates, IsHelpModules, IsFontsData
    
    if Err.Number <> 0 then
      MsgBox Err.Description, vbSystemModal or vbCritical, Caption
      exit sub
    end if
  On Error Goto 0

  MsgBox "Конвертация успешно завершена." & vbNewLine &_
    "Чтобы начать использовать сконвертированные объекты необходимо перезапустить сервис сервера приложений.",_
    vbSystemModal or vbInformation, Caption
end sub

private sub ConvertTemplates(Query)
  ConvertObjects Query, True, False, False, "Конвертация трафарета"
end sub

sub ConvertSelectedTemplates
  Query.SQL.Text = _
    "select BXLS from V_BLRPFRMTEMPLATES" & vbNewLine &_
    " where NVERSION = :VERSION" & vbNewLine &_
    "   and NRN in (" & GetSelectedDocuments & ")" & vbNewLine &_
    "   and dbms_lob.getlength(BXLS) > 0"
  Query.ParamByName("VERSION").Value = VERSION
  Query.Open
  if Query.Eof then
    MsgBox "Не найдены шаблоны выбранных трафаретов.", vbSystemModal or vbInformation, "Конвертация трафарета"
    exit sub
  end if
  
  ConvertTemplates Query
end sub

sub ConvertTemplatesOfSelectedRedactions
  Query.SQL.Text = _
    "select BXLS from V_BLRPFRMTEMPLATES" & vbNewLine &_
    " where NVERSION = :VERSION" & vbNewLine &_
    "   and NPRN in (" & GetSelectedDocuments & ")" & vbNewLine &_
    "   and dbms_lob.getlength(BXLS) > 0"
  Query.ParamByName("VERSION").Value = VERSION
  Query.Open
  if Query.Eof then
    MsgBox "Не найдены шаблоны трафаретов выбранных редакций.", vbSystemModal or vbInformation, "Конвертация трафарета"
    exit sub
  end if
  
  ConvertTemplates Query
end sub

sub ConvertTemplatesOfSelectedForm
  FromDate = GetParamValue("FromDate")
  ToDate = GetParamValue("ToDate")

  Query.SQL.Text = _
    "select T.BXLS" & vbNewLine &_
    "  from V_BLRPFRMTEMPLATES T inner join V_BLREPFORMED R" & vbNewLine &_
    "    on T.NPRN = R.NRN" & vbNewLine &_
    " where T.NVERSION = :VERSION" & vbNewLine &_
    "   and R.NPRN in (" & GetSelectedDocuments & ")" & vbNewLine &_
    GetFilterByDateClause(FromDate, ToDate) &_
    "   and dbms_lob.getlength(T.BXLS) > 0"

  Query.ParamByName("VERSION").Value = VERSION
  if not IsNull(FromDate) then
    Query.ParamByName("FromDate").Value = FromDate
  end if
  if not IsNull(ToDate) then
    Query.ParamByName("ToDate").Value = ToDate
  end if
  
  Query.Open
  if Query.Eof then
    MsgBox "Не найдены шаблоны трафаретов выбранных форм.", vbSystemModal or vbInformation, "Конвертация трафарета"
    exit sub
  end if
  
  ConvertTemplates Query
end sub

sub ConvertHelpModules
  Query.SQL.Text = "select MODULE from MODULES where MODULE_TYPE = 2"
  Query.Open
  if Query.Eof then
    MsgBox "Не найдены модули справочной системы.", vbSystemModal or vbInformation, "Конвертация модулей справочной системы"
    exit sub
  end if
  
  ConvertObjects Query, False, True, False, "Конвертация модулей справочной системы"
end sub

sub CreateFontsData
  ConvertObjects Query, False, False, True, "Конвертация данных шрифтов"
end sub

sub SaveFontsDataToFile
  Caption = "Сохранение данных шрифтов в файл"
  if not GetSchemaName(SchemaName, Caption) then exit sub

  Query.SQL.Text = _
    "select ""CRC"", max(""Position"") as Position from " & SchemaName & ".""TParusConvertedData$Prope028C""" & vbNewLine &_
    " where ""DataType$N"" = 'cdFontsData'" & vbNewLine &_
    "   and ""ObjectCRC"" = '00000000'" & vbNewLine &_
    " group by ""CRC"""
  Query.Open
  if Query.Eof then
    MsgBox "Сконвертированные данные шрифтов отсутствуют.", vbSystemModal or vbInformation, Caption
    exit sub
  end if

  set LFileSystem = CreateObject("Scripting.FileSystemObject")
  set LProvider = CreateObject("ParusAppServerProvider.Provider")
  set LData = LProvider.CreateBinaryData

  LDataCRC = Query.FieldByName("CRC").Value
  LMaxPosition = Query.FieldByName("Position").Value
  LProvider.DebugString "Контрольная сумма сконвертированных данных: " & LDataCRC & ", количество частей: " & LMaxPosition

  LTargetFileName = GetParamValue("FileName")
  LTempFileName = LProvider.CreateTempFileName(".bin")

  for I = 1 to LMaxPosition
    Query.SQL.Text = _
      "select ""Data"", ""CRC"" from " & SchemaName & ".""TParusConvertedData$Prope028C""" & vbNewLine &_
      " where ""DataType$N"" = 'cdFontsData'" & vbNewLine &_
      "   and ""ObjectCRC"" = '00000000'" & vbNewLine &_
      "   and ""Position"" = " & I
    Query.Open
    if Query.Eof then
      MsgBox "Не найден кусок данных сконвертированных шрифтов с номером " & I, vbSystemModal or vbCritical, Caption
      exit sub
    end if

    LProvider.DebugString I & ": " & Query.FieldByName("CRC").Value

    if LFileSystem.FileExists(LTempFileName) then
      LFileSystem.DeleteFile LTempFileName
    end if
    Query.FieldByName("Data").SaveToFile LTempFileName
    LData.Append LTempFileName

    Query.Next
    if not Query.Eof then
      MsgBox "Найдено несколько кусков данных сконвертированных шрифтов с номером " & I & ". Целостность данных сконвертированных шрифтов нарушена, обратитесь к разработчику.", vbSystemModal or vbCritical, Caption
      exit sub
    end if
  next
  LData.Save LTargetFileName

  MsgBox "Данные сконвертированных шрифтов успешно сохранены в указанный файл.", vbSystemModal or vbInformation, Caption

  LFileSystem.DeleteFile LTempFileName
  set LData = Nothing
  set LProvider = Nothing
end sub

sub ClearConvertedData
  if MsgBox("Все сконвертированные объекты будут удалены. Продолжить?", vbSystemModal or vbQuestion or vbOKCancel or vbDefaultButton2, "Конвертация объектов") = vbOK then
    if not GetSchemaName(SchemaName, "Конвертация объектов") then exit sub
    
    Query.SQL.Text = _
      "begin" & vbNewLine &_
      "  " & SchemaName & ".""TParusConverted$Clear"";" & vbNewLine &_
      "end;"
    Query.Execute

    MsgBox "Все сконвертированные объекты успешно удалены.", vbSystemModal or vbInformation, "Конвертация объектов"
  end if
end sub