' Загрузка/объединение конфигураций в автоматическом режиме
'   
'	Макросу "AutomaticMDUpdate" можно передать путь к новому файлу конфигурации
'
'	И он сначала пытается выполнить загрузку
'		если переданный файл подходит для загрузки, загружает его и сохраняет конфигурацию
'		если же нет, выполняет объединение конфигураций
'		при этом учитывает, если конфигурации идентичны, значит, загрузка успешна, иначе нет
'		объединение автоматом не выполняется, появляется только окно различий конфигураций, 
'		далее пользователь сам выбирает нужные действия
'
'	Пример вызова: ( в макросе "TestAutomaticMDUpdate")
'		bSuccessLoad = Scripts("ЗагрузкаОбъединениеМД").DoAutomaticMDUpdate(strNewMDPath, true) ' c объединением
'		bSuccessLoad = Scripts("ЗагрузкаОбъединениеМД").DoAutomaticMDUpdate(strNewMDPath, false) ' без объединения
'	в переменной bSuccessLoad Результат загрузки - true (успешна), false (нет или запустили ручное объединение)
'
'Версия: $Revision: 1.9 $ 
'
'Автор:
'	Артур Аюханов aka artbear
'

Function DoAutomaticMDUpdate(strMDPath, bUseMerge) ' основная функция 
	bDisableDebugMessages = true

	AutomaticMDUpdate strMDPath, bUseMerge
	DoAutomaticMDUpdate = IsSuccessMDUpdate
End Function
       
' выведу отладочные/вспомогательные сообщения
Function DoAutomaticMDUpdateWithDebugMessages(strMDPath, bUseMerge) ' основная функция 
	bDisableDebugMessages = false

	AutomaticMDUpdate strMDPath, bUseMerge
	DoAutomaticMDUpdateWithDebugMessages = IsSuccessMDUpdate
End Function

strLoadedMDPath = "" 

Dim strStep ' Начало, ЗагрузитьИзмененнуюКонфигурацию, ВыполнитьОбъединениеКонфигураций, сохранение, Конец 

Dim bUseAutomaticMDUpdate
Dim bSuccessLoadChanged
Dim bSuccessSaveMD

Dim bDisableDebugMessages ' true - запрещены отладочные сообщения, false - разрешены
bDisableDebugMessages = true ' по умолчанию запрещены

Private Sub Clear()
	bUseAutomaticMDUpdate = false
	bSuccessLoadChanged = true
	strLoadedMDPath = ""
	SetbSuccessSaveMD false, "Clear"
	
	strStep = "конец"
End Sub ' Clear

Private Sub SetbSuccessSaveMD(value, Place)
	bSuccessSaveMD = value
	
End Sub ' SetbSuccessSaveMD

Private Function IsSuccessMDUpdate()
	IsSuccessMDUpdate = false

	if bSuccessSaveMD and (UCase(strStep) = UCase("конец")) then
		IsSuccessMDUpdate = true
	end if                

End Function ' IsSuccessMDUpdate
	
Private Sub AutomaticMDUpdate(strMDPath, bUseMerge)
    
	CommonScripts.SetQuietMode bDisableDebugMessages
	Clear

	if CommonScripts.FSO.FileExists(strMDPath) then
		bUseAutomaticMDUpdate = true
		strLoadedMDPath = strMDPath
		strStep = "начало"
		CommonScripts.Debug "Состояние", strStep
	else
		CommonScripts.Error "Файл конфигурации не существует - " + strMDPath
		Exit Sub
	end if

	strStep = "ЗагрузитьИзмененнуюКонфигурацию"
	CommonScripts.Debug "Состояние", strStep
	CommonScripts.SendCommand cmdLoadMD ' жду исполнения
	
	if bSuccessLoadChanged then 
		if not MetaData.Modified then
			CommonScripts.Debug "Загрузка не удалась.", ""
			CommonScripts.Debug "Возможно, у вас открыто окно конфигурации и/или какой-то объект метаданных.", ""
		else
			' сразу выполнить сохранение данных

			' учесть, что база может быть занята !
			set ob = CreateObject("1S.IBState")
			CommonScripts.Debug "Статус базы", ob.StringIBState(strIBDir)
			
			iIBState = ob.IBState(strIBDir)
			'-1	-->>	"Выполнен некорректный выход из 1С, нужна переиндексация"
			'0	-->>	"В базе никого нет"
			if (iIBState > 0) then ' кто-то работает
				CommonScripts.Error "В базе кто-то работает, сохранение невозможно"
		        SetbSuccessSaveMD false, "AutomaticMDUpdate: Неудачное сохранение"
				Clear
				Exit Sub
			end if

			strStep = "сохранение"
			CommonScripts.Debug "Состояние", strStep
			
			CommonScripts.SendCommand cmdSave

			bMDUpdate = bSuccessSaveMD
			Clear
			
	        SetbSuccessSaveMD bMDUpdate, "AutomaticMDUpdate"
	
			Exit Sub
		end if
	end if

    if bUseMerge then
		strStep = "ВыполнитьОбъединениеКонфигураций"
		CommonScripts.Debug "Состояние", strStep
		CommonScripts.SendCommand cmdMergeMD ' посылаю
	end if

End Sub ' AutomaticMDUpdate

'Если при нажатии кнопки "Файл\Открыть" в клипборде хранится имя файла, то макрос предложит открыть этот файл
Sub Configurator_OnFileDialog(Saved, Caption, Filter, FileName, Answer)
                 
	if	(UCase(strStep) <> UCase("ЗагрузитьИзмененнуюКонфигурацию")) and _
		(UCase(strStep) <> UCase("ВыполнитьОбъединениеКонфигураций")) then 
		Clear
		Exit Sub
	end if
		
	if bUseAutomaticMDUpdate then
		CommonScripts.Debug "Событие OnFileDialog", strLoadedMDPath
		FileName  = strLoadedMDPath
		if	(UCase(strStep) = UCase("ВыполнитьОбъединениеКонфигураций")) then 
			Clear ' больше ничего делать не надо
		end if
		Answer = mbaOK
		Exit Sub
	end if

End Sub

Sub Configurator_OnMsgBox(text, style, def, Answer)

	strWrongMD = "Выбранный файл конфигурации не является потомком данного файла"
	strSaveMD = "При сохранении метаданных будет произведен анализ сделанных  изменений и,"	
	strEndSaveMD = "Реорганизация информации закончена!"
	strFailSaveMD = "Реорганизация данных не выполнена"
	strMDEq = "Конфигурации идентичны"

    if bUseAutomaticMDUpdate and (InStr(text, strWrongMD) > 0) then
		CommonScripts.Error strWrongMD
		CommonScripts.Error "Загрузка изменненной конфигурации невозможна, пробую объединение конфигураций"
		bSuccessLoadChanged = false
		
		Answer = mbaNo
		Exit Sub
	end if
	
    if bUseAutomaticMDUpdate and (InStr(text, strSaveMD) > 0) then
		if UCase(strStep) = UCase("сохранение") then
			CommonScripts.Debug "Событие OnMsgBox", strSaveMD
			Clear ' все успешно закончено

			Answer = mbaYes
			Exit Sub
		end if
	end if
	
    if InStr(text, strEndSaveMD) > 0 then
		CommonScripts.Debug "Событие OnMsgBox", strEndSaveMD
		Clear ' все успешно закончено
        SetbSuccessSaveMD true, strEndSaveMD

		Answer = mbaOK
		Exit Sub
	end if
	
    if InStr(text, strFailSaveMD) > 0 then
		CommonScripts.Error strFailSaveMD
		Clear

		Answer = mbaOK
		Exit Sub
	end if
	
    if InStr(text, strMDEq) > 0 then
		CommonScripts.Error strMDEq
		Clear
        SetbSuccessSaveMD true, strMDEq

		Answer = mbaOK
		Exit Sub
	end if
	
	Clear
	
	'CommonScripts.Debug "Событие OnMsgBox", text
	
End Sub

Sub Configurator_OnDoModal(hWnd, Caption, Answer)
	Exit Sub ' Если убираю эту строку, но оставляю событие, вызов макросов по Цтрл+М зависает
End Sub

Sub TestAutomaticMDUpdate() ' тест
	strLoadedMDPath1 = "W:\Дополнительные конфигурации\Разработка 1С++\Копия\1Cv7.MD" 
	
	b = DoAutomaticMDUpdate(strLoadedMDPath1, false) ' без объединения
	if b then
		Message "Успешно"
	else
		Message "НЕУCПЕХ"
    end if

End Sub ' TestAutomaticMDUpdate

Sub TestAutomaticMDUpdateWithMerge() ' тест
	strLoadedMDPath1 = "W:\Дополнительные конфигурации\Разработка 1С++\Копия\1Cv7.MD" 
	
	b = DoAutomaticMDUpdate(strLoadedMDPath1, true) ' с объединением
	if b then
		Message "Успешно"
	else
		Message "НЕУCПЕХ"
    end if

End Sub ' TestAutomaticMDUpdateWithMerge

Sub TestAutomaticMDUpdateWithDebugMessages() ' тест
	strLoadedMDPath1 = "W:\Дополнительные конфигурации\Разработка 1С++\Копия\1Cv7.MD" 
	
	b = DoAutomaticMDUpdateWithDebugMessages(strLoadedMDPath1, false) ' без объединения
	if b then
		Message "Успешно"
	else
		Message "НЕУCПЕХ"
    end if

End Sub ' TestAutomaticMDUpdate

Sub TestAutomaticMDUpdateWithMergeWithDebugMessages() ' тест
	strLoadedMDPath1 = "W:\Дополнительные конфигурации\Разработка 1С++\Копия\1Cv7.MD" 
	
	b = DoAutomaticMDUpdateWithDebugMessages(strLoadedMDPath1, true) ' с объединением
	if b then
		Message "Успешно"
	else
		Message "НЕУCПЕХ"
    end if

End Sub ' TestAutomaticMDUpdateWithMerge

'
' Процедура инициализации скрипта
'
Private Sub Init() ' Фиктивный параметр, чтобы процедура не попадала в макросы
	
    Set c = Nothing
    On Error Resume Next
    Set c = CreateObject("OpenConf.CommonServices")
    On Error GoTo 0
    If c Is Nothing Then
        Message "Не могу создать объект OpenConf.CommonServices", mRedErr
        Message "Скрипт " & SelfScript.Name & " не загружен", mInformation
        Scripts.UnLoad SelfScript.Name
		Exit Sub
    End If
    c.SetConfig(Configurator)
	  
	' ВНИМАНИЕ: следующие 2 строки обязательно в таком порядке, иначе не получается !
	
	' При загрузке скрипта инициализируем его
	c.AddPluginToScript SelfScript, "Телепат", "Telepat", Telepat
	
	SelfScript.AddNamedItem "CommonScripts", c, False
End Sub

Init
