diff --git a/VERSION b/VERSION index e8ea05d..3a3cd8c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.2.4 +1.3.1 diff --git a/src/LinkFunctions.bas b/src/LinkFunctions.bas index de2bea7..ed2385e 100644 --- a/src/LinkFunctions.bas +++ b/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 - addr = docpath & "\" & addr + If Not docPath = vbNullString Then + 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 diff --git a/src/LinkMappingUnit.cls b/src/LinkMappingUnit.cls index 762ab2a..6b26c9b 100644 --- a/src/LinkMappingUnit.cls +++ b/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 - testAdr = ConvertLinkToURL(adr) - If CheckFile(testAdr, testAdr) Then + If CheckFile(testAdr) Then + If testAdr <> adr Then + adr = testAdr + FixLink = RV_LINK_FIXED + Else 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) 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 - adr = ConvertLinkToLocal(result) + If CheckFile(result) Then + adr = result FixLink = RV_LINK_FIXED Exit Function End If @@ -58,29 +53,56 @@ 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) Set rule = New LMUItem - rule.repWhat = "031 Переговоры возможные" + rule.repWhat = "03 1 Переговоры возможные" rule.repList.Add ("00 Архив\03 Переговоры") rule.repList.Add ("03 Переговоры Активные") 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 - IsValidAddress = True - If Left(addr, Len("\\server\Projects")) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Pp]rojects" Then IsValidAddress = False - If Left(addr, Len("\\strg1\Exchange")) Like "\\[Ss][Tt][Rr][Gg]1\[Ee]xchange" Then IsValidAddress = False -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 +Private Function FixPrefix(addr$) As String + FixPrefix = "" + Dim prefixLen& - 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 + 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 - On Error Resume Next - CheckFile = Len(Dir(addr)) <> 0 Or Len(Dir(addr, vbDirectory)) <> 0 + 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 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 diff --git a/src/Main.bas b/src/Main.bas index d6d3667..48be5d0 100644 --- a/src/Main.bas +++ b/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) diff --git a/src/MainImpl.bas b/src/MainImpl.bas index 5e17439..f3cf847 100644 --- a/src/MainImpl.bas +++ b/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 Left(linkRange.Text, 2) = "\\" Then - linkRange.Text = ConvertLinkToLocal(linkAdr) - Else - linkRange.Text = ConvertLinkToURL(linkAdr) - End If - End If + If StrComp(linkRange.Text, SafeGetHLinkAddress(aLink)) Then _ + linkRange.Text = linkAdr 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(sResult) - If LinkCheckResult = RV_LINK_FIXED Then _ - rawLnk = sResult + LinkCheckResult = rulemap.FixLink(rawLnk, docPath) End Function Private Function TryProcessAddin(sLocal$, sServer$) As Boolean