Set FSO = CreateObject("Scripting.FileSystemObject")
ion = FSO.GetParentFolderName(FileName) & "\descript.ion"
If FSO.FileExists(ion) Then
If FSO.GetFile(ion).Size > 3 Then
' Паттерн замены искомых частей на пробел:
Pattern = "(\[[^[\]]+\])+"
' Паттерны искомых частей комментария:
Pattern1 = "\[[cC]=([^[\]]+)\]"
Pattern2 = "\[[yY]=([^[\]]+)\]"
With CreateObject("SAPI.SpFileStream") .Open ion : .Read ArrB, 3 : .Close : End With
For i = 1 To 2 : Dec = Dec & AscB(MidB(ArrB, i, 1)) : Next
Select Case Dec
Case 239187 Enc = "UTF-8"
Case 255254 Enc = "UTF-16LE"
Case 254255 Enc = "UTF-16BE"
Case Else Enc = "Windows-1251"
End Select
With CreateObject("ADODB.Stream")
.Open : .Type = 2 : .CharSet = Enc : .LoadFromFile ion : All = .ReadText : .Close
End With
FileName = FSO.GetFileName(FileName)
If InStr(FileName, " ") Then FileName = """" & FileName & """"
Set RExp = New RegExp
With RExp
.Pattern = "([[\]\{}\-\(\)^(\$\+\.])" : .Global = 1
.Pattern = "^" & .Replace(FileName, "\$1") & " ([^\r\n]+)$" : .MultiLine = 1
If .Test(All) Then
Comment = .Execute(All)(0).Submatches(0)
.Pattern = Pattern : Content = Trim(.Replace(Comment, " "))
Substring Pattern1, Content1
Substring Pattern2, Content2
End If
End With
End If
End If
Set FSO = Nothing : Set RExp = Nothing
Sub Substring(Patt, Cont)
With RExp
.Pattern = Patt : If .Test(Comment) Then Cont = .Execute(Comment)(0).SubMatches(0)
End With
End Sub |