Update archive fixer

VERSION

@@ -1 +1 @@
-1.2.4
+1.3.1

src/LinkFunctions.bas

@@ -3,11 +3,11 @@ Attribute VB_Name = "LinkFunctions"
 Option Explicit
 Option Private Module
 
-Public Function GetFullPath(ByVal addr$, docpath$) As String
+Public Function GetFullPath(ByVal addr$, docPath$) As String
 ' Ïðåîáðàçîâàíèå îòíîñèòåëüíûõ ïóòåé â àáñîëþòíûå
   If Left(addr, 1) = "." Or InStr(addr, "\") + InStr(addr, "/") = 0 Then
-    If Not docpath = vbNullString Then
+    If Not docPath = vbNullString Then
-      addr = docpath & "\" & addr
+      addr = docPath & "\" & addr
     Else
       GetFullPath = addr
       Exit Function
@@ -24,24 +24,6 @@ Public Function GetFullPath(ByVal addr$, docpath$) As String
   GetFullPath = Replace(addr, "/", "\")
 End Function
 
-Public Function ConvertLinkToLocal(ByVal addr$) As String
-' Ïðåîáðàçîâàíèå ññûëêè èç P:\ â \\STRG1\...
-  ConvertLinkToLocal = addr
-  If Left(addr, 3) Like "P:\" Then _
-    ConvertLinkToLocal = "\\STRG1\Projects\" & Right(addr, Len(addr) - 3)
-  If Left(addr, 3) Like "X:\" Then _
-    ConvertLinkToLocal = "\\Server\Exchange\" & Right(addr, Len(addr) - 3)
-End Function
-
-Public Function ConvertLinkToURL(ByVal addr$) As String
-' Ïðåîáðàçîâàíèå ññûëêè èç \\STRG1\... â P:\ è \\server\... â X:\
-  ConvertLinkToURL = addr
-  If Left(addr, 17) Like "\\[Ss][Tt][Rr][Gg]1\[Pp]rojects\" Then _
-    ConvertLinkToURL = "P:\" & Right(addr, Len(addr) - 17)
-  If Left(addr, 18) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Ee]xchange\" Then _
-    ConvertLinkToURL = "X:\" & Right(addr, Len(addr) - 18)
-End Function
-
 Public Function SafeGetHLinkAddress(hLink As Hyperlink) As String
 ' Îáðàáàòûâàåì êðèâûå ññûëêè è íå òîëüêî ñì. îøèáêà 4198
   On Error GoTo PICK_RANGE
@@ -51,10 +33,3 @@ Public Function SafeGetHLinkAddress(hLink As Hyperlink) As String
 PICK_RANGE:
   SafeGetHLinkAddress = hLink.Range.Text
 End Function
-
-Public Function IsSamePath(ByVal hLinkText$, ByVal hLinkAddress$, docpath$) As Boolean
-  IsSamePath = False
-  hLinkText = UCase(ConvertLinkToURL(GetFullPath(hLinkText, docpath)))
-  hLinkAddress = UCase(ConvertLinkToURL(GetFullPath(hLinkAddress, docpath)))
-  If InStr(hLinkText, hLinkAddress) = 1 And Abs(Len(hLinkText) - Len(hLinkAddress)) <= 1 Then IsSamePath = True
-End Function

src/LinkMappingUnit.cls

@@ -7,32 +7,27 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = False
 Attribute VB_Exposed = False
-' Ìîäóëü äëÿ ïðîâåðêè è êîððåêòèðîâêè ññûëîê
+' Fixing hyperlink to server
 Option Explicit
 
 Private m_ReplaceMap As Collection
 
 '---------- Public Interface ----------
-Public Function FixLink(ByRef adr$) As LMU_Return
+Public Function FixLink(ByRef adr$, Optional docPath$ = "") As LMU_Return
-' Ïðîâåðêà ññûëîê
   Dim testAdr$
-  If Not IsFSO(adr, "") Then
+  testAdr = FixPrefix(GetFullPath(adr, docPath))
+   If testAdr = "" Then
     FixLink = RV_NOTAFSO
     Exit Function
   End If
   
-  If IsValidAddress(adr) Then
+  If CheckFile(testAdr) Then
-    testAdr = ConvertLinkToURL(adr)
+    If testAdr <> adr Then
-    If CheckFile(testAdr, testAdr) Then
+      adr = testAdr
-      FixLink = RV_LINK_OK
-      Exit Function
-    End If
-  End If
-  
-  testAdr = SwapStrgServer(adr)
-  If CheckFile(testAdr, testAdr) Then
       FixLink = RV_LINK_FIXED
-    adr = ConvertLinkToLocal(testAdr)
+    Else
+      FixLink = RV_LINK_OK
+    End If
     Exit Function
   End If
   
@@ -41,13 +36,13 @@ Public Function FixLink(ByRef adr$) As LMU_Return
   Dim result$
   For j = 1 To m_ReplaceMap.Count
     Set rule = m_ReplaceMap.Item(j)
-    If InStr(adr, rule.repWhat) = 0 Then _
+    If InStr(1, testAdr, rule.repWhat, vbTextCompare) = 0 Then _
       GoTo NEXT_RULE
     
     For k = 1 To rule.repList.Count
       result = Replace(testAdr, rule.repWhat, rule.repList(k))
-      If CheckFile(result, "") Then
+      If CheckFile(result) Then
-        adr = ConvertLinkToLocal(result)
+        adr = result
         FixLink = RV_LINK_FIXED
         Exit Function
       End If
@@ -58,23 +53,50 @@ NEXT_RULE:
   FixLink = RV_LINK_NOFIX
 End Function
 
-'---------- Event handlers and misc code ----------
+'---------- Internals ----------
+Private Function CheckFile(ByVal addr$) As Boolean
+  On Error Resume Next
+  CheckFile = Len(Dir(addr)) <> 0 Or Len(Dir(addr, vbDirectory)) <> 0
+End Function
+
 Private Sub Class_Initialize()
   Set m_ReplaceMap = New Collection
   Dim rule As LMUItem
+    
+  Set rule = New LMUItem
+  rule.repWhat = "! àðõèâ\Income"
+  rule.repList.Add ("00 Àðõèâ\01 Èíêàì")
+  Call m_ReplaceMap.Add(rule)
+  
+  Set rule = New LMUItem
+  rule.repWhat = "! àðõèâ\Outcome"
+  rule.repList.Add ("00 Àðõèâ\02 Àóòêàì")
+  Call m_ReplaceMap.Add(rule)
+  
+  Set rule = New LMUItem
+  rule.repWhat = "01 Income-ïðîåêòû\àðõèâèðîâàòü"
+  rule.repList.Add ("! àðõèâ\Income")
+  rule.repList.Add ("00 Àðõèâ\01 Èíêàì")
+  Call m_ReplaceMap.Add(rule)
+  
   Set rule = New LMUItem
   rule.repWhat = "01 Income-ïðîåêòû"
+  rule.repList.Add ("! àðõèâ\Income")
   rule.repList.Add ("00 Àðõèâ\01 Èíêàì")
   Call m_ReplaceMap.Add(rule)
   
   Set rule = New LMUItem
   rule.repWhat = "02 Outcome-ïðîåêòû"
+  rule.repList.Add ("! àðõèâ\Outcome")
   rule.repList.Add ("00 Àðõèâ\02 Àóòêàì")
   Call m_ReplaceMap.Add(rule)
   
   Set rule = New LMUItem
   rule.repWhat = "03 Ïåðåãîâîðû Àêòèâíûå"
   rule.repList.Add ("00 Àðõèâ\03 Ïåðåãîâîðû")
+  rule.repList.Add ("! àðõèâ\Ïåðåãîâîðû")
+  rule.repList.Add ("! àðõèâ\Income")
+  rule.repList.Add ("00 Àðõèâ\01 Èíêàì")
   rule.repList.Add ("01 Income-ïðîåêòû")
   rule.repList.Add ("02 Outcome-ïðîåêòû")
   Call m_ReplaceMap.Add(rule)
@@ -91,38 +113,41 @@ Private Sub Class_Initialize()
   Call m_ReplaceMap.Add(rule)
 End Sub
 
-Private Function IsValidAddress(ByVal addr$) As Boolean
+Private Function FixPrefix(addr$) As String
-  IsValidAddress = True
+  FixPrefix = ""
-  If Left(addr, Len("\\server\Projects")) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Pp]rojects" Then IsValidAddress = False
+  Dim prefixLen&
-  If Left(addr, Len("\\strg1\Exchange")) Like "\\[Ss][Tt][Rr][Gg]1\[Ee]xchange" Then IsValidAddress = False
+  
+  prefixLen = Len("P:\")
+  If Len(addr) < prefixLen Then Exit Function
+  If Left(addr, prefixLen) Like "[Pp]:\" Or Left(addr, prefixLen) Like "[Qq]:\" Then
+    FixPrefix = "\\fs1.concept.ru\projects\" + Right(addr, Len(addr) - prefixLen)
+    Exit Function
+  End If
+  If Left(addr, prefixLen) Like "[Xx]:\" Or Left(addr, prefixLen) Like "[Ww]:\" Then
+    FixPrefix = "\\fs1.concept.ru\exchange\" + Right(addr, Len(addr) - prefixLen)
+    Exit Function
+  End If
+  
+  prefixLen = Len("\\strg1\")
+  If Len(addr) < prefixLen Then Exit Function
+  If LCase(Left(addr, prefixLen)) Like "\\strg1\" Then
+    FixPrefix = "\\fs1.concept.ru\" + Right(addr, Len(addr) - prefixLen)
+    Exit Function
+  End If
+  
+  prefixLen = Len("\\server\")
+  If Len(addr) < prefixLen Then Exit Function
+  If LCase(Left(addr, prefixLen)) = "\\server\" Then
+    FixPrefix = "\\fs1.concept.ru\" + Right(addr, Len(addr) - prefixLen)
+    Exit Function
+  End If
+  
+  prefixLen = Len("\\fs1.concept.ru\")
+  If Len(addr) < prefixLen Then Exit Function
+  If LCase(Left(addr, prefixLen)) = "\\fs1.concept.ru\" Then
+    FixPrefix = addr
+    Exit Function
+  End If
 End Function
 
-Private Function IsFSO(addr$, docpath$) As Boolean
-'Ïðîâåðêà ëîêàëüíûõ ññûëîê
-  addr = GetFullPath(addr, docpath)
-  If Left(addr, 3) Like "[PpXx]:\" Then IsFSO = True: Exit Function
-  If Left(addr, 16) Like "\\[Ss][Tt][Rr][Gg]1\[Pp]rojects" Then IsFSO = True: Exit Function
-  If Left(addr, 16) Like "\\[Ss][Tt][Rr][Gg]1\[Ee]xchange" Then IsFSO = True: Exit Function
-  If Left(addr, 17) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Ee]xchange" Then IsFSO = True: Exit Function
-  If Left(addr, 17) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Pp]rojects" Then IsFSO = True: Exit Function
-  
-  IsFSO = False
-End Function
-
-Private Function CheckFile(ByVal addr$, currentPath$) As Boolean
-' Ïðîâåðêà ñóùåñòâîâàíèÿ ôàéëà
-  If Left(addr, 1) = "." Or InStr(addr, "\") + InStr(addr, "/") = 0 Then _
-    addr = currentPath & "\" & addr
-  
-  On Error Resume Next
-  CheckFile = Len(Dir(addr)) <> 0 Or Len(Dir(addr, vbDirectory)) <> 0
-End Function
-
-Private Function SwapStrgServer(ByVal addr$)
-  SwapStrgServer = addr
-  If Left(addr, Len("\\server\Projects")) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Pp]rojects" Then _
-    SwapStrgServer = "P:\" + Right(addr, Len(addr) - Len("\\server\Projects\"))
-  If Left(addr, Len("\\strg1\Exchange")) Like "\\[Ss][Tt][Rr][Gg]1\[Ee]xchange" Then _
-    SwapStrgServer = "X:\" + Right(addr, Len(addr) - Len("\\strg1\Exchange\"))
-End Function
 

src/Main.bas

@@ -73,7 +73,7 @@ Public Sub CC_Convert1252_1251()
   Dim wordUI As New API_WordWrapper: Call wordUI.SetDocument(theDoc)
   Call wordUI.PauseUI
   
-  Call CSE_ProgressBar.Init("Êîððåêòèðîâêà êîäèðîâêè 1252 -> 1251", sHeader:="Îáðàáîòêà ñèìâîëîâ...", maxVal:=inputR.Characters.Count)
+  Call CSE_ProgressBar.Init("Converting encoding 1252 -> 1251", sHeader:="Processing...", maxVal:=inputR.Characters.Count)
   Call CSE_ProgressBar.ShowModeless
 
   Dim aChr As Word.Range: Set aChr = inputR.Characters.First
@@ -340,13 +340,13 @@ Private Function ExecuteAllRules(iDoc As Word.Document, Optional bApplyFix As Bo
   
   Call iGuard.BeginEdit(iConfig.GetValue("TrackRevisions"))
   
-  Call CSE_ProgressBar.Init("Àâòîìàòèçèðîâàííàÿ ñèñòåìà òåñòèðîâàíèÿ", sHeader:="Âûïîëíÿåòñÿ ïðîâåðêà, ïîäîæäèòå...", maxVal:=iProcessor.RuleCount, canInterrupt:=True)
+  Call CSE_ProgressBar.Init("Testing system", sHeader:="Processing, please wait...", maxVal:=iProcessor.RuleCount, canInterrupt:=True)
   Call CSE_ProgressBar.ShowModeless
   
   Call iProcessor.RunAll(CollectionToDictionary(iConfig.GetValue("ExcludeRules")), bApplyFix)
   
   Dim nMilliseconds&: nMilliseconds = Int(CSE_ProgressBar.Time)
-  CSE_ProgressBar.Description = "Ðàññòàíîâêà êîììåíòàðèåâ"
+  CSE_ProgressBar.Description = "Creating comments"
   Call iGuard.EndEdit
   
   Call Unload(CSE_ProgressBar)

src/MainImpl.bas

@@ -58,7 +58,7 @@ End Function
 Public Function FixHyperlinksIn(target As Word.Range) As LMU_LinksInfo
   FixHyperlinksIn.lnkCount_ = target.Hyperlinks.Count
 
-  Call CSE_ProgressBar.Init("Ïðåîáðàçîâàíèå ãèïåðññûëîê", sHeader:="Îáðàáîòêà...", _
+  Call CSE_ProgressBar.Init("Hyperlinks conversion", sHeader:="Processing...", _
                               maxVal:=FixHyperlinksIn.lnkCount_)
   Call CSE_ProgressBar.ShowModeless
   
@@ -67,11 +67,11 @@ Public Function FixHyperlinksIn(target As Word.Range) As LMU_LinksInfo
   
   Dim aLink As Hyperlink
   For Each aLink In target.Hyperlinks
-    Dim linkAdr$: linkAdr = GetFullPath(SafeGetHLinkAddress(aLink), target.Document.Path)
+    Dim linkAdr$: linkAdr = SafeGetHLinkAddress(aLink)
     If linkAdr = vbNullString Then _
       GoTo NEXT_LINK
     
-    Select Case LinkCheckResult(linkAdr)
+    Select Case LinkCheckResult(linkAdr, target.Document.Path)
     Case RV_LINK_FIXED:
       FixHyperlinksIn.modCount_ = FixHyperlinksIn.modCount_ + 1
       Dim linkRange As Word.Range: Set linkRange = aLink.Range
@@ -80,13 +80,8 @@ Public Function FixHyperlinksIn(target As Word.Range) As LMU_LinksInfo
       If linkRange.HighlightColorIndex = wdTurquoise Then _
         linkRange.HighlightColorIndex = wdAuto
       
-      If IsSamePath(linkRange.Text, SafeGetHLinkAddress(aLink), target.Document.Path) Then
+      If StrComp(linkRange.Text, SafeGetHLinkAddress(aLink)) Then _
-        If Left(linkRange.Text, 2) = "\\" Then
+        linkRange.Text = linkAdr
-          linkRange.Text = ConvertLinkToLocal(linkAdr)
-        Else
-          linkRange.Text = ConvertLinkToURL(linkAdr)
-        End If
-      End If
       
       linkRange.Text = linkRange.Text
       Call ActiveDocument.Hyperlinks.Add(linkRange, linkAdr)
@@ -226,13 +221,10 @@ RETURN_FALSE:
 End Function
 
 ' =============
-Private Function LinkCheckResult(ByRef rawLnk$) As LMU_Return
+Private Function LinkCheckResult(ByRef rawLnk$, docPath$) As LMU_Return
 'Ñîñòîÿíèå ññûëîê (ñ ïîäìåíîé ñòðîêîâîé ïåðåìåííîé)
   Dim rulemap As LinkMappingUnit: Set rulemap = GetLMU
-  Dim sResult$: sResult = rawLnk
+  LinkCheckResult = rulemap.FixLink(rawLnk, docPath)
-  LinkCheckResult = rulemap.FixLink(sResult)
-  If LinkCheckResult = RV_LINK_FIXED Then _
-    rawLnk = sResult
 End Function
 
 Private Function TryProcessAddin(sLocal$, sServer$) As Boolean