Option Strict Off
Option Explicit On
Imports System.Linq
Imports System.Collections.Generic
Imports gmRTL.GUI
Namespace VBSCAN
   Public Module modVBSCAN
   Public gsMAKName As String = ""    ' full name of project mak file
   Public gsMAKPath As String = ""    ' path of project make file
   Public gsModPath As String() = Array.Empty(Of String)() ' full path and name of module files
   Public giModCnt As Integer = 0     ' number of modules
   Public gsSrch As String() = Array.Empty(Of String)() ' array of strings to search for
   Public gsDtlView As String = ""    ' Detail View
   Public gNumHits As Integer = 0     ' number of mathing lines
   Public giCase As Integer = 0       ' ignore case flag
   Public giCmnts As Integer = 0      ' ignore comments flag
   Public giStopScan As Integer = 0   ' abort scanning
   Public Const [Default] As Integer = 0 ' 0 - Default
   Public Const HOURGLASS As Integer = 11 ' 11 - Hourglass
   Public gsDocComment As String = ""
   Public gsDocFile As String = ""
   Public gsDocType As String = ""
   Public Sub Main()
      gsDocComment = "'!d"
      gsDocFile = "c:\temp\vbscan.htm"
      gsDocType = "HTML"
      System.Windows.Forms.Application.Run(frmVbScan.DefInstance)
   End Sub
   Public Function rdPrjFile(ByVal sFName As String) As Integer
      rdPrjFile = 0

      On Error Goto rdPrjFile_err
      rdPrjFile = -1

      Dim inf As Double = 0.0
      inf = 1
      Dim sbuf As String = ""
      Dim c As String = ""
      Dim sExt As String = ""
      Dim l As Integer = 0
      Dim i As Integer = 0
      Dim rc As Integer = 0
      Dim sfullname As String = ""
      Dim sshortName As String = ""
      Dim fType As String = ""
      Dim ol As MSOutl.Outline = Nothing

      ol = frmVbScan.DefInstance.OL1
      ol.Clear()

      ' add project

      giModCnt = 0
      Erase gsModPath
      giModCnt = giModCnt + 1

      FileSystem.FileOpen(inf,sFName,OpenMode.Input,OpenAccess.Default,OpenShare.Default,-1)
      sbuf = ""
      Do While Not (FileSystem.EOF(inf) And giStopScan = 0)
         System.Windows.Forms.Application.DoEvents()
         c = FileSystem.InputString(inf,1)
         If (c <> Strings.Chr(10)) Then
            sbuf = sbuf & c
         Else
            sExt = Strings.UCase(Strings.Left(Strings.Right(sbuf,4),3))
            If (sExt = "BAS" Or sExt = "FRM" Or sExt = "CLS" Or sExt = "CTL") Then

               cleanupNames(sbuf,sshortName,sfullname)

               ol.AddItem(sshortName)
               ol.Indent(ol.ListCount - 1) = 1
               fType = Word(sbuf,1,"=")
               ol.List(ol.ListCount - 1) = fType & ": " & sshortName
               frmVbScan.DefInstance.Refresh()

               ' save index of gsModPath in ItemData

               giModCnt = giModCnt + 1
               Redim Preserve gsModPath(giModCnt)
               gsModPath(giModCnt) = sfullname
               ol.ItemData(ol.ListCount - 1) = giModCnt

               rc = rdMODFile(sfullname)
               If (rc <> 0) Then
                  rdPrjFile = 1
                  GoTo rdPrjFile_err
               End If
            End If
            sbuf = ""

         End If
      Loop                               ' while not EOF

      rdPrjFile = 0

   rdPrjFile_err:

      If (Err.Number <> 0) Then
         System.Windows.Forms.MessageBox.Show("Error [rdPrjFile] " & Environment.NewLine & Err.Description, "", MessageBoxButtons.OK)
      End If

      FileSystem.FileClose(inf)

   End Function
   Private Sub cleanupNames(ByRef sbuf As String,ByRef sshortName As String,ByRef sfullname As String)
      Dim l As Integer = 0
      Dim i As Integer = 0

      l = Strings.Len(sbuf) - 1
      sbuf = Strings.Trim(Strings.Left(sbuf,l)) ' get rid of CR

      i = Strings.InStr(1,sbuf,"=",CompareMethod.Binary)
      If (i <> 0) Then
         sbuf = Strings.Trim(Mid(sbuf,i + 1))
      End If

      i = Strings.InStr(1,sbuf,";",CompareMethod.Binary)
      If (i <> 0) Then
         sbuf = Strings.Trim(Mid(sbuf,i + 1))
      End If

      l = Strings.Len(sbuf)
      i = RInStr(sbuf,"\")
      If (i = 0) Then
         sshortName = sbuf
         sfullname = gsMAKPath & sbuf
      Else
         sshortName = Strings.Trim(Strings.Right(sbuf,l - i))
         sfullname = sbuf
      End If
   End Sub
   Public Function rdMODFile(ByVal sFName As String) As Integer
      rdMODFile = 0

      On Error Goto rdModFile_err
      rdMODFile = -1
      Dim inf As Double = 0.0
      inf = 2
      Dim sbuf As String = ""
      Dim c As String = ""
      Dim sExt As String = ""
      Dim l As Integer = 0
      Dim w As String = ""
      Dim rc As Integer = 0
      Dim w2 As String = ""
      Dim ol As MSOutl.Outline = Nothing
      Dim sn As String = ""
      Dim iNoComments As Integer = 0

      ol = frmVbScan.DefInstance.OL1

      FileSystem.FileOpen(inf,sFName,OpenMode.Input,OpenAccess.Default,OpenShare.Default,-1)
      sbuf = ""
      sn = "General"
      Do While Not FileSystem.EOF(inf)
         c = FileSystem.InputString(inf,1)
         If (c <> Strings.Chr(10)) Then
            ' keep adding characters until new line encountered
            sbuf = sbuf & c
         Else
            sbuf = Strings.Left(sbuf,Strings.Len(sbuf) - 1)
            If (Strings.Right(sbuf,1) <> "_") Then
               'Debug.Print sbuf
               w = Word(sbuf,1)

               If (w = "Public" Or w = "Private" Or w = "Friend") Then
                  l = 2
               Else
                  l = 1
               End If

               w = Word(sbuf,l)

               Select Case w
                  Case "Function","Sub"
                     w = Strings.Left(w,3) & " " & Word(sbuf,l + 1)
                  Case "Property"
                     w = Strings.Left(w,3) & " " & Word(sbuf,l + 1) & " " & Word(sbuf,l + 2)
                  Case Else
                     l = 0
               End Select

               If (l > 0) Then
                  l = Strings.InStr(1,w,"(",CompareMethod.Binary)
                  If (l > 0) Then
                     w = Strings.Left(w,l - 1)
                  End If
                  'sn = w ' mej modified to show full function declaration
                  sn = sbuf
               End If
               If (giCmnts <> 0) Then
                  l = Strings.InStr(1,sbuf,"'",CompareMethod.Binary)
                  If (l <> 0) Then
                     sbuf = Strings.Left(sbuf,l)
                  End If
               End If
               rc = ScanLine(sbuf,gsSrch)
               If (rc <> 0) Then
                  If (sn <> "") Then
                     ol.AddItem(sn)
                     ol.Indent(ol.ListCount - 1) = 2
                     sn = ""
                  End If
                  ol.AddItem(TrimWS(sbuf))
                  ol.Indent(ol.ListCount - 1) = 3
                  gNumHits = gNumHits + 1
               End If
               sbuf = ""
            Else

               ' trim off line continuation character

               sbuf = Strings.Left(sbuf,Strings.Len(sbuf) - 1)
            End If

         End If
      Loop                               ' while not EOF

      ol = Nothing


      rdMODFile = 0

   rdModFile_err:
      If (Err.Number <> 0) Then
         If (Interaction.MsgBox("Error [rdModFile] " & sFName & " " & Err.Description,MsgBoxStyle.OkCancel,"") = MsgBoxResult.Cancel) Then
            rdMODFile = 1
         Else
            rdMODFile = 0
         End If
      End If

      FileSystem.FileClose(inf)
      Exit Function
   End Function
   Public Function rdRoutine(ByVal sFName As String,ByVal sRtn As String) As Integer
      rdRoutine = 0

      Debug.WriteLine("rdRoutine: fname=" & sFName & " rtn=" & sRtn)

      On Error Goto rdRoutine_err
      rdRoutine = -1

      Dim inf As Double = 0.0
      inf = 2
      Dim sbuf As String = ""
      Dim c As String = ""
      Dim w As String = ""
      Dim rc As Integer = 0
      Dim l As Integer = 0

      FileSystem.FileOpen(inf,sFName,OpenMode.Input,OpenAccess.Default,OpenShare.Default,-1)
      sbuf = ""
      Do While Not FileSystem.EOF(inf)
         c = FileSystem.InputString(inf,1)
         If (c <> Strings.Chr(10)) Then
            sbuf = sbuf & c
         Else
            sbuf = Strings.Left(sbuf,Strings.Len(sbuf) - 1)

            w = Word(sbuf,1)

            If (w = "Public" Or w = "Private" Or w = "Friend") Then
               l = 2
            Else
               l = 1
            End If

            w = Word(sbuf,l)

            Select Case w
               Case "Function","Sub"
                  w = Strings.Left(w,3) & " " & Word(sbuf,l + 1)
               Case "Property"
                  w = Strings.Left(w,3) & " " & Word(sbuf,l + 1) & " " & Word(sbuf,l + 2)
               Case Else
                  l = 0
            End Select

            If (l > 0) Then
               l = Strings.InStr(1,w,"(",CompareMethod.Binary)
               If (l > 0) Then
                  w = Strings.Left(w,l - 1)
               End If

               If (sbuf = sRtn) Then

                  If (gsDtlView = "List") Then
                     rc = Rtn2Lst("End " & Strings.Left(w,3),inf,sbuf)
                  Else
                     rc = Rtn2OL("End " & Strings.Left(w,3),inf,sbuf)
                  End If

                  If (rc <> 0) Then
                     GoTo rdRoutine_err
                  Else
                     Exit Do
                  End If
               End If
            End If
            sbuf = ""
         End If
      Loop                               ' while not EOF

      rdRoutine = 0

   rdRoutine_end:
      FileSystem.FileClose(inf)
      Exit Function

   rdRoutine_err:
      System.Windows.Forms.MessageBox.Show("Error [rdRoutine] " & Err.Description & " #" & Err.Number, "", MessageBoxButtons.OK)
      GoTo rdRoutine_end
   End Function
   Public Function rdGeneral(ByVal sFName As String) As Integer
      rdGeneral = 0

      On Error Goto rdRoutine_err
      rdGeneral = -1

      Dim inf As Double = 0.0
      inf = 2
      FileSystem.FileOpen(inf,sFName,OpenMode.Input,OpenAccess.Default,OpenShare.Default,-1)
      Dim rc As Integer = 0

      If (gsDtlView = "List") Then
         rc = Rtn2Lst("",inf,"")
      Else
         rc = Rtn2OL("",inf,"")
      End If

      rdGeneral = 0

   rdRoutine_end:
      FileSystem.FileClose(inf)
      Exit Function

   rdRoutine_err:
      System.Windows.Forms.MessageBox.Show("Error [rdRoutine] " & Err.Description & " #" & Err.Number, "", MessageBoxButtons.OK)
      GoTo rdRoutine_end
   End Function
   Public Function RInStr(ByVal sSource As String,ByVal sSearch As String) As Integer
      RInStr = 0
      Dim i As Integer = 0
      Dim l As Integer = 0
      l = Strings.Len(sSource)
      For i = l To 1 Step -1
         If (Mid(sSource,i,1) = sSearch) Then
            RInStr = i
            Exit Function
         End If
      Next
      RInStr = 0
      Exit Function
   End Function
   Public Function Rtn2Lst(ByVal sTerm As String,ByVal inf As Double,ByVal sRtnHdr As String) As Integer
      Rtn2Lst = 0

      On Error Goto Rtn2lst_err
      Rtn2Lst = -1

      Dim sbuf As String = ""
      Dim tbuf As String = ""
      Dim c As String = ""
      Dim w As String = ""
      Dim rc As Integer = 0
      Dim l As Integer = 0
      Dim Lst As System.Windows.Forms.ListBox = Nothing
      Dim i As Integer = 0

      Lst = frmRtnLst.DefInstance.List1

      Lst.Items.Clear()
      If (Strings.Len(sRtnHdr) <> 0) Then
         Lst.Items.Add(sRtnHdr)
      End If

      sbuf = ""
      Do While Not FileSystem.EOF(inf)
         c = FileSystem.InputString(inf,1)
         If (c <> Strings.Chr(10)) Then
            sbuf = sbuf & c
         Else
            sbuf = Strings.Left(sbuf,Strings.Len(sbuf) - 1)
            tbuf = TrimWS(sbuf)
            If (Strings.Len(tbuf) > 0) Then
               Lst.Items.Add(sbuf)
               Lst.SetItemData((Lst.Items.Count - 1),0)
               If (giCmnts <> 0) Then
                  l = Strings.InStr(1,tbuf,"'",CompareMethod.Binary)
                  If (l <> 0) Then
                     tbuf = Strings.Left(tbuf,l)
                  End If
               End If
               rc = ScanLine(tbuf,gsSrch)
               If (rc <> 0) Then
                  Lst.SetItemData((Lst.Items.Count - 1),1)
                  Lst.SetSelected(Lst.Items.Count - 1,True)
               End If
               If (Strings.Len(sTerm) > 0 And Strings.Left(tbuf,7) = sTerm) Then
                  Exit Do                            ' exit at end of routine
               End If                             ' exit at end of routine
               sbuf = ""
            End If
         End If

      Loop                               ' while not EOF

      Rtn2Lst = 0

   Rtn2Lst_end:
      FileSystem.FileClose(inf)
      Exit Function

   Rtn2lst_err:
      System.Windows.Forms.MessageBox.Show("Error [Rtn2Lst] " & Err.Description & " #" & Err.Number, "", MessageBoxButtons.OK)
      GoTo Rtn2Lst_end

   End Function
   Public Function Rtn2OL(ByVal sTerm As String,ByVal inf As Double,ByVal sRtnHdr As String) As Integer
      Rtn2OL = 0

      On Error Goto Rtn2OL_err
      Rtn2OL = -1

      Dim sbuf As String = ""
      Dim c As String = ""
      Dim w As String = ""
      Dim i As Integer = 0
      Dim l As Integer = 0
      Dim tbuf As String = ""
      Dim ol As MSOutl.Outline = Nothing
      Dim nest As Integer = 0

      ol = frmRtnOL.DefInstance.OL1
      ol.Clear()
      nest = 1
      sbuf = ""
      If (Strings.Len(sRtnHdr) <> 0) Then
         ol.AddItem(sRtnHdr)
      End If
      Do While Not FileSystem.EOF(inf)
         c = FileSystem.InputString(inf,1)
         If (c <> Strings.Chr(10)) Then
            sbuf = sbuf & c
         Else
            sbuf = Strings.Left(sbuf,Strings.Len(sbuf) - 1)
            sbuf = TrimWS(sbuf)
            If (Strings.Len(sbuf) > 0) Then

               If (Strings.Len(sTerm) > 0 And Strings.Left(sbuf,7) = sTerm) Then
                  ol.AddItem(sbuf)
                  ol.Indent(ol.ListCount - 1) = 1
                  Exit Do                            ' exit at end of routine
               End If

               w = Word(sbuf,1)

               If (w = "End") Then
                  w = w & " " & Word(sbuf,2)
               End If

               ol.AddItem(sbuf)
               Select Case w
                  Case "If","While","Do","Select","For"
                     ol.Indent(ol.ListCount - 1) = nest
                     i = 1
                     If (w = "If") Then
                                                           ' check for same-line if
                        l = Strings.InStr(1,sbuf,"'",CompareMethod.Binary)
                        If (l = 0) Then
                           l = Strings.Len(sbuf) + 1
                        End If
                        tbuf = Strings.Trim(Strings.Left(sbuf,l - 1))
                        If (Strings.Right(tbuf,4) <> "Then") Then
                           i = 0
                        End If
                     End If
                     nest = nest + i
                  Case "End If","End Select","Wend","Loop","Next"
                     ol.Indent(ol.ListCount - 1) = nest - 1
                     nest = nest - 1
                  Case "ElseIf","Else","Case"
                     ol.Indent(ol.ListCount - 1) = nest - 1
                  Case Else
                     ol.Indent(ol.ListCount - 1) = nest
               End Select

               sbuf = ""

            End If
         End If

      Loop                               ' while not EOF

      Rtn2OL = 0

      Exit Function

   Rtn2OL_err:

      System.Windows.Forms.MessageBox.Show("Error [Rtn2OL] " & Err.Description & " #" & Err.Number, "", MessageBoxButtons.OK)
      Exit Function
   End Function
   Public Function SaveCSR(ByVal sFile As String) As Integer
      SaveCSR = 0
      On Error Goto SaveCSR_err
      SaveCSR = -1

      Dim oFile As String = ""


      oFile = sFile

      Dim i As Integer = 0
      Dim m As Integer = 0
      Dim cout As Integer = 0
      cout = 1
      Dim TABc As String = ""
      TABc = Strings.Chr(9)
      Dim ol As MSOutl.Outline = Nothing

      FileSystem.FileOpen(cout,oFile,OpenMode.Output,OpenAccess.Default,OpenShare.Default,-1)

      FileSystem.PrintLine(cout,"VBScan Report for " & gsMAKName & " -- " & Now)
      FileSystem.PrintLine(cout,Strings.StrDup(80,"-"))
      FileSystem.PrintLine(cout,"")
      FileSystem.PrintLine(cout,"Ignore Comments: ",IIf(giCmnts = 0,"No","Yes"))
      FileSystem.PrintLine(cout,"Ignore Case    : ",IIf(giCase = 0,"No","Yes"))
      FileSystem.PrintLine(cout,"")

      m = UBound(gsSrch,1)

      For i = 1 To m Step 1
         FileSystem.PrintLine(cout,"Search " & i & ": [" & gsSrch(i) & "]")
      Next
      FileSystem.PrintLine(cout,Strings.StrDup(80,"-"))


      ol = frmVbScan.DefInstance.OL1
      m = ol.ListCount
      For i = 0 To m - 1 Step 1
         FileSystem.PrintLine(cout,Strings.StrDup(ol.Indent(i) - 1,TABc) & ol.List(i))
      Next

      SaveCSR = 0

   SaveCSR_end:
      On Error Resume Next
      FileSystem.FileClose(cout)
      Exit Function

   SaveCSR_err:
      System.Windows.Forms.MessageBox.Show("Error [SaveCSR] " & Err.Description & " #" & Err.Number, "", MessageBoxButtons.OK)
      GoTo SaveCSR_end

   End Function
   Public Function MakeHtm(ByVal sFile As String) As Integer
      MakeHtm = 0
      On Error Goto MakeHtm_err
      MakeHtm = -1

      Dim ol As MSOutl.Outline = Nothing

      '-------------------------------------------------------------------------------
      ' create and open a new htm file and save as the specified file name
      '-------------------------------------------------------------------------------

      Dim f As Integer = 0
      f = FileSystem.FreeFile()
      FileSystem.FileOpen(f,sFile,OpenMode.Output,OpenAccess.Default,OpenShare.Default,-1)

      '-------------------------------------------------------------------------------
      ' Add document header
      '-------------------------------------------------------------------------------

      FileSystem.PrintLine(f,"<HTML>")
      FileSystem.PrintLine(f,"<HEAD>")
      FileSystem.PrintLine(f,"<TITLE>" & gsMAKName & "</TITLE>")
      FileSystem.PrintLine(f,"</HEAD>")

      '-------------------------------------------------------------------------------
      ' Walk the outline adding the outline contents to the word doc.  Use Header styles
      ' for indent levels < 3.
      '-------------------------------------------------------------------------------

      ol = frmVbScan.DefInstance.OL1

      Dim sStyle As String = ""
      Dim sText As String = ""
      Dim iBgn As Integer = 0
      Dim i As Integer = 0

      For i = 0 To ol.ListCount - 1 Step 1

         If (ol.Indent(i) = 1) Then
            ol.Expand(i) = True
            ol.ListIndex = i
            ol.Refresh()
         End If


         sStyle = "p>"                      ' default style is none

         sText = ol.List(i)

         If (ol.Indent(i) < 3) Then
            sStyle = "H" & ol.Indent(i) & ">"
            If (ol.Indent(i) = 1) Then
               sText = Strings.UCase(sText)
            End If
         Else

            ' clean up doc comment lines

            If (sText = gsDocComment) Then
               sText = ""                         ' convert blank doc comments to blank line
            End If                             ' convert blank doc comments to blank line

            iBgn = Strings.InStr(1,sText,gsDocComment,CompareMethod.Text)
            If (iBgn <> 0) Then

               If (iBgn = 1) Then

                  ' strip the comment off of begin-of-line comments

                  iBgn = Strings.Len(gsDocComment) + 1
                  sText = Strings.Trim(Mid(sText,iBgn))
               Else

                  ' Cut the comment out of in-line comments and replace with a ":"

                  sText = Strings.Left(sText,iBgn - 1) & " : " & Mid(sText,iBgn + Strings.Len(gsDocComment))
               End If

            End If
         End If

         'sText = sText & "<p>"
         '
         'Debug.Print sStyle, sText

         If (sStyle <> "") Then
            FileSystem.PrintLine(f,"<" & sStyle & sText & "</" & sStyle)
         Else
            FileSystem.PrintLine(f,sText & Environment.NewLine)
         End If

      Next

      MakeHtm = 0

      '-------------------------------------------------------------------------------
      ' End HTML Generation
      '-------------------------------------------------------------------------------

      FileSystem.PrintLine(f,"</BODY>")
      FileSystem.PrintLine(f,"</HTML>")

   MakeHtm_err:

      FileSystem.FileClose(f)

      If (Err.Number <> 0) Then
         Err.Raise(Err.Number,"Error [MakeHtm] " & Err.Description,String.Empty)
      End If

   End Function
   Public Function SaveRtnOL() As Integer
      SaveRtnOL = 0
      On Error Goto SaveRtnOL_err
      SaveRtnOL = -1

      Dim oFile As String = ""
      Dim CMD1 As gmRTL.MSComDlg.CommonDialog = Nothing
      Dim sRtn As String = ""
      sRtn = Strings.Trim(frmRtnOL.DefInstance.Text)

      CMD1 = frmVbScan.DefInstance.CMD1

      CMD1.Filter = "VBScan Routine Files (*.CS1)|*.CS1"
      CMD1.DialogTitle = "Select Output File"
      CMD1.FilterIndex = 1
      CMD1.FileName = "VBSCAN.CS1"
      CMD1.CancelError = False
      CMD1.ShowSave()
      If (CMD1.FileName <> "") Then
         oFile = CMD1.FileName
      Else
         SaveRtnOL = 0
         Exit Function
      End If

      Dim i As Integer = 0
      Dim m As Integer = 0
      Dim cout As Integer = 0
      cout = 1
      Dim TABc As String = ""
      TABc = Strings.Chr(9)
      Dim ol As MSOutl.Outline = Nothing

      FileSystem.FileOpen(cout,oFile,OpenMode.Output,OpenAccess.Default,OpenShare.Default,-1)

      FileSystem.PrintLine(cout,sRtn)
      FileSystem.PrintLine(cout,"' ",Now)
      FileSystem.PrintLine(cout,"'",Strings.StrDup(80,"-"))
      FileSystem.PrintLine(cout,"")

      ol = frmRtnOL.DefInstance.OL1
      m = ol.ListCount
      For i = 0 To m - 1 Step 1
         FileSystem.PrintLine(cout,Strings.StrDup(ol.Indent(i) - 1,TABc) & ol.List(i))
      Next

      SaveRtnOL = 0

   SaveRtnOL_end:
      On Error Resume Next
      FileSystem.FileClose(cout)
      Exit Function

   SaveRtnOL_err:
      System.Windows.Forms.MessageBox.Show("Error [SaveRtnOL] " & Err.Description & " #" & Err.Number, "", MessageBoxButtons.OK)
      GoTo SaveRtnOL_end
   End Function
   Public Function ScanLine(ByVal sSource As String,ByVal sSrch() As String) As Integer
      ScanLine = 0

      On Error Goto ScanLine_err
      ScanLine = 0

      Dim i As Integer = 0
      Dim m As Integer = 0

      m = UBound(sSrch,1)

      For i = 1 To m Step 1
         If (Strings.InStr(1,sSource,sSrch(i),giCase) <> 0) Then
            ScanLine = 1
            Exit Function
         End If
      Next

      Exit Function

   ScanLine_err:
      System.Windows.Forms.MessageBox.Show("Error [ScanLine] " & Err.Description & " #" & Err.Number, "", MessageBoxButtons.OK)
      Exit Function

   End Function
   Public Function TrimWS(ByVal s_In As String) As String
      ' trim leading and trailing (tabs and spaces)

      TrimWS = ""

      Dim l As Integer = 0
      Dim i As Integer = 0
      Dim SOut As String = ""
      Dim c As String = ""
      Dim TABc As String = ""
      TABc = Strings.Chr(9)

      SOut = Strings.Trim(s_In)

      l = Strings.Len(SOut)
      If (l = 0) Then
         Exit Function
      End If

      For i = 1 To l Step 1
         c = Strings.Left(SOut,1)
         If (c = TABc Or c = " ") Then
            SOut = Strings.Right(SOut,l - 1)
            l = l - 1
         End If
      Next
      For i = l To 1 Step 1
         c = Strings.Right(SOut,1)
         If (c = TABc Or c = " ") Then
            SOut = Strings.Left(SOut,l - 1)
            l = l - 1
         End If
      Next
      TrimWS = SOut
   End Function
   Public Function Word(ByVal ss As String,ByVal i As Integer,Optional ByVal delim As String = " ") As String
      Word = ""
      ' Parse a blank delimeted string
      ' ss = string to be parsed
      ' i = number of the word to be returned
      '
      ' return the i'th word in string ss.  Words are delimited by blanks
      ' if i < 1 or i > number of words in ss, blank is returned

      On Error Goto Word_err
      Word = ""

      Dim s As String = ""
      s = Strings.Trim(ss)
      Dim l As Integer = 0
      l = Strings.Len(s)
      Dim c As Integer = 0
      c = 0                              ' word count
      Dim b As Integer = 0
      b = 1                              ' begining each parsed word
      Dim e As Integer = 0
      e = 0                              ' end of each parsed word

      If (l = 0) Then
         Exit Function
      End If
      If (i < 1) Then
         Exit Function
      End If

      Do While e <= l
         e = Strings.InStr(b,ss,delim,CompareMethod.Binary)

         If (e = 0) Then
            e = l + 1
         End If
         c = c + 1
         If (c = i) Then
            Word = Mid(ss,b,e - b)
            Exit Function
         End If
         For b = e To l Step 1
                                               ' skip white space
            If (Mid(ss,b,1) <> " ") Then
               Exit For
            End If
         Next
      Loop

      On Error Goto 0
      Exit Function

   Word_err:
      System.Windows.Forms.MessageBox.Show("Error [Word] " & Err.Description & " #" & Err.Number, "", MessageBoxButtons.OK)
      Exit Function
   End Function
   End Module
End Namespace
