Procedure Extractor

' ================================================================
' = This procedure extracts the source code of a given procedure =
' = Version 1.1
' ================================================================
Function GetProcedureText(ByVal strProcName, ByVal strPathLib, ByVal bIncludeComments)
   Dim strTemp
   Dim objRE
   Dim objFSO
   Dim oF
   Dim strFileText
   Dim objMatchItem
   Dim objMatches
   Dim strPattern
  
   Set objRE = New RegExp
   Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
   If Not objFSO.FileExists(strPathLib) Then
      strTemp = "{Error: File not found. Please provide a valid PHYSICAL path!}"
   Else
      On Error Resume Next
      Set oF = objFSO.OpenTextFile(strPathLib)
      strFileText = oF.ReadAll
      oF.Close
      Set oF = Nothing
      If bIncludeComments Then
         strPattern = "(?:^[ \t]*?'(?:.|\n(?=\s*'|\n|"
         strPattern = strPattern & "(?:Function|Sub|Class)[ \t]*?" & strProcName & "))*?|^)"
      Else
         strPattern = "^"
      End If
      strPattern = strPattern & "[ \t]*?(Function|Sub|Class)[ \t]*?" & strProcName
      strPattern = strPattern & "(?:.|\n)*?^End\s*?\1"
      objRE.Pattern = strPattern
      objRE.IgnoreCase = True
      objRE.Global = False
      objRE.MultiLine = True
      Set objMatches = objRE.Execute(strFileText)
      
      If objMatches.Count > 0 Then
         strTemp = objMatches(0).Value
      Else
         strTemp = "Error: {No matches found for " & strProcName & "}"
      End If
      If Err.Number > 0 Then
         If Err.Number = 438 Then
            strTemp = "Error: {This procedure requires VBScript version 5.5 or later}"
         Else
            strTemp = "Error: {" & Err.Description & "}"
         End If
      End If
      Err.Clear
   End If
   Set objFSO = Nothing
   GetProcedureText = strTemp
End Function