Update archive fixer
This commit is contained in:
Ivan
parent
237e0412d2
commit
eddee9e5eb
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user