Imports EnvDTE
Imports Extensibility
Public Class Utilities
Public oVB As DTE
Public LastLineWrapped As Boolean
Public Function GetToken(ByRef srcline As String, _
ByVal rsNonDelimiters As String, _
Optional ByVal rsDel As String = "N") _
As String
'-----
' If rsDel = "N" then the rsNondelimiters is a list of non delimters
' which is added to a list of AN Chars (a-z, A-Z, 0-9), which are
' always assumed to be non delimiters.
' If rsDel="D" then rsNonDelimiters is the list of delimiters, anything
' else in the string is assumed to be non deliter.
' Get Next word from srcLine. An alphanumeric and any character
' found in strDelimtrs is a valid char for the word. i.e. a char
' which is not alphanumeric and not found in the delimiter string
' will terminate the word. If space is not a delimiter it must be
' included in the strNonDelimitrs.
' Typicall call is:
' srcLine = GetToken(srcLine, " ().!" or
' srcLine = GetToken(srcLine, " ,") where space and comma are the delimiters.
' Any non alphanumeric and not in the " ().!" would terminate the string
' To include " in the set of allowable chars, concatenate chr(34) with the
' other non delimiters.
' If non delimiters are not supplied, dont compare for them
' and performance is increased...
'-----
Dim n_w As String ' staging area for return string
Dim FC As String ' first char of string
Dim lsTemp As String
Dim lsTemp2 As String
Const AN_DIGITS = "abcdefghijklmnopqrstuvwxyz" & _
"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
Try
n_w = ""
If rsDel = "N" Then
lsTemp2 = AN_DIGITS & rsNonDelimiters
Else
lsTemp2 = rsNonDelimiters
End If
Do While Trim$(srcline) <> ""
FC = Left$(srcline, 1)
lsTemp = "*" & FC & "*"
If rsDel = "N" Then
If Not (lsTemp2 Like lsTemp) Then
srcline = Mid(srcline, 2) ' save all but first char for next call
If Trim$(n_w) <> "" Then
GetToken = n_w
Exit Function
End If
Else
n_w = n_w & FC
srcline = Mid(srcline, 2)
End If
Else
If (lsTemp2 Like lsTemp) Then
srcline = Mid(srcline, 2) ' save all but first char for next call
If Trim$(n_w) <> "" Then
GetToken = n_w
Exit Function
End If
Else
n_w = n_w & FC
srcline = Mid(srcline, 2)
End If
End If
Loop
GetToken = n_w
Exit Function
Catch e As System.Exception
MsgBox("Error in GetToken: " & e.Message, )
GetToken = n_w
End Try
End Function
Public Function MLCount(ByVal cStrng As String, ByVal nL As Integer) As Integer
'-----
' VB Replacement for Clipper MLCount Function
' It does handle word wrap, nL is the max char
' count per line.
'-----
Dim nStptr As Integer, nLenStr As Integer, nLineCtr As Integer
Dim sTemp As String
Dim i As Integer
' nStPtr is the pointer to position in cStrng
Try
nStptr = 1
nLenStr = Len(cStrng)
nLineCtr = 0
While True
' If the pointer to the beginning of the next line
' is >= the length of the string, we are outta here!
If nStptr >= nLenStr Then
Return nLineCtr
Exit Function
End If
' Get the next line, not to exceed the length of nL
' if nL was greater than 0
If nL > 0 Then
sTemp = Mid$(cStrng, nStptr, nL)
If InStr(sTemp, vbCrLf) > 0 Then
' there is a CRLF in the string
sTemp = Left$(sTemp, sTemp.IndexOf(vbCrLf) - 1)
nStptr = nStptr + Len(sTemp) + 2
Else
' new code to handle lines with no crlf
If Len(sTemp) = nL Then
' we have a full line left (at least)
i = sTemp.LastIndexOf(" ")
' truncate the partial word from the end
sTemp = Left$(sTemp, i - 1)
'set the pointer to start the next line at
'current start point + len(stemp)
nStptr = nStptr + Len(sTemp)
Else
' this is the last line, because the string is
' shorter than the nL length
Return nLineCtr + 1
Exit Function
End If
End If
Else
' nL was supplied as 0 meaning we just look for CRLf
nStptr = InStr(nStptr, cStrng, vbCrLf) + 2
End If
' if the ptr = 2 then there was no crlf in the line
If nStptr = 2 Then
Return nLineCtr + 1
End If
nLineCtr = nLineCtr + 1
If nStptr + 1 > nLenStr Then
Return nLineCtr
End If
End While
Exit Function
Catch e As System.Exception
MsgBox("Error: " & e.Message, vbCritical, "MLCount")
End Try
End Function
Public Function MemoLine(ByVal cStrng As String, ByVal nLL As Integer, ByVal nL As Integer) As String
'***************************************
'* Name: MemoLine
'* Purpose:
'* VB Replacement for Clipper MemoLine() Function.
'* Handles Word Wrap. nLL is the max char/line.
'* Note that if the user asks for a line that is beyond the
'* end of the string, i.e. more lines than are in the string
'* unpredictable results will be returned, assuming we
'* return at all. Therefore, MLCount() must be called
'* before calling MemoLine() and MemoLine must not be called
'* to return a line numbered higher than MLCount() returened.
'*
'* Parameters:
'* cStrng
'* nLL As Integer
'* nL As Integer
'*
'* Returns:
'*
'* Author: Les Smith
'* Date Created: 11/10/1997
'* Copyright: HHI Software
'* Date Last Changed: to allow fetch of any line
'* in word wrap.
'***************************************
Static nStptr As Long
Dim i As Long
Dim nTmpPtr As Long
Dim sTemp As String
Static j As Long
Dim iSt As Long
' if NL is 1 > than J then
' this is a subsequent call to get the next
' line
If j = 0 Then
nStptr = 1
End If
If nL - j = 1 Then
iSt = nL
Else
nStptr = 1
iSt = 1
End If
LastLineWrapped = False
If nStptr >= Len(cStrng) Then
MemoLine = ""
Exit Function
End If
' Loop through the string until we find the requested line.
For j = iSt To nL
' Get the next line, not to exceed the length of nLL
' if nL was greater than 0
If nLL = 0 Then
' nL was supplied as 0 meaning we just look for vbCrLf
i = InStr(nStptr, cStrng, vbCrLf, 1)
If i = 0 Then
' no vbcrlf, return the whole remaining portion of string
MemoLine = Trim(Mid(cStrng, nStptr))
' set the next ptr at the end of the string
' in case the user calls for the next line, which
' if mlcount worked properly, they should not do...
nStptr = Len(cStrng)
Exit Function
ElseIf i = nStptr Then
' the first chars in the current line are vbcrlf
nStptr = nStptr + 2
MemoLine = ""
If j < nL Then
GoTo BottomOfLoop
Else
Exit Function
End If
Else
MemoLine = Trim(Mid(cStrng, nStptr, i - nStptr))
nStptr = i + 2
If j < nL Then
GoTo BottomOfLoop
Else
Exit Function
End If
End If
Else
' user specified max length of lines to be returned,
' i.e. word wrap is called for...
sTemp = Mid$(cStrng, nStptr, nLL)
If InStr(sTemp, vbCrLf) > 0 Then
' there is a vbCrLf in the string
sTemp = Left$(sTemp, InStr(sTemp, vbCrLf) - 1)
nStptr = nStptr + Len(sTemp) + 2
MemoLine = Trim(sTemp)
If j < nL Then
GoTo BottomOfLoop
Else
Exit Function
End If
Else
' no vbCrLf in string, find end of last full word
' see if the line is shorter than the requested line
If Len(sTemp) < nLL Then
' line is less than requested length,
' we are at the end of the input string
' set the pointer to the next line past the
' end of the string
nStptr = Len(cStrng) + 1
MemoLine = sTemp
Exit Function
Else
' this is not the last line, .'. find the
' last space in the line, assuming there is one...
i = InStrRev(sTemp, " ")
If i = 0 Then
' there is no space in the line
MemoLine = Trim(sTemp)
nStptr = nStptr + Len(sTemp) '+ 1
If j < nL Then
GoTo BottomOfLoop
Else
LastLineWrapped = True
Exit Function
End If
Else
' there is a space in the line
sTemp = Left$(sTemp, i)
MemoLine = Trim(sTemp)
nStptr = nStptr + i
If j < nL Then
GoTo BottomOfLoop
Else
LastLineWrapped = True
Exit Function
End If
End If
End If
End If
End If
BottomOfLoop:
Next j
End Function
'Public Function oldMemoLine(ByVal cStrng As String, _
' ByVal nLL As Integer, ByVal nL As Integer) As String
' '-----
' ' VB Replacement for Clipper MemoLine() Function.
' ' Handles Word Wrap. nLL is the max char/line.
' ' Note that if the user asks for a line that is beyond the
' ' end of the string, i.e. more lines than are in the string
' ' unpredictable results will be returned, assuming we
' ' return at all. Therefore, MLCount() must be called
' ' before calling MemoLine() and MemoLine must not be called
' ' to return a line numbered higher than MLCount() returened.
' '-----
' Static nStptr As Integer
' Dim i As Integer
' Dim nTmpPtr As Integer
' Dim sTemp As String
' Dim nPrevStPtr As Integer
' Dim lFoundSpace As Integer
' Static j As Integer
' Dim iST As Integer
' LastLineWrapped = False
' Try
' ' if NL is 1 > than J then
' ' this is a subsequent call to get the next
' ' line
' If nL = 1 Then
' nStptr = 1
' iST = 1
' ElseIf (nL - (j - 1) = 1) And (j <> 0) Then
' iST = nL
' Else
' nStptr = 1
' iST = 1
' End If
' ' Loop through the string until we find the requested line.
' For j = iST To nL
' ' Remembering where the previous line started will allow
' ' us to know where the requested line began when we have gone
' ' just past it with the following loop
' nPrevStPtr = nStptr
' ' Get the next line, not to exceed the length of nLL
' ' if nL was greater than 0
' If nLL = 0 Then
' ' nL was supplied as 0 meaning we just look for CRLf
' nStptr = InStr(nStptr, cStrng, Chr(13) & Chr(10)) + 2
' Else
' sTemp = Mid$(cStrng, nStptr, nLL)
' If sTemp.IndexOf(vbCrLf) > 0 Then
' ' there is a CRLF in the string
' sTemp = Left$(sTemp, sTemp.IndexOf(vbCrLf) - 1)
' If Len(sTemp) = 0 Then
' nStptr = nStptr + 3
' Else
' nStptr = nStptr + Len(sTemp) + 2
' End If
' Else
' ' new code to handle lines with no crlf
' If Len(sTemp) = nLL Then
' ' we have a full line left with no crlf
' ' find last space
' i = sTemp.LastIndexOf(" ")
' ' truncate the partial word from the end
' sTemp = Left$(sTemp, i)
' ' set the pointer to start the next line at current
' ' start point + len(stemp)
' nStptr = nStptr + Len(sTemp)
' If j = nL Then
' LastLineWrapped = True
' End If
' End If
' End If
' End If
' Next j
' ' nStPtr is now positioned to the end of the requested line
' ' Now find the end of the current (requested) line.
' If nLL = 0 Then
' If nStptr = 2 Then
' Return Mid$(cStrng, nPrevStPtr)
' Else
' Return Mid(cStrng, nPrevStPtr, nStptr - (nPrevStPtr + 2))
' End If
' Else
' Return Trim$(sTemp)
' End If
' Exit Function
' Catch e As System.Exception
' MsgBox("Error: " & e.Message, vbCritical, "MemoLine")
' End Try
'End Function
Public Function CountSpacesBeforeFirstChar(ByVal sIN As String) As Short
' Return the number of spaces before the first non blank character
Dim iSpCnt As Short = 0
Try
For iSpCnt = 0 To CType(sIN.Length - 1, Short)
If Mid$(sIN, iSpCnt + 1, 1) <> " " Then
Return iSpCnt
End If
Next iSpCnt
Catch
CountSpacesBeforeFirstChar = iSpCnt
End Try
End Function
Public Sub AddMethodToEndOfDocument(ByVal NewMethod As String)
Dim objTD As TextDocument = oVB.ActiveDocument.Object
Dim objEP As EditPoint = objTD.EndPoint.CreateEditPoint
' We are past the end of the last line of the document
' move back in front of the End Module/Class
objEP.LineUp(1)
' if a c# file, we must get within the namespace and the class braces
If Me.GetFileType(oVB.ActiveDocument) = 9 Then
objEP.LineUp(1)
End If
objEP.Insert(NewMethod)
End Sub
Public Function GetCodeFromWindow() As String
Dim s As String
Dim selCodeBlock As TextSelection
Dim oUtil As New Utilities(oVB)
Try
selCodeBlock = CType(oVB.ActiveDocument.Selection(), EnvDTE.TextSelection)
GetCodeFromWindow = selCodeBlock.Text
Catch e As System.Exception
MsgBox("Error: " & e.Message, MsgBoxStyle.Critical, "GetCodeFromWindow")
End Try
oUtil = Nothing
End Function
Public Sub PutCodeBack(ByVal s As String)
Dim selCodeBlock As TextSelection
'Dim datobj As New System.Windows.Forms.DataObject()
Try
selCodeBlock = CType(oVB.ActiveDocument.Selection(), EnvDTE.TextSelection)
'datobj.SetData(System.Windows.Forms.DataFormats.Text, s)
'System.Windows.Forms.Clipboard.SetDataObject(datobj)
'selCodeBlock.Paste()
selCodeBlock.Delete()
selCodeBlock.Insert(s, 1)
Catch e As System.Exception
MsgBox("Could not put code back in window.", _
MsgBoxStyle.Critical, _
"PutCodeBackInWindow")
End Try
End Sub
Function GetCommentCharForDoc(Optional ByVal doc As Document = Nothing) As String
If (doc Is Nothing) Then
doc = oVB.ActiveDocument
End If
Dim ext As String = doc.Name
If (ext.EndsWith(".cs")) Then
Return "//"
ElseIf (ext.EndsWith(".cpp")) Then
Return "//"
ElseIf (ext.EndsWith(".h")) Then
Return "//"
ElseIf (ext.EndsWith(".vb")) Then
Return "'*"
ElseIf (ext.EndsWith(".idl")) Then
Return "//"
Else
Return ""
End If
End Function
Public Function GetLanguageCommentChars(ByVal FileType As Short) As String
Select Case FileType
Case 1, 2, 9 : Return "//"
Case 8, 6 : Return "'*"
Case 4, 10 : Return ";"
Case Else : Return ""
End Select
End Function
Function GetFileType(ByVal doc As Document) As Integer
' Pass this function the document that you wish to get information for.
' Return value:
' 0 Unknown file type
' 1 C-related file, this includes .c, .cpp, .cxx, .h, .hpp, .hxx
' 2 Java-related file, this includes .jav, .java
' 3 ODL-style file, .odl, .idl
' 4 Resource file, .rc, .rc2
' 7 Def-style file, .def
' 8 VB, .vb
' 9 C#, .cs
' 10 Batch, .bat
Dim pos As Integer
Dim ext As String
Try
ext = doc.Name.ToUpper
If ext.EndsWith(".RC") Or ext.EndsWith(".RC2") Then
Return 4
ElseIf ext.EndsWith(".CPP") Or _
ext.EndsWith(".C") Or _
ext.EndsWith(".H") Or _
ext.EndsWith(".HPP") Then
Return 1
ElseIf ext.EndsWith(".JAV") Or ext.EndsWith(".JAVA") Then
Return 2
ElseIf ext = ".DEF" Then
Return 7
ElseIf ext.EndsWith(".VB") Then
Return 8
ElseIf ext.EndsWith(".CS") Then
Return 9
ElseIf ext.EndsWith(".BAT") Then
Else
Return 0
End If
Catch e As System.Exception
MsgBox(e.Message)
End Try
End Function
Public Function GetWholeProc() As String
'Dim ts As TextSelection = oVB.ActiveWindow().Selection
Dim ts As TextSelection = oVB.ActiveDocument.Selection
Dim ep As EditPoint = ts.ActivePoint.CreateEditPoint
Dim sLine As String
Dim i As Integer
Dim sCommentChar As String
Try
sCommentChar = Me.GetCommentCharForDoc(oVB.ActiveDocument)
sCommentChar = Left(sCommentChar, 1)
If sCommentChar = "/" Then
If Len(ts.Text) = 0 Then
MsgBox("For a C#/C++ project you must select the whole proc.")
Return ""
End If
End If
' if the user has selected the whole proc, then just return it
' otherwise select it for them...
If Len(ts.Text) > 0 Then
If (InStr(1, ts.Text, "Sub ", 1) > 0 Or _
InStr(1, ts.Text, "Function ", 1) > 0) And _
(InStr(1, ts.Text, "End Sub", 1) > 0 Or _
InStr(1, ts.Text, "End Function", 1) > 0) _
Then
Return ts.Text
End If
GoTo SelectTheProc
Else
SelectTheProc:
'' Get the start of the proc
ep.MoveToPoint(ep.CodeElement(EnvDTE.vsCMElement.vsCMElementFunction).GetStartPoint(vsCMPart.vsCMPartWhole))
' move selection start point to top of proc
ts.MoveToPoint(ep, False)
' back up to previous line looking for comments
i = 0
Do
ep.LineUp()
ts.MoveToPoint(ep, False)
ts.SelectLine()
sLine = ts.Text
If Left(Trim(sLine), 1) <> sCommentChar Then
ep.LineDown()
ts.MoveToPoint(ep, False)
Exit Do
End If
i = i + 1
Loop
' if the count of comment lines > 0 the ts point is set properly
' else we must move it back to the original
ep.LineDown(i + 1)
' move to bottom of proc
ep.MoveToPoint(ep.CodeElement(EnvDTE.vsCMElement.vsCMElementFunction).GetEndPoint(vsCMPart.vsCMPartWhole))
' select the proc
ts.MoveToPoint(ep, True)
Return ts.Text
End If
Catch e As System.Exception
System.Windows.Forms.MessageBox.Show("You must either select " & _
"the whole procedure or your cursor must be within the procedure " & _
"to be selected. " & e.Message)
Return ""
End Try
End Function
Shared Function CountOccurrences(ByVal rsExp As String, _
ByVal rsStr As Object) As Long
' Returns the number of occurrences of rsExp (expression)
' found in rsStr (string)
' Returns 0 of no occurrences found.
Dim pPos As Integer
Dim lPos As Integer
Dim nPos As Integer
Dim nFirst As Integer
Dim lCnt As Integer
Try
pPos = 0 ' previous find
lPos = 0 ' return position of right char
nPos = 1 ' position of next right most char
nFirst = 1
lCnt = 0
' loop thru every char in string until we
' find the last occurrence
Do
lPos = InStr(nPos, rsStr, rsExp, 1)
If lPos > 0 Then
nPos = lPos + 1
pPos = lPos
lCnt = lCnt + 1
Else
Exit Do
End If
Loop
Return lCnt
Catch e As System.Exception
End Try
End Function
Public Sub New(ByVal roVB As DTE)
oVB = roVB
End Sub
End Class
Submit an article or tip