' Copyright 2007 Servprise International, Inc.
'
' Licensed under the Apache License, Version 2.0 (the "License");
' you may not use this file except in compliance with the License.
' You may obtain a copy of the License at
'
'     http://www.apache.org/licenses/LICENSE-2.0
'
' Unless required by applicable law or agreed to in writing, software
' distributed under the License is distributed on an "AS IS" BASIS,
' WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
' See the License for the specific language governing permissions and
' limitations under the License.

Option Explicit

Const cstrFieldDataCodePrefix As String = " PRIVATE code_"
Const cstrFieldDataEndPathDesignator As String = ":"
Const cstrCodeBookmarkName As String = "codeBookmark"
Const cstrBaseUrlDocumentProperty As String = "codeBaseUrl"
Const cstrStyleName As String = "Code"

' GetCodeExcerpts will search the active Word document for specialized tags
' that indicate source code should be pulled into the document directly from
' source code files.
'
' For a thorough explanation on usage, see Cory von Wallenstein's blog
' at http://www.standingonthebrink.com.

Sub GetCodeExcerpts()
    Dim ie As Object
    Dim strDocument As String
    Dim nStart As Integer
    Dim nEnd As Integer
    Dim oixField As Integer
    Dim oixBookmark As Integer
    Dim cstrBaseUrl As String
    Dim strFilePath As String
    Dim strReferenceName As String
    Dim strFieldData As String
    
    cstrBaseUrl = ActiveDocument.CustomDocumentProperties(cstrBaseUrlDocumentProperty).Value
    Set ie = CreateObject("InternetExplorer.Application")
    
    ' If we don't have a trailing slash on the base URL, add one
    If False = StringEndsWith(cstrBaseUrl, "/", vbTextCompare) And False = StringEndsWith(cstrBaseUrl, "\", vbTextCompare) Then
        cstrBaseUrl = cstrBaseUrl & "/"
    End If
    
    ' Delete all of the existing code bookmarks
    oixBookmark = ActiveDocument.Bookmarks.Count
    Do Until oixBookmark < 1
        If True = StringStartsWith(ActiveDocument.Bookmarks(oixBookmark).Name, cstrCodeBookmarkName) Then
            ActiveDocument.Bookmarks(oixBookmark).Select
            Selection.Delete
        End If
        oixBookmark = oixBookmark - 1
    Loop
    
    ' Iterate through each field in the document, filtering for the ones we care about
    oixField = 1
    Do Until oixField > ActiveDocument.Fields.Count
        
        strFieldData = ActiveDocument.Fields(oixField).Code
                                       
        If wdFieldPrivate = ActiveDocument.Fields(oixField).Type And StringStartsWith(strFieldData, cstrFieldDataCodePrefix) Then
                                       
            strFilePath = cstrBaseUrl & ExtractFilePathFromFieldData(strFieldData)
            
            strReferenceName = ExtractReferenceFromFieldData(strFieldData)
                               
            With ie
                .Navigate strFilePath
                Do Until Not .Busy And .ReadyState = 4
                    DoEvents
                Loop
        
                strDocument = ie.Document.body.innertext
            End With
            
            AddCodeBookmarkForThisField oixField, ExtractCodeFromDocument(strFieldData, strDocument)
            
        End If
        oixField = oixField + 1
    Loop

    ie.Quit
    Set ie = Nothing
    
End Sub
    
    
'Extracts a path from the encoded bookmark name.
'Example: If we receive "code_build_p_xml___refWsdl2javaTaskdef", we will return
'the path "build.xml"
Function ExtractFilePathFromFieldData(ByVal strFieldData As String) As String

    Dim strFilePath As String
    Dim nStart As Integer
    Dim nEnd As Integer
    
    'Get the location of the end of the path name
    nStart = Len(cstrFieldDataCodePrefix) + 1
    nEnd = InStr(nStart, strFieldData, cstrFieldDataEndPathDesignator, vbTextCompare)
    
    If nEnd Then
    
        'Extract the portion between the prefix and the end designator, then decode characters like slashes and periods
        strFilePath = Mid$(strFieldData, nStart, nEnd - nStart)
        
        ExtractFilePathFromFieldData = strFilePath
    Else
        MsgBox "ExtractFilePathFromFieldData: Failed to find end of file path designator '" & cstrFieldDataEndPathDesignator & "'"
        ExtractFilePathFromFieldData = "EndPathDesignatorNotFound"
    End If

End Function


'Extracts a reference name from the encoded bookmark name.
'Example: If we receive "code_build_p_xml___refWsdl2javaTaskdef", we will return
'the path "refWsdl2javaTaskdef"
Function ExtractReferenceFromFieldData(ByVal strFieldData As String) As String

    Dim strReferenceName As String
    Dim nStart As Integer
    Dim nEnd As Integer
    
    'Get the location of the end of the path name
    nStart = InStr(1, strFieldData, cstrFieldDataEndPathDesignator, vbTextCompare) + Len(cstrFieldDataEndPathDesignator)
    If nStart Then
        nEnd = Len(strFieldData)
    
        'Extract the portion between the prefix and the end designator, then decode characters like slashes and periods
        strReferenceName = Mid$(strFieldData, nStart, nEnd - nStart)
            
        ExtractReferenceFromFieldData = strReferenceName
    Else
        MsgBox "ExtractReferenceFromFieldData: Failed to find end of file path designator '" & cstrFieldDataEndPathDesignator & "'"
        ExtractReferenceFromFieldData = "EndPathDesignatorNotFound"
    End If
    
End Function


'Extracts code from the provided document
Function ExtractCodeFromDocument(ByVal strFieldData As String, ByVal strDocument As String) As String

    Dim strReferenceName As String
    Dim nStart As Integer
    Dim nStartOfReferenceName As Integer
    Dim nEnd As Integer
    
    strReferenceName = ExtractReferenceFromFieldData(strFieldData)
    
    ' Find the reference (ensure it's followed by whitespace to avoid premature matches)
    nStart = InStr(1, strDocument, strReferenceName & " ", vbTextCompare)
    If nStart Then
    
        nStartOfReferenceName = nStart
    
        'Go to the end of the line containing the reference, plus 1 to get to the next line
        nStart = nStart + Len(strReferenceName) + 2
        
        nStart = InStr(nStart, strDocument, vbNewLine, vbTextCompare) + Len(vbNewLine)
        
        'The end is the next location of the reference
        nEnd = InStr(nStart, strDocument, strReferenceName, vbTextCompare)
        If nEnd Then
            'Looking backward, find the end of the line
            nEnd = InStrRev(strDocument, vbNewLine, nEnd, vbTextCompare)
            
            'Now we have the range we want... in between nStart and nEnd
            ExtractCodeFromDocument = Mid$(strDocument, nStart, nEnd - nStart)
        Else
            'If we do not have a concluding reference, we must just be looking for a variable name.
            'To extract it, eat backwards until we get to the first non-comment character and non-whitespace character (that's the end)
            'Then continue reading until you find a whitespace character (that's the beginning) and extract
            
            Dim i As Integer
            Dim c As String
            i = nStartOfReferenceName - 1
            
            'Find the first non-comment, non-semi-colon, and non-whitespace character
            c = Mid$(strDocument, i, 1)
            Do While c = "/" Or c = " " Or c = ";" Or c = "*"
                i = i - 1
                c = Mid$(strDocument, i, 1)
            Loop
            
            nEnd = i + 1
            
            'Now find the first whitespace or asterisk
            Do Until c = " " Or c = "*"
                i = i - 1
                c = Mid$(strDocument, i, 1)
            Loop
                        
            nStart = i + 1
            
            'We now have our variable name
            ExtractCodeFromDocument = Mid$(strDocument, nStart, nEnd - nStart)
        End If
    Else
        MsgBox "ExtractCodeFromDocument: Failed to find first reference to '" & strReferenceName & "' in code document."
        ExtractCodeFromDocument = "Reference1NotFound"
    End If

End Function
    
    
' Determines if a string starts with the same characters as CheckFor string
Public Function StringStartsWith(ByVal strValue As String, _
  CheckFor As String, Optional CompareType As VbCompareMethod _
   = vbBinaryCompare) As Boolean
    
  Dim strCompare As String
  Dim lLen As Long
   
  lLen = Len(CheckFor)
  If lLen > Len(strValue) Then Exit Function
  strCompare = Left(strValue, lLen)
  StringStartsWith = StrComp(strCompare, CheckFor, CompareType) = 0

End Function


' Determines if a string ends with the same characters as CheckFor string
Public Function StringEndsWith(ByVal strValue As String, _
   CheckFor As String, Optional CompareType As VbCompareMethod _
   = vbBinaryCompare) As Boolean

  Dim strCompare As String
  Dim lLen As Long
   
  lLen = Len(CheckFor)
  If lLen > Len(strValue) Then Exit Function
  strCompare = Right(strValue, lLen)
  StringEndsWith = StrComp(strCompare, CheckFor, CompareType) = 0

End Function


' Locates the bookmark of the specified name in the active document
' and replaces its contents with the provided string
Sub AddCodeBookmarkForThisField(oixFieldToUpdate As Integer, strTextToInsert As String)
    ActiveDocument.Fields(oixFieldToUpdate).Select
    Selection.Collapse
    Selection.InsertAfter strTextToInsert
    With ActiveDocument.Bookmarks
       .Add Range:=Selection.Range, Name:=cstrCodeBookmarkName & oixFieldToUpdate
       .DefaultSorting = wdSortByName
       .ShowHidden = False
    End With
    Selection.Style = cstrStyleName
End Sub