Attribute VB_Name = "MainImpl"
Option Private Module
Option Explicit

Public Function Output2Excel(outWB As Excel.Workbook, theDB As InfoDatabase)
  Dim exporter As New ActiveStateExporter: Call exporter.Init(outWB, theDB)
  
  Dim lawIDs As New Scripting.Dictionary
  Set lawIDs = exporter.ExportLaws()
  
  Call CSE_ProgressBar.InitSecondBar(maxVal:=theDB.CountLinks)
  CSE_ProgressBar.Description = "Список связей"
  
  Call exporter.ExportLinks(lawIDs)
End Function

Public Function UpdateHyperlinks(target As Excel.Worksheet, theDB As InfoDatabase)
  Dim nRow&: nRow = HT03_DEFAULT_FIRST_LINE
  Do While target.Cells(nRow, 1) <> vbNullString
    Dim aCell As Excel.Range: Set aCell = target.Cells(nRow, LawStruct.S_D_FILENAME)
    Dim sFileName$: sFileName = aCell
    
    Call aCell.Hyperlinks.Delete
    If sFileName <> vbNullString And sFileName <> HT03_FILE_NOT_LOADED Then _
      Call aCell.Hyperlinks.Add(aCell, theDB.DocumentsRelativePath & sFileName)
    
    nRow = nRow + 1
  Loop
End Function

Public Function UpdateStats(theDB As InfoDatabase)
  Dim outerDocs As New Collection
  
  Dim countDoc&, countLnk&, lnkTotal&, lnkProc&, lnkDeclined&
  Dim lnkDeclinedIn&, lnkDefin&, lnkFound&, lnkAspekt&, lnkNotProcIn&
  
  Dim iLaw As IteratorLaw: Set iLaw = theDB.Laws
  Do While Not iLaw.IsDone
    lnkTotal = 0: lnkDeclined = 0: lnkDefin = 0: lnkAspekt = 0
    lnkProc = 0: lnkDeclinedIn = 0: lnkFound = 0: lnkNotProcIn = 0
    
    If iLaw.Status = T_LAWS_IGNORE Then
      Call SafeAddToCollection(VBA.CStr(iLaw.ID), VBA.CStr(iLaw.ID), outerDocs)
      GoTo NEXT_DOC
    End If
    
    Dim iLink As IteratorLinkLaw: Set iLink = iLaw.Links
    If iLink Is Nothing Then _
      GoTo NEXT_DOC
      
    Do While iLink.Increment
      lnkTotal = lnkTotal + 1
      If Not theDB.Contains(iLink.DestinationID) Then
        Call SafeAddToCollection(VBA.CStr(iLink.DestinationID), VBA.CStr(iLink.DestinationID), outerDocs)
        If iLink.IsProcessed Then
          lnkProc = lnkProc + 1
          lnkDeclined = lnkDeclined + 1
        End If
      Else
        Dim isInner As Boolean: isInner = theDB.GetLawStatus(iLink.DestinationID) = T_LAWS_IGNORE
        If Not iLink.IsProcessed Then
           If isInner Then lnkNotProcIn = lnkNotProcIn + 1
        Else
          lnkProc = lnkProc + 1
          If Not iLink.IsActive Then
            lnkDeclined = lnkDeclined + 1
            If isInner Then lnkDeclinedIn = lnkDeclinedIn + 1
          Else
            If iLink.LType = T_LINK_ASPECT Then lnkAspekt = lnkAspekt + 1
            If iLink.LType = T_LINK_DEFINITION Then lnkDefin = lnkDefin + 1
            If iLink.LType = T_LINK_FOUNDATION Then lnkFound = lnkFound + 1
          End If
        End If
      End If
NEXT_LINK:
    Loop
NEXT_DOC:
    With iLaw
      Call .SetVaueIn(S_LS_LINKS_TOTAL, lnkTotal)
      Call .SetVaueIn(S_LS_LINKS_TODO, lnkTotal - lnkProc)
      Call .SetVaueIn(S_LS_LINKS_TODOIN, lnkNotProcIn)
      Call .SetVaueIn(S_LS_LINKS_DECL, lnkDeclined)
      Call .SetVaueIn(S_LS_LINKS_DECLIN, lnkDeclinedIn)
      Call .SetVaueIn(S_LS_LINKS_ASPECT, lnkAspekt)
      Call .SetVaueIn(S_LS_LINKS_FOUND, lnkFound)
      Call .SetVaueIn(S_LS_LINKS_DEFIN, lnkDefin)
      Call .Increment
    End With
    Call CSE_ProgressBar.IncrementA
    CSE_ProgressBar.Description = iLaw.Title
  Loop
  
  ThisWorkbook.Names(CELL_STAT_BASE).RefersToRange = outerDocs.Count
  Call ThisWorkbook.Sheets(HT03_SHT_STATS).Calculate
End Function

Public Function OpenUnresolvedDocument(sFileName$) As Boolean
  OpenUnresolvedDocument = False
  
  Dim wordAppl As New API_WordWrapper
  If wordAppl.OpenDocument(GetDocumentsLocation(ThisWorkbook) & "\" & sFileName) Is Nothing Then _
    Exit Function
  
  Call wordAppl.Document.Activate
  wordAppl.Application.WindowState = xlMaximized
  Call wordAppl.Run("HT03_UpdateMarkup")
  Call wordAppl.Run("HT03_NextLink")
  
  Call AppActivate(wordAppl.Application.Caption)
  
  OpenUnresolvedDocument = True
End Function

Public Function PromptNewFileName(target&, theDB As InfoDatabase) As String
   Dim docData As IteratorLaw: Set docData = theDB.Data(target)
  Dim oldName$: oldName = docData.FileName
  If oldName = HT03_FILE_NOT_LOADED Then
    Call UserInteraction.ShowMessage(EM_RENAME_UNLOADED)
    Exit Function
  End If
  
  oldName = VBA.Left(oldName, VBA.Len(oldName) - VBA.Len(HT03_DOC_EXTENSION))
  Dim newName$: newName = UserInteraction.PromptInput("Введетие имя файла (80 символов)", "Имя файла", oldName)
  If newName = vbNullString Or newName = oldName Then _
    Exit Function
    
  newName = SafeFileName(VBA.Trim(VBA.Left(newName, 80))) & HT03_DOC_EXTENSION
  Dim theCopy As IteratorLaw: Set theCopy = theDB.FindByFileName(newName)
  If Not theCopy Is Nothing Then
    Call UserInteraction.ShowMessage(EM_NAME_TAKEN, theCopy.ID)
    Exit Function
  End If
  
  PromptNewFileName = newName
End Function

Public Function CreateDummyFor(target&) As Boolean
  CreateDummyFor = False
  
  Dim theDB As InfoDatabase: Set theDB = AccessDatabase
  If Not theDB.Contains(target) Then
    Call UserInteraction.ShowMessage(EM_MISSING_ID)
    Exit Function
  End If
  
  Dim iLaw As IteratorLaw: Set iLaw = theDB.Data(target)
  If iLaw.HasFile Then
    Call UserInteraction.ShowMessage(EM_DUMMY_HAS_FILE)
    Exit Function
  End If
  
  Dim iData As ItemLaw: Set iData = iLaw.Data
  iData.fileName_ = theDB.GenerateFileName(iData.title_)
  Call AddDummyDocument(iData, theDB.docsLocation_)
  Call theDB.SetItem(iData)
  
  Dim sLinks() As String: ReDim sLinks(1 To 1, LinkTransferStruct.[_First] To LinkTransferStruct.[_Last])
  sLinks(1, S_TL_DESTINATION_ID) = CStr(target)
  sLinks(1, S_TL_DESTINATION_SUB) = "sub_0"
  sLinks(1, S_TL_SOURCE_SUB) = "sub_0"
  Call theDB.SetLinksFor(target, sLinks)
  
  CreateDummyFor = True
End Function

Public Function DeleteLaw(targetID&)
  Dim removedCount&: removedCount = RemoveLinksFor(targetID)
  Dim sFile$: sFile = RemoveIDFromDocs(targetID)
  If sFile <> "" Then _
    Call KillDocument(sFile)
  If removedCount <> 0 Then _
    Call AccessDatabase.ValidateLinks
End Function

Public Function DeleteLinks(targetID&) As Long
  DeleteLinks = RemoveLinksFor(targetID)
  If DeleteLinks <> 0 Then _
    Call AccessDatabase.ValidateLinks
End Function

Public Function PromptMerge(theDB As InfoDatabase) As ItemMerge
  With MergeLawsDlg
    Call .Init(theDB)
    Call .Show
    If .isCancelled_ Then _
      Exit Function
    Set PromptMerge = .GetMerge
  End With
  Call Unload(MergeLawsDlg)
End Function

Public Function ExecuteMerge(iMerge As ItemMerge)
  Dim theDB As InfoDatabase: Set theDB = AccessDatabase
  Dim sTitle$: sTitle = theDB.Data(iMerge.substitute_).Title
  
  Dim iWord As New API_WordWrapper: Call iWord.CreateApplication(bIsVisible:=True)
  Dim iLaw As IteratorLaw: Set iLaw = theDB.Laws
  Do While Not iLaw.IsDone
    Dim iLink As IteratorLinkLaw: Set iLink = theDB.LawLinks(iLaw.ID)
    If iLink Is Nothing Then _
      GoTo NEXT_LAW
    
    Do While iLink.Increment
      If iLink.DestinationID = iMerge.delete_ Then
        If Not iWord.OpenDocument(theDB.docsLocation_ & "\" & iLaw.FileName) Is Nothing Then
          Call iWord.Document.Activate
          Call iWord.Run("HT03_MergeID", iMerge.delete_, iMerge.substitute_, sTitle)
          Call iWord.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=True)
        End If
        GoTo NEXT_LAW
      End If
    Loop
    
NEXT_LAW:
    Call CSE_ProgressBar.IncrementA
    Call iLaw.Increment
  Loop
  
  Call iWord.ReleaseApplication
  Call SubstituteLinks(iMerge.delete_, iMerge.substitute_)
End Function

' ========
Private Function KillDocument(targetFile$)
  If targetFile = vbNullString Then _
    Exit Function
  Dim fso As New Scripting.FileSystemObject
  If fso.FileExists(targetFile) Then
    Call Kill(targetFile)
  End If
End Function
