My Blog: July 2011

'Namespace My
<Microsoft.VisualBasic.ComClass()> Public Class Util
 Private localCompName As String = ""
 Public Shared IPAdd As String = ""
 Private oFolder As Folder_Masked
 Private oFile As File_Masked
 Private oXML As XML_Masked

 Public Sub New()
 oFolder = New Folder_Masked
 oFile = New File_Masked
 oXML = New XML_Masked
 localCompName = CStr(System.Net.Dns.GetHostName())
 IPAdd = CStr(System.Net.Dns.GetHostByName(localCompName).AddressList(0).ToString)
 End Sub

 Public ReadOnly Property Folder() As Folder_Masked
 Get
 Return (oFolder)
 End Get
 End Property

 Public ReadOnly Property File() As File_Masked
 Get
 Return (oFile)
 End Get
 End Property

 Public ReadOnly Property XML() As XML_Masked
 Get
 Return (oXML)
 End Get
 End Property

 Public ReadOnly Property IPAddress() As String
 Get
 Return (IPAdd)
 End Get
 End Property

 Public ReadOnly Property ComputerName() As String
 Get
 Return (localCompName)
 End Get
 End Property

 Public ReadOnly Property WhoAmI() As String
 Get
 Return (Environment.UserDomainName & "\" & Environment.UserName)
 End Get
 End Property

 Public ReadOnly Property UserName() As String
 Get
 Return (Environment.UserName)
 End Get
 End Property

 Public Property ClipboardText() As String
 Get
 Return (CStr(System.Windows.Forms.Clipboard.GetText()))
 End Get
 Set(ByVal value As String)
 System.Windows.Forms.Clipboard.Clear()
 System.Windows.Forms.Clipboard.SetText(value)
 End Set
 End Property

 Public ReadOnly Property TimeStamp() As String
 Get
 Return (CStr(Format(Now, "ddMMMyy_HHmmss")))
 End Get
 End Property

 Public Function FormatUserDefDateTime(ByVal DateTime As Date, ByVal Pattern As String) As String
 Return (CStr(Format(DateTime, Pattern)))
 End Function

 Public Sub DisplayProgressbar(Optional ByVal TimeOut As Double = 5, Optional ByVal LabelText As String = "Please Wait...")
 Dim Form As New System.Windows.Forms.Form
 Dim Label As New System.Windows.Forms.Label
 Dim Pbar As New System.Windows.Forms.ProgressBar
 Dim Position As New System.Drawing.Point
 'Dim TimeOut As Integer
 Dim Iterations, i As Integer

 Iterations = TimeOut * 2 '(Seconds * 1000) / 500 Millisecons and Time Interval

 With Form
 'Position.X = 0 'System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width / 2 + 50
 'Position.Y = 0 'System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height / 2 + 50
 .Height = 100
 .Width = 200
 .Controls.Add(Label)
 .Controls.Add(Pbar)
 .Text = TimeOut & " Secs Remaining!!"
 .StartPosition = 1
 'Msgbox(.Left)
 'Msgbox(.Top)
 End With

 With Label
 .Visible = True
 .Text = LabelText
 .AutoSize = True
 End With

 Position.X = 0
 Position.Y = 30
 'Msgbox(CInt((100 / Iterations)))
 With Pbar
 .Style = 1
 .Minimum = 0
 .Maximum = Iterations
 .Value = 0
 '.Step = CInt((100 / Iterations))
 .Width = 180
 .Height = 30
 .Location = Position
 End With

 Form.Show()
 Form.BringToFront()

 'Timer1 = New System.Windows.Forms.Timer
 'Timer1.Stop()
 'Timer1.Interval = 500
 'Timer1.Start()

 'MsgBox("mmm")
 'Timer1.BeginInit()
 'ProgressBar1.Value = 80

 TimeOut = TimeOut + 0.5
 For i = 0 To Iterations
 Pbar.Increment(1)
 'Pbar.PerformStep()
 TimeOut = TimeOut - 0.5
 Form.Text = CInt(TimeOut) & " Secs Remaining!!"
 Form.Refresh()
 System.Threading.Thread.Sleep(500)
 Next
 'MsgBox("Disposing")
 Pbar.Dispose()
 Label.Dispose()
 Form.Dispose()
 Pbar = Nothing
 Label = Nothing
 Form = Nothing
 Position = Nothing
 TimeOut = Nothing
 Iterations = Nothing
 i = Nothing

 End Sub

 Public Sub SendKeys(ByVal KeySequence As String)
 Dim i, j, sqOpenBrcPos, sqCloseBrcPos As Integer
 Dim strKeysArr() As String
 Dim RepeatNo, newStr As String
 Dim KeyboardClass As New Microsoft.VisualBasic.Devices.Keyboard

 strKeysArr = Split(KeySequence, ">>")
 For i = 0 To UBound(strKeysArr)
 sqOpenBrcPos = InStr(1, strKeysArr(i), "[")
 sqCloseBrcPos = InStr(1, strKeysArr(i), "]")
 If sqOpenBrcPos > 0 And sqCloseBrcPos > 0 Then
 RepeatNo = Mid(strKeysArr(i), sqOpenBrcPos + 1, System.Math.Abs(sqCloseBrcPos - sqOpenBrcPos - 1))
 newStr = Left(strKeysArr(i), sqOpenBrcPos - 1)
 For j = 1 To CInt(RepeatNo)
 KeyboardClass.SendKeys(newStr, True)
 If (j Mod 8) = 0 Then
 System.Threading.Thread.Sleep(1000)
 End If ' Wait 1 if KeyStroke is more the 8 times
 Next
 Else
 System.Threading.Thread.Sleep(1000)
 KeyboardClass.SendKeys(strKeysArr(i), True)
 End If
 Next
 Erase strKeysArr
 i = Nothing
 KeyboardClass = Nothing
 sqOpenBrcPos = Nothing
 sqCloseBrcPos = Nothing
 strKeysArr = Nothing
 RepeatNo = Nothing
 newStr = Nothing
 End Sub

 Public Function CreatePDF(ByVal Path As String, Optional ByVal PDFFilePath As String = "") As String
 If Not (System.IO.File.Exists(Path)) Then
 Return ("File Does Not Exists")
 Exit Function
 Else
 KillProcessByName("pdfcreator")
 Dim FileName As String = Microsoft.VisualBasic.FileIO.FileSystem.GetName(Path)
 Dim DirectoryName As String = Microsoft.VisualBasic.FileIO.FileSystem.GetParentPath(Path)

 If Len(PDFFilePath) = 0 Then
 PDFFilePath = DirectoryName & "\" & Left(FileName, InStrRev(FileName, ".")) & "pdf"
 End If

 oFile.Delete(PDFFilePath)

 Dim oPDFCreator As Object = CreateObject("PDFCreator.clsPDFCreator")
 With oPDFCreator
 .cStart()
 .cVisible = False
 .cOption("UseAutosave") = 1
 .cOption("UseAutosaveDirectory") = 1
 .cOption("AutosaveFormat") = 0
 .cDefaultprinter = "PDFCreator"
 .cClearcache()
 .cPrinterStop = False
 .cOption("AutosaveDirectory") = DirectoryName
 .cOption("AutosaveFilename") = FileName
 .cPrintfile(Path)
 oFile.WaitTillExists(PDFFilePath, 20)
 .cClose()
 End With
 FileName = Nothing
 DirectoryName = Nothing
 oPDFCreator = Nothing
 Return (CStr(System.IO.File.Exists(PDFFilePath)))
 End If
 End Function

 Public Function EnvironmentVarGet(ByVal VariableName As String, Optional ByVal User_System As String = "User") As String
 Dim EnvVarTarget As Integer
 Select Case UCase(User_System)
 Case "USER" : EnvVarTarget = 1
 Case "SYSTEM" : EnvVarTarget = 2
 Case Else : EnvVarTarget = 1
 End Select
 Return (Environment.GetEnvironmentVariable(VariableName, EnvVarTarget))
 End Function

 Public Sub EnvironmentVarSet(ByVal VariableName As String, ByVal VarValue As String, Optional ByVal User_System As String = "User")
 Dim EnvVarTarget As Integer
 Select Case UCase(User_System)
 Case "USER" : EnvVarTarget = 1
 Case "SYSTEM" : EnvVarTarget = 2
 Case Else : EnvVarTarget = 1
 End Select
 Environment.SetEnvironmentVariable(VariableName, VarValue, EnvVarTarget)
 End Sub

 Public Function WaitTillEnvrionVarValue(ByVal VariableName As String, ByVal Value As String, Optional ByVal TimeOut As Integer = 120) As Boolean
 Value = LCase(Value)
 Dim StartTime As Double = Timer
 While Not (LCase(Environment.GetEnvironmentVariable(VariableName, 1)) = Value) And (TimeOut >= (Timer - StartTime))
 System.Threading.Thread.Sleep(1000)
 End While
 Return (LCase(Environment.GetEnvironmentVariable(VariableName, 1)) = Value)
 End Function

 Public Function ReplaceRegX(ByVal Text As String, ByVal Pattern As String, ByVal Replacement As String) As String
 If System.Text.RegularExpressions.Regex.IsMatch(Text, Pattern, System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline) Then
 Return (System.Text.RegularExpressions.Regex.Replace(Text, Pattern, Replacement, System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline))
 Else
 Return Text
 End If
 End Function

 Public Function RegXFirstMatch(ByVal Text As String, ByVal Pattern As String) As String
 If System.Text.RegularExpressions.Regex.IsMatch(Text, Pattern, System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline) Then
 Return (System.Text.RegularExpressions.Regex.Match(Text, Pattern, System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline).Value)
 Else
 Return ""
 End If
 End Function

 Public Function RemoveLeadingZeros(ByVal Text As String) As String
 If System.Text.RegularExpressions.Regex.IsMatch(Text, "[^0].*", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline) Then
 Return (System.Text.RegularExpressions.Regex.Match(Text, "[^0].*", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline).Value)
 Else
 Return Text
 End If
 End Function

 Public Function IsTagPresent(ByVal Text As String, Optional ByVal Tag As String = "[a-zA-Z][a-zA-Z0-9]") As Boolean
 Dim TagPattern As String = "<" & Tag & "*\b[^>]*>|</" & Tag & "*\b[^>]*>"
 Return (System.Text.RegularExpressions.Regex.IsMatch(Text, TagPattern, System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline))
 End Function

 Public Function OpeningTagsCount(ByVal Text As String) As Integer
 If System.Text.RegularExpressions.Regex.IsMatch(Text, "<[a-z][a-z0-9]*\b[^>]*>", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline) Then
 Return (System.Text.RegularExpressions.Regex.Matches(Text, "<[a-z][a-z0-9]*\b[^>]*>", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline).Count)
 Else
 Return 0
 End If
 End Function

 Public Function ReadFirstTagName(ByVal Text As String) As String
 Return (ReplaceRegX(RegXFirstMatch(Text, "<[a-z][a-z0-9]*\b[^>]*>"), "<|>", ""))
 End Function

 Public Function ReadTagValue(ByVal Text As String, ByVal Tag As String) As String
 If System.Text.RegularExpressions.Regex.IsMatch(Text, "<" & Tag & ">.*?</" & Tag & ">", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline) Then
 Dim FirstMatch As String
 FirstMatch = (System.Text.RegularExpressions.Regex.Match(Text, "<" & Tag & ">.*?</" & Tag & ">", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline).Value())
 Return (RemoveTagOnly(FirstMatch, Tag))
 Else
 Return ""
 End If
 End Function

 Public Function MaskTags(ByVal Text As String) As String
 Text = Replace(Text, "<", "<")
 Text = Replace(Text, ">", ">")
 Return (Text)
 End Function

 Public Function UnMaskTags(ByVal Text As String) As String
 Text = Replace(Text, "<", "<")
 Text = Replace(Text, ">", ">")
 Return (Text)
 End Function

 Public Function RemoveTagOnly(ByVal Text As String, ByVal Tag As String) As String
 Return (ReplaceRegX(Text, "<" & Tag & "*\b[^>]*>|</" & Tag & ">", ""))
 End Function

 Public Function RemoveTagWithText(ByVal Text As String, ByVal Tag As String) As String
 Return (ReplaceRegX(Text, "<" & Tag & "*\b[^>]*>.*?</" & Tag & ">", ""))
 End Function

 Public Function RemoveHTMLTags(ByVal Text As String) As String
 Text = RemoveTagOnly(Text, "html")
 Text = RemoveTagOnly(Text, "body")
 Text = RemoveTagOnly(Text, "tr")
 Text = RemoveTagOnly(Text, "td")
 Text = RemoveTagOnly(Text, "table")
 Text = RemoveTagOnly(Text, "br")
 Text = ReplaceRegX(Text, "|", "")
 Text = ReplaceRegX(Text, "|", "")
 Text = ReplaceRegX(Text, "|", "")
 Return (Text)
 End Function

 Public Function RemoveAllTags(ByVal Text As String) As String
 Return (ReplaceRegX(Text, "<[a-z][a-z0-9]*\b[^>]*>|</[a-z][a-z0-9]*\b[^>]*>", ""))
 End Function

 Public Function ReadSquareTagValue(ByVal Text As String) As String
 Return (ReplaceRegX(RegXFirstMatch(Text, "\[[\w\d]*\b[^\]]*\]"), "\[|\]", ""))
 End Function

 Public Function RemoveSquareTagsWithText(ByVal Text As String) As String
 Return (ReplaceRegX(Text, "\[[\w\d]*\b[^\]]*\]", ""))
 End Function

 Public Function ReadCurlyTagValue(ByVal Text As String) As String
 Return (ReplaceRegX(RegXFirstMatch(Text, "{[\w\d]*\b[^}]*}"), "{|}", ""))
 End Function

 Public Function RemoveCurlyTagsWithText(ByVal Text As String) As String
 Return (ReplaceRegX(Text, "{[\w\d]*\b[^}]*}", ""))
 End Function

 Public Function GetPixel(ByVal abs_x As Integer, ByVal abs_y As Integer) As Integer
 Dim BMP As New System.Drawing.Bitmap(1, 1)
 Dim GFX As System.Drawing.Graphics
 GFX = System.Drawing.Graphics.FromImage(BMP)
 GFX.CopyFromScreen(New System.Drawing.Point(abs_x, abs_y), New System.Drawing.Point(0, 0), BMP.Size)
 Dim Pixel As System.Drawing.Color = BMP.GetPixel(0, 0)
 BMP.Dispose()
 GFX.Dispose()
 BMP = Nothing
 GFX = Nothing
 Return (System.Drawing.ColorTranslator.ToWin32(Pixel))
 End Function

 Public Function RunDosCommand(ByVal Command As String) As String
 Dim Cmdlet As New System.Diagnostics.Process
 Dim Output As String = ""
 With Cmdlet.StartInfo
 .FileName = "cmd.exe" 'starts cmd window
 .RedirectStandardInput = True
 .RedirectStandardOutput = True
 .RedirectStandardError = True
 .UseShellExecute = False 'required to redirect
 .CreateNoWindow = True '<—- creates no window, obviously
 End With
 With Cmdlet
 .Start()
 .StandardInput.WriteLine("@echo off")
 .StandardInput.WriteLine("cls")

 While .StandardOutput.ReadLine <> "cls"
 'Debug.WriteLine(.StandardOutput.ReadLine)
 End While
 .StandardInput.WriteLine(Command)
 .StandardOutput.ReadLine()
 .StandardInput.WriteLine("exit")
 Output = .StandardError.ReadToEnd()
 If Len(Output) = 0 Then
 Output = .StandardOutput.ReadToEnd()
 If Len(Output) <= 6 Then
 Output = ""
 Else
 Output = Microsoft.VisualBasic.Strings.Left(Output, Len(Output) - 8)
 End If
 Else
 Output = "Err: " & Output
 End If
 End With
 Cmdlet.Dispose()
 Return (Output)
 End Function

 Public Sub RunProcess(ByVal FileName As String)
 Dim Process As New System.Diagnostics.Process
 Process.StartInfo.FileName = FileName
 Process.Start()
 Process.Dispose()
 Process = Nothing
 End Sub

 Public Sub KillProcessByName(ByVal ProcessName As String)
 If Len(ProcessName) = 0 Then
 Exit Sub
 Else
 Dim Proc As System.Diagnostics.Process
 Dim MatchingProcess() As System.Diagnostics.Process = System.Diagnostics.Process.GetProcessesByName(ProcessName)
 For Each Proc In MatchingProcess
 Proc.Kill()
 Next
 Proc = Nothing
 Erase MatchingProcess
 MatchingProcess = Nothing
 End If

 End Sub

 'Public Sub AppendTextToWord(ByRef oWord As Object, ByVal TextToPrint As String, Optional ByVal ImagePath As String = "")
 ' Dim oRegX As New System.Text.RegularExpressions.Regex("<[a-zA-Z][a-zA-Z0-9]*\b[^>]*>|</[a-zA-Z][a-zA-Z0-9]*\b[^>]*>", Text.RegularExpressions.RegexOptions.Multiline Or Text.RegularExpressions.RegexOptions.IgnoreCase)
 ' Dim Match As System.Text.RegularExpressions.Match
 ' Dim TagValue As String = ""
 ' Dim TagLocation As Integer = 0
 ' Dim CurrRow As Integer = 0
 ' Dim CurrCol As Integer = 0

 ' oWord = New Microsoft.Office.Interop.Word.Application
 ' oWord.Documents.Add()

 ' 'oWord = System.Runtime.InteropServices.Marshal.GetActiveObject("Word.Application")
 ' 'oWord.Documents.Add()
 ' oWord.Visible = True

 ' Dim Selection As Object = oWord.Selection

 ' With oWord.Selection
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' .Font.Underline = 0
 ' .Font.Italic = False
 ' .EndKey(6)
 ' .TypeParagraph()

 ' Do
 ' Match = oRegX.Match(TextToPrint)
 ' If Not (Match.Success) Then
 ' .TypeText(TextToPrint)
 ' Match = Nothing
 ' oRegX = Nothing
 ' Exit Do
 ' End If
 ' TagValue = Match.Value
 ' TagLocation = Match.Index

 ' If TagLocation = 0 Then
 ' Select Case LCase(TagValue)
 ' Case "" : .Font.Bold = True
 ' Case "" : .Font.Bold = False
 ' Case "" : .Font.Underline = 1
 ' Case "" : .Font.Underline = 0
 ' Case "" : .Font.Italic = True
 ' Case "" : .Font.Italic = False
 ' Case " " : .TypeParagraph()
 ' Case "<red>" : .Font.ColorIndex = 6
 ' Case "<blue>" : .Font.ColorIndex = 2
 ' Case "<green>" : .Font.ColorIndex = 4
 ' Case "" : .Font.ColorIndex = 1
 ' Case "<good>"
 ' .Font.ColorIndex = 4
 ' .Font.Bold = True
 ' .Font.Italic = True
 ' Case "<bad>"
 ' .Font.ColorIndex = 6
 ' .Font.Bold = True
 ' Case "<warn>"
 ' .Font.ColorIndex = 2
 ' .Font.Bold = True
 ' .Font.Underline = 1
 ' Case "</good>"
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' .Font.Italic = False
 ' Case "</bad>"
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' Case "</warn>"
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' .Font.Underline = 0
 ' Case "<table border = ""1"">"
 ' oWord.ActiveDocument.Tables.Add(oWord.Selection.Range, 1, 1, 1, 2) 'Add Single Cell
 ' Case "<tr>"
 ' CurrRow = CurrRow + 1
 ' CurrCol = 0
 ' If CurrRow > 1 Then
 ' .Tables(1).Rows.Add()
 ' End If
 ' Case "<td>"
 ' CurrCol = CurrCol + 1
 ' If CurrCol > .Tables(1).Columns.Count Then
 ' .Tables(1).Columns.Add()
 ' End If
 ' .Tables(1).Cell(CurrRow, CurrCol).Select()
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' .Font.Underline = 0
 ' .Font.Italic = False
 ' Case "</td>"
 ' .Tables(1).Columns.AutoFit()
 ' End Select
 ' TextToPrint = oRegX.Replace(TextToPrint, "", 1)
 ' Else
 ' .TypeText(Left(TextToPrint, TagLocation))
 ' TextToPrint = Right(TextToPrint, Len(TextToPrint) - TagLocation)
 ' End If

 ' Loop While Len(TextToPrint) > 0
 ' End With

 'End Sub

 'Public Sub PrintTextToWord(ByRef oWord, ByVal TextToPrint)

 ' Dim oRegX As New System.Text.RegularExpressions.Regex("<[a-zA-Z][a-zA-Z0-9]*\b[^>]*>|</[a-zA-Z][a-zA-Z0-9]*\b[^>]*>", Text.RegularExpressions.RegexOptions.Multiline Or Text.RegularExpressions.RegexOptions.IgnoreCase)
 ' Dim Match As System.Text.RegularExpressions.Match
 ' 'Dim Matches As System.Text.RegularExpressions.MatchCollection
 ' Dim TagValue As String = ""
 ' Dim TagLocation As Integer = 0
 ' Dim CurrRow As Integer = 0
 ' Dim CurrCol As Integer = 0

 ' oWord = GetObject(, "Word.Application")
 ' oWord.Visible = True

 ' Dim Selection = oWord.Selection

 ' With oWord.Selection
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' .Font.Underline = 0
 ' .Font.Italic = False
 ' .EndKey(6)
 ' .TypeParagraph()

 ' Do
 ' Match = oRegX.Match(TextToPrint)
 ' If Not (Match.Success) Then
 ' .TypeText(TextToPrint)
 ' Match = Nothing
 ' oRegX = Nothing
 ' Exit Do
 ' End If
 ' TagValue = Match.Value
 ' TagLocation = Match.Index

 ' If TagLocation = 0 Then
 ' Select Case LCase(TagValue)
 ' Case "" : .Font.Bold = True
 ' Case "" : .Font.Bold = False
 ' Case "" : .Font.Underline = 1
 ' Case "" : .Font.Underline = 0
 ' Case "" : .Font.Italic = True
 ' Case "" : .Font.Italic = False
 ' Case " " : .TypeParagraph()
 ' Case "<red>" : .Font.ColorIndex = 6
 ' Case "<blue>" : .Font.ColorIndex = 2
 ' Case "<green>" : .Font.ColorIndex = 4
 ' Case "" : .Font.ColorIndex = 1
 ' Case "<good>"
 ' .Font.ColorIndex = 4
 ' .Font.Bold = True
 ' .Font.Italic = True
 ' Case "<bad>"
 ' .Font.ColorIndex = 6
 ' .Font.Bold = True
 ' Case "<warn>"
 ' .Font.ColorIndex = 2
 ' .Font.Bold = True
 ' .Font.Underline = 1
 ' Case "</good>"
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' .Font.Italic = False
 ' Case "</bad>"
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' Case "</warn>"
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' .Font.Underline = 0
 ' Case "<table border = ""1"">"
 ' oWord.ActiveDocument.Tables.Add(Selection.Range, 1, 1, 1, 2) 'Add Single Cell
 ' Case "<tr>"
 ' CurrRow = CurrRow + 1
 ' CurrCol = 0
 ' If CurrRow > 1 Then
 ' .Tables(1).Rows.Add()
 ' End If
 ' Case "<td>"
 ' CurrCol = CurrCol + 1
 ' If CurrCol > .Tables(1).Columns.Count Then
 ' .Tables(1).Columns.Add()
 ' End If
 ' .Tables(1).Cell(CurrRow, CurrCol).Select()
 ' .Font.ColorIndex = 1
 ' .Font.Bold = False
 ' .Font.Underline = 0
 ' .Font.Italic = False
 ' Case "</td>"
 ' .Tables(1).Columns.AutoFit()
 ' End Select
 ' TextToPrint = oRegX.Replace(TextToPrint, "")
 ' Else
 ' .TypeText(Left(TextToPrint, TagLocation))
 ' TextToPrint = Right(TextToPrint, Len(TextToPrint) - TagLocation)
 ' End If

 ' Loop While Len(TextToPrint) > 0
 ' End With

 'End Sub

 Public Sub CaptureScreen(ByVal path As String)
 oFile.Delete(path)
 Dim BMP As System.Drawing.Bitmap = New System.Drawing.Bitmap(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
 Dim gfx As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(BMP)
 gfx.CopyFromScreen(My.Computer.Screen.Bounds.X, My.Computer.Screen.Bounds.Y, 0, 0, System.Windows.Forms.Screen.PrimaryScreen.Bounds.Size, System.Drawing.CopyPixelOperation.SourceCopy)
 BMP.Save(path, System.Drawing.Imaging.ImageFormat.Png)
 gfx.Dispose()
 BMP.Dispose()
 gfx = Nothing
 BMP = Nothing
 End Sub

 Public Sub AddtoZip(ByVal ZipFileName As String, ByVal FileOrFolderPath As String)
 If oFolder.Exists(FileOrFolderPath) Or oFile.Exists(FileOrFolderPath) Then
 If Not (System.IO.File.Exists(ZipFileName)) Then
 oFile.AddText(ZipFileName, "PK" & Chr(5) & Chr(6) & StrDup(18, vbNullChar), True, False)
 End If
 Dim oShellApp As Object = CreateObject("Shell.Application")
 Dim ExistingFilesCountInZip As Integer = oShellApp.Namespace((ZipFileName)).Items.Count
 Dim NewFilesCountInZip As Integer = ExistingFilesCountInZip
 Dim StartTime As Double = Timer
 oShellApp.Namespace((ZipFileName)).Copyhere((FileOrFolderPath))
 Do
 System.Threading.Thread.Sleep(1000)
 oFile.WaitTillExists(ZipFileName, 180)
 NewFilesCountInZip = oShellApp.Namespace((ZipFileName)).Items.Count
 Loop While (ExistingFilesCountInZip >= NewFilesCountInZip) And (180 >= (Timer - StartTime))
 StartTime = Nothing
 NewFilesCountInZip = Nothing
 ExistingFilesCountInZip = Nothing
 oShellApp = Nothing
 End If
 End Sub

 Public Sub Unzip(ByVal ZipFileName As String, ByVal DestinationFolder As String)
 If oFile.Exists(ZipFileName) Then
 Dim oShellApp As Object = CreateObject("Shell.Application")
 Dim filesInzip As Object = oShellApp.Namespace((ZipFileName)).Items
 If Not (oFolder.Exists(DestinationFolder)) Then
 oFolder.Create(DestinationFolder)
 End If
 oShellApp.Namespace((DestinationFolder)).CopyHere((filesInzip))
 filesInzip = Nothing
 oShellApp = Nothing
 End If
 End Sub

 Public Sub DownloadFile(ByVal URL As String, ByVal DestinationFullName As String)
 Dim oNet As New Microsoft.VisualBasic.Devices.Network
 oNet.DownloadFile(URL, DestinationFullName)
 oNet = Nothing
 End Sub

 Public Function Ping(ByVal HostNameOrIP As String, Optional ByVal TimeOutInMilliSec As Integer = 4000) As Boolean
 Dim ReturnValue As Boolean = False
 Dim oNet As New Microsoft.VisualBasic.Devices.Network
 ReturnValue = oNet.Ping(HostNameOrIP, TimeOutInMilliSec)
 Return (ReturnValue)
 End Function

 Public Function CanConvertToDouble(ByVal Value As String) As Boolean
 On Error Resume Next
 Err.Clear()
 Value = CDbl(Value)
 If Err.Number > 0 Then
 Return False
 Else
 Return True
 End If
 End Function

 Public Function CanConvertToDate(ByVal Value As String) As Boolean
 On Error Resume Next
 Err.Clear()
 Value = CDate(Value)
 If Err.Number > 0 Then
 Return False
 Else
 Return True
 End If

 End Function

 Public Sub Dispose()
 oFile = Nothing
 oXML = Nothing
 oFolder = Nothing
 System.GC.Collect()
 MyBase.Finalize()
 'MsgBox("Exit")
 End Sub

 Protected Overrides Sub Finalize()
 Dispose()
 End Sub

End Class

<Microsoft.VisualBasic.ComClass()> Public Class Folder_Masked

 Public Function Exists(ByVal Path As String) As Boolean
 Return (System.IO.Directory.Exists(Path))
 End Function

 Public Sub Create(ByVal Path As String)
 Delete(Path)
 System.IO.Directory.CreateDirectory(Path)
 End Sub

 Public Sub Delete(ByVal Path As String)
 If System.IO.Directory.Exists(Path) Then
 System.IO.Directory.Delete(Path, True)
 End If
 End Sub

 Public Function GetSubFolders(ByVal Path As String, Optional ByVal SearchPattern As String = "*") As String
 Return (Join(System.IO.Directory.GetDirectories(Path, SearchPattern), "|"))
 End Function

 Public Function GetFilesInFolder(ByVal Path As String, Optional ByVal SearchPattern As String = "*.*") As String
 Return (Join(System.IO.Directory.GetFiles(Path, SearchPattern), "|"))
 End Function

 Public Function GetCreationDate(ByVal Path As String) As Date
 Dim CreationDate As Date
 If System.IO.Directory.Exists(Path) Then
 CreationDate = System.IO.Directory.GetCreationTime(Path)
 End If
 Return (CreationDate)
 End Function

 Public Sub SetCreationDate(ByVal Path As String, ByVal CreationDate As Date)
 If System.IO.Directory.Exists(Path) Then
 System.IO.Directory.SetCreationTime(Path, CreationDate)
 End If
 End Sub

 Public Sub MoveOrRename(ByVal Source As String, ByVal Destination As String)
 System.IO.Directory.Move(Source, Destination)
 End Sub

 Public Function GetSize(ByVal Path As String) As Double
 Dim Size As Double
 If System.IO.Directory.Exists(Path) Then
 Dim fso As Object = CreateObject("Scripting.FileSystemObject")
 Dim f As Object = fso.GetFolder(Path)
 Size = f.size
 f = Nothing
 fso = Nothing
 End If
 If Size > 0 Then
 Size = (Size / 1024) / 1024
 End If
 Return (FormatNumber(Size, 2))
 End Function

 Protected Overrides Sub Finalize()
 System.GC.Collect()
 MyBase.Finalize()
 End Sub

End Class

<Microsoft.VisualBasic.ComClass()> Public Class File_Masked

 Public Function Exists(ByVal Path As String) As Boolean
 Return (System.IO.File.Exists(Path))
 End Function

 Public Sub Copy(ByVal Source As String, ByVal Destination As String, Optional ByVal SearchPatern As String = "")
 If Len(SearchPatern) > 0 Then
 If Right(Destination, 1) <> "\" Then
 Destination = Destination & "\"
 End If
 Dim Files As Object = System.IO.Directory.GetFiles(Source, SearchPatern)
 Dim File As Object
 Dim SrcFileName As String
 For Each File In Files
 SrcFileName = Right(File.ToString, (Len(File.ToString) - InStrRev(File.ToString, "\")))
 System.IO.File.Copy(File.ToString, Destination & SrcFileName)
 WaitTillExists(Destination & SrcFileName)
 Next
 File = Nothing
 Erase Files
 SrcFileName = Nothing
 Files = Nothing
 Else
 Delete(Destination)
 System.IO.File.Copy(Source, Destination, True)
 WaitTillExists(Destination)
 End If
 End Sub

 Public Function WaitTillExists(ByVal Path As String, Optional ByVal TimeOut As Double = 120) As Boolean
 Dim StartTime As Double = Timer
 While Not (System.IO.File.Exists(Path)) And (TimeOut >= (Timer - StartTime))
 System.Threading.Thread.Sleep(1000)
 End While
 Return (System.IO.File.Exists(Path))
 End Function

 Public Function WaitTillDeleted(ByVal Path As String, Optional ByVal TimeOut As Double = 120) As Boolean
 Dim StartTime As Double = Timer
 While System.IO.File.Exists(Path) And (TimeOut >= (Timer - StartTime))
 System.Threading.Thread.Sleep(1000)
 End While
 Return (Not (System.IO.File.Exists(Path)))
 End Function

 Public Sub AddText(ByVal Path As String, ByVal Contents As String, Optional ByVal ClearExistingContent As Boolean = False, Optional ByVal AppendNewLine As Boolean = True)
 If AppendNewLine Then
 Contents = Contents & vbNewLine
 End If
 If ClearExistingContent Then
 Delete(Path)
 End If
 System.IO.File.AppendAllText(Path, Contents)
 End Sub

 Public Sub Delete(ByVal Path As String, Optional ByVal SearchPatern As String = "")
 If Len(SearchPatern) > 0 Then
 Dim Files As Object = System.IO.Directory.GetFiles(Path, SearchPatern)
 Dim File As Object
 For Each File In Files
 System.IO.File.Delete(File)
 Next
 File = Nothing
 Erase Files
 Files = Nothing
 Else
 If System.IO.File.Exists(Path) Then
 System.IO.File.Delete(Path)
 End If
 End If
 End Sub

 Public Sub DeleteFilesBeforeDate(ByVal DirectoryPath As String, ByVal BeforeDate As Date)
 If System.IO.Directory.Exists(DirectoryPath) Then
 Dim FilesStr() As String
 Dim f As String
 FilesStr = System.IO.Directory.GetFiles(DirectoryPath)
 For Each f In FilesStr
 If System.IO.File.GetCreationTime(f) < BeforeDate Then
 System.IO.File.Delete(f)
 End If
 Next
 Erase FilesStr
 End If
 End Sub

 Public Function ReadAll(ByVal Path As String) As String
 Return (System.IO.File.ReadAllText(Path))
 End Function

 Public Function GetNewName(ByVal FileFullName As String) As String
 Dim NewName As String = ""
 Dim path As String = ""
 Dim filename As String = ""
 Dim filenameWOextn As String = ""
 Dim fileExtn As String = ""
 Dim i As Integer = 1
 path = Microsoft.VisualBasic.Strings.Left(FileFullName, InStrRev(FileFullName, "\"))
 filename = Microsoft.VisualBasic.Strings.Right(FileFullName, Len(FileFullName) - Len(path))
 filenameWOextn = Microsoft.VisualBasic.Strings.Left(filename, InStrRev(filename, ".") - 1)
 fileExtn = Microsoft.VisualBasic.Strings.Right(filename, Len(filename) - Len(filenameWOextn))

 Do
 NewName = path & filenameWOextn & "_" & i & fileExtn
 i += 1
 Loop While System.IO.File.Exists(NewName)

 path = Nothing
 filename = Nothing
 filenameWOextn = Nothing
 fileExtn = Nothing
 i = Nothing

 Return (NewName)
 End Function

 Public Function GetCreationDate(ByVal Path As String) As Date
 Dim CreationDate As Date
 If System.IO.File.Exists(Path) Then
 CreationDate = System.IO.File.GetCreationTime(Path)
 End If
 Return (CreationDate)
 End Function

 Public Sub SetCreationDate(ByVal Path As String, ByVal CreationDate As Date)
 If System.IO.File.Exists(Path) Then
 System.IO.File.SetCreationTime(Path, CreationDate)
 End If
 End Sub

 Public Sub MoveOrRename(ByVal Source As String, ByVal Destination As String, Optional ByVal SearchPatern As String = "")
 If Len(SearchPatern) > 0 Then
 If Right(Destination, 1) <> "\" Then
 Destination = Destination & "\"
 End If
 Dim Files As Object = System.IO.Directory.GetFiles(Source, SearchPatern)
 Dim File As Object
 Dim SrcFileName As String
 For Each File In Files
 SrcFileName = Right(File.ToString, (Len(File.ToString) - InStrRev(File.ToString, "\")))
 System.IO.File.Move(File.ToString, Destination & SrcFileName)
 WaitTillExists(Destination & SrcFileName)
 Next
 File = Nothing
 Erase Files
 SrcFileName = Nothing
 Files = Nothing
 Else
 System.IO.Directory.Move(Source, Destination)
 WaitTillExists(Destination)

 End If
 End Sub

 Public Function GetSize(ByVal Path As String) As Double
 Dim Size As Double
 If System.IO.File.Exists(Path) Then
 Size = Microsoft.VisualBasic.FileSystem.FileLen(Path)
 End If
 If Size > 0 Then
 Size = (Size / 1024) / 1024
 End If
 Return (FormatNumber(Size, 2))
 End Function

 Public Function Lock(ByVal FileFullName As String, Optional ByVal Comment As String = "", Optional ByVal TimeOut As Integer = 60) As Boolean
 Dim StartTime As Double = Timer
 While IsFileLocked(FileFullName) And (TimeOut >= (Timer - StartTime))
 System.Threading.Thread.Sleep(CInt((Rnd() * 10000)))
 End While
 If Not (IsFileLocked(FileFullName)) Then
 AddText(FileFullName & ".lck.txt", CStr(Format(Now, "ddMMMyy_HHmmss")) & ":" & Util.IPAdd & ":" & System.Diagnostics.Process.GetCurrentProcess.ProcessName() & Comment, True, False)
 Return (True)
 Else
 Return (False)
 End If
 End Function

 Public Function IsFileLocked(ByVal FileFullName As String) As Boolean
 Return (System.IO.File.Exists(FileFullName & ".lck.txt"))
 End Function

 Public Sub UnLock(ByVal FileFullName As String)
 Delete(FileFullName & ".lck.txt")
 End Sub

 Protected Overrides Sub Finalize()
 System.GC.Collect()
 MyBase.Finalize()
 End Sub

End Class

<Microsoft.VisualBasic.ComClass()> Public Class XML_Masked
 Private XMLPath As String = "c:\temp\temp.xml"
 Private XmlDoc As New System.Xml.XmlDocument
 Private XMLAutoSave As Boolean = True
 Private LowerCaseXpaths As Boolean = True

 Public Property FilePath(Optional ByVal AutoSave As Boolean = True) As String
 Get
 Return (XMLPath)
 End Get
 Set(ByVal value As String)
 XMLPath = value
 XMLAutoSave = AutoSave
 If System.IO.File.Exists(XMLPath) Then
 XmlDoc.Load(XMLPath)
 End If
 End Set
 End Property

 Public Property LowerCasePath() As Boolean
 Get
 Return LowerCaseXpaths
 End Get
 Set(ByVal value As Boolean)
 LowerCaseXpaths = value
 End Set
 End Property

 Private Function RectifyXpath(ByVal Xpath As String) As String
 If Len(Xpath) > 0 Then
 Xpath = Replace(Xpath, "\", "/")
 Xpath = Replace(Xpath, """", "'")
 If (Right(Xpath, 1) = "/") Then
 Xpath = Left(Xpath, Len(Xpath) - 1)
 End If

 If LowerCaseXpaths Then
 Xpath = LowerCaseXPath(Xpath)
 'Xpath = LCase(Xpath)
 End If
 End If
 Return Xpath
 End Function

 Private Function LowerCaseXPath(ByVal XPath As String) As String
 Dim RegXMatch As System.Text.RegularExpressions.Match
 Dim NewXpath As String = ""
 Dim PredicateValue As String
 Dim PredicateLocation As Integer
 Dim PredicateValueLen As Integer

 Dim TempArr As String()

 Do
 RegXMatch = System.Text.RegularExpressions.Regex.Match(XPath, "(?<!@)(?<=\[|\s)[\w\d\.]+='[^']*'", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline)
 ' .Match(abc)
 If Not (RegXMatch.Success) Then
 NewXpath = NewXpath & LCase(XPath)
 Exit Do
 End If
 PredicateValue = RegXMatch.Value
 PredicateValueLen = Len(PredicateValue)
 PredicateLocation = RegXMatch.Index
 Erase TempArr
 TempArr = Split(PredicateValue, "=")
 PredicateValue = LCase(TempArr(0)) & "=" & TempArr(1)

 'to increment
 NewXpath = NewXpath & LCase(Microsoft.VisualBasic.Left(XPath, PredicateLocation)) & PredicateValue
 XPath = Microsoft.VisualBasic.Right(XPath, Len(XPath) - (PredicateLocation + PredicateValueLen))
 Loop While Len(XPath) > 0
 RegXMatch = Nothing
 Erase TempArr
 Return NewXpath
 End Function

 Public Function CreateNewXML(ByVal path As String, Optional ByVal RootNodeText As String = "Parent") As Boolean
 If System.IO.File.Exists(path) Then
 System.IO.File.Delete(path)
 End If
 If LowerCaseXpaths Then
 RootNodeText = LCase(RootNodeText)
 End If
 XMLPath = path
 Dim writer As New System.Xml.XmlTextWriter(path, System.Text.Encoding.UTF8)
 writer.WriteStartDocument(True)
 writer.Formatting = System.Xml.Formatting.Indented
 writer.Indentation = 2
 writer.WriteStartElement(RootNodeText)
 writer.WriteEndElement()
 writer.WriteEndDocument()
 writer.Close()
 writer = Nothing
 XmlDoc.Load(path)
 Return (System.IO.File.Exists(path))
 End Function

 Public Function NodeExists(ByVal Xpath As String) As Boolean
 Xpath = RectifyXpath(Xpath)
 Dim ReturnValue As String = ""
 Dim xmlnode As Xml.XmlNode = XmlDoc.SelectSingleNode(Xpath)
 If xmlnode Is Nothing Then
 ReturnValue = False
 Else
 ReturnValue = True
 End If
 xmlnode = Nothing
 Return (ReturnValue)
 End Function

 Public Function GetChildCount(ByVal Xpath As String) As Integer
 Xpath = RectifyXpath(Xpath)
 Dim ReturnValue As Integer = 0
 Dim xmlnode As Xml.XmlNode = XmlDoc.SelectSingleNode(Xpath)
 If xmlnode Is Nothing Then
 ReturnValue = 0
 Else
 ReturnValue = xmlnode.ChildNodes.Count
 End If
 xmlnode = Nothing
 Return (ReturnValue)
 End Function

 Public Function GetSibilingCount(ByVal Xpath As String) As Integer
 Xpath = RectifyXpath(Xpath)
 Dim ReturnValue As Integer = 0
 Dim xmlnodes As Xml.XmlNodeList = XmlDoc.SelectNodes(Xpath)
 If xmlnodes Is Nothing Then
 ReturnValue = 0
 Else
 ReturnValue = xmlnodes.Count
 End If
 xmlnodes = Nothing
 Return (ReturnValue)
 End Function

 Public Function GetNodeText(ByVal Xpath As String) As String
 Xpath = RectifyXpath(Xpath)
 Dim ReturnValue As String = ""
 Dim xmlnode As Xml.XmlNode = XmlDoc.SelectSingleNode(Xpath)
 If xmlnode Is Nothing Then
 ReturnValue = ""
 Else
 ReturnValue = xmlnode.InnerText()
 End If
 xmlnode = Nothing
 Return (ReturnValue)
 End Function

 Public Function GetCousinNodeText(ByVal ChildXPath As String, ByVal GrandParentNodeName As String, ByVal CousinXPathFromGrandParent As String) As String
 ChildXPath = RectifyXpath(ChildXPath)
 CousinXPathFromGrandParent = RectifyXpath(CousinXPathFromGrandParent)
 If LowerCaseXpaths Then
 GrandParentNodeName = LCase(GrandParentNodeName)
 End If

 Dim ReturnValue As String = ""
 Dim NodeFound As Boolean = False
 Dim ChildNode As Xml.XmlNode = XmlDoc.SelectSingleNode(ChildXPath)
 Dim XmlNode As Xml.XmlNode

 If ChildNode Is Nothing Then
 ReturnValue = ""
 Else
 'XmlNo\\
 Do Until ChildNode.ParentNode Is Nothing
 If ChildNode.Name = GrandParentNodeName Then
 NodeFound = True
 Exit Do
 End If
 ChildNode = ChildNode.ParentNode
 Loop
 If NodeFound Then
 XmlNode = ChildNode.SelectSingleNode(CousinXPathFromGrandParent)
 If XmlNode Is Nothing Then
 ReturnValue = ""
 Else
 ReturnValue = XmlNode.InnerText()
 End If
 End If
 End If
 ChildNode = Nothing
 XmlNode = Nothing
 Return (ReturnValue)
 End Function

 Public Sub SetNodeText(ByVal Xpath As String, ByVal Value As String)
 Xpath = RectifyXpath(Xpath)
 Dim xmlnode As Xml.XmlNode = XmlDoc.SelectSingleNode(Xpath)
 If xmlnode Is Nothing Then
 Dim ParentXpath As String
 Dim NodeName As String
 NodeName = Right(Xpath, Len(Xpath) - InStrRev(Xpath, "/"))
 ParentXpath = Left(Xpath, Len(Xpath) - Len(NodeName) - 1)
 AppendNode(NodeName, ParentXpath, Value)
 NodeName = Nothing
 ParentXpath = Nothing
 Else
 xmlnode.InnerText = Value
 End If
 If XMLAutoSave Then
 XmlDoc.Save(XMLPath)
 End If
 xmlnode = Nothing
 End Sub

 Public Sub AppendNode(ByVal NodeName As String, Optional ByVal ParentXpath As String = "", Optional ByVal NodeInnerText As String = "", Optional ByVal NodeAttributeNameValuePair As String = "")
 If Not (System.IO.File.Exists(XMLPath)) Then
 CreateNewXML(XMLPath)
 End If
 If LowerCaseXpaths Then
 ParentXpath = RectifyXpath(ParentXpath)
 NodeName = LCase(NodeName)
 NodeAttributeNameValuePair = LCase(NodeAttributeNameValuePair)
 End If
 Dim xmlnode As Xml.XmlNode = XmlDoc.CreateElement(NodeName)
 If Len(NodeInnerText) > 0 Then
 xmlnode.InnerText = NodeInnerText
 End If
 If Len(NodeAttributeNameValuePair) > 0 Then
 NodeAttributeNameValuePair = Replace(NodeAttributeNameValuePair, " ", "")
 Dim AttrValueNodePair(1) As String
 AttrValueNodePair = Split(NodeAttributeNameValuePair, ":=")
 Dim AttrNode As System.Xml.XmlNode = XmlDoc.CreateAttribute(AttrValueNodePair(0))
 AttrNode.Value = AttrValueNodePair(1)
 xmlnode.Attributes.Append(AttrNode)
 Erase AttrValueNodePair
 AttrValueNodePair = Nothing
 AttrNode = Nothing
 End If
 If Len(ParentXpath) = 0 Then
 XmlDoc.DocumentElement.AppendChild(xmlnode)
 Else
 Dim ParentNode As System.Xml.XmlNode = XmlDoc.SelectSingleNode(ParentXpath)
 ParentNode.AppendChild(xmlnode)
 ParentNode = Nothing
 End If

 If XMLAutoSave Then
 XmlDoc.Save(XMLPath)
 End If
 xmlnode = Nothing
 End Sub

 Public Sub RemoveNode(ByVal Xpath As String)
 Xpath = RectifyXpath(Xpath)
 Dim NodeToRemove As System.Xml.XmlNode = XmlDoc.SelectSingleNode(Xpath)
 Dim ParentNode As System.Xml.XmlNode = NodeToRemove.ParentNode
 ParentNode.RemoveChild(NodeToRemove)
 If XMLAutoSave Then
 XmlDoc.Save(XMLPath)
 End If
 NodeToRemove = Nothing
 ParentNode = Nothing
 End Sub

 Public Function AttributeExists(ByVal Xpath As String, ByVal AttributeName As String) As Boolean
 Xpath = RectifyXpath(Xpath)
 If LowerCaseXpaths Then
 AttributeName = LCase(AttributeName)
 End If
 Dim AttributeNode As System.Xml.XmlAttribute
 Dim ReturnValue As String
 AttributeNode = XmlDoc.SelectSingleNode(Xpath).Attributes.GetNamedItem(AttributeName)
 If AttributeNode Is Nothing Then
 ReturnValue = False
 Else
 ReturnValue = True
 End If
 'ReturnValue = xmldoc.SelectSingleNode(Xpath).Attributes.GetNamedItem(AttributeName).Value
 AttributeNode = Nothing
 Return ReturnValue
 End Function

 Public Sub AddAttribute(ByVal Xpath As String, ByVal AttributeName As String, ByVal AttributeValue As String)
 Xpath = RectifyXpath(Xpath)
 AttributeName = Replace(AttributeName, " ", "")
 AttributeValue = Replace(AttributeValue, " ", "")
 If LowerCaseXpaths Then
 AttributeName = LCase(AttributeName)
 AttributeValue = LCase(AttributeValue)
 End If
 Dim AttributeNode As System.Xml.XmlNode = XmlDoc.CreateAttribute(AttributeName)
 AttributeNode.Value = AttributeValue
 Dim xmlNode As System.Xml.XmlNode = XmlDoc.SelectSingleNode(Xpath)
 xmlNode.Attributes.Append(AttributeNode)
 If XMLAutoSave Then
 XmlDoc.Save(XMLPath)
 End If
 xmlNode = Nothing
 AttributeNode = Nothing
 End Sub

 Public Sub RemoveAttribute(ByVal Xpath As String, ByVal AttributeName As String)
 Xpath = RectifyXpath(Xpath)
 AttributeName = Replace(AttributeName, " ", "")
 If LowerCaseXpaths Then
 AttributeName = LCase(AttributeName)
 End If
 XmlDoc.SelectSingleNode(Xpath).Attributes.RemoveNamedItem(AttributeName)
 If XMLAutoSave Then
 XmlDoc.Save(XMLPath)
 End If
 End Sub

 Public Function GetAttributeValue(ByVal Xpath As String, ByVal AttributeName As String) As String
 Xpath = RectifyXpath(Xpath)
 AttributeName = Replace(AttributeName, " ", "")
 If LowerCaseXpaths Then
 AttributeName = LCase(AttributeName)
 End If
 Dim AttributeNode As System.Xml.XmlAttribute
 Dim ReturnValue As String
 AttributeNode = XmlDoc.SelectSingleNode(Xpath).Attributes.GetNamedItem(AttributeName)
 If AttributeNode Is Nothing Then
 ReturnValue = ""
 Else
 ReturnValue = AttributeNode.Value
 End If
 'ReturnValue = xmldoc.SelectSingleNode(Xpath).Attributes.GetNamedItem(AttributeName).Value
 AttributeNode = Nothing
 Return ReturnValue
 End Function

 Public Sub SetAttributeValue(ByVal Xpath As String, ByVal AttributeName As String, ByVal AttributeValue As String)
 Xpath = RectifyXpath(Xpath)
 AttributeName = Replace(AttributeName, " ", "")
 AttributeValue = Replace(AttributeValue, " ", "")
 If LowerCaseXpaths Then
 AttributeName = LCase(AttributeName)
 AttributeValue = LCase(AttributeValue)
 End If
 Dim Attrs As System.Xml.XmlAttributeCollection = XmlDoc.SelectSingleNode(Xpath).Attributes
 Dim Att As System.Xml.XmlAttribute
 For Each Att In Attrs
 If LCase(Att.Name) = LCase(AttributeName) Then
 Att.Value = AttributeValue
 Exit For
 End If
 Next
 If XMLAutoSave Then
 XmlDoc.Save(XMLPath)
 End If
 Attrs = Nothing
 Att = Nothing
 End Sub

 Public Sub Save()
 XmlDoc.Save(XMLPath)
 XmlDoc.Load(XMLPath)
 End Sub

 Public Function GetChildNodeNameAndText(ByVal Xpath As String) As String
 Xpath = RectifyXpath(Xpath)
 Dim ReturnValue As String = ""
 Dim xmlnode As Xml.XmlNode = XmlDoc.SelectSingleNode(Xpath)
 If xmlnode Is Nothing Then
 ReturnValue = ""
 Else
 Dim Node As Xml.XmlNode
 Dim ChildNodes As Xml.XmlNodeList = xmlnode.ChildNodes
 For Each Node In ChildNodes
 ReturnValue = ReturnValue & Node.Name & ":" & Node.InnerText & "|"
 Next
 Node = Nothing
 ChildNodes = Nothing
 End If
 xmlnode = Nothing
 Return (ReturnValue)

 End Function

 Public Sub Normalize(Optional ByVal RemoveLeafNodesWithText As Boolean = True, Optional ByVal RemoveAllAttributes As Boolean = True) ', Optional ByVal LowerCaseAllNodes As Boolean = True)
 Dim XmlNodes As Xml.XmlNodeList
 Dim XmlNode As Xml.XmlNode

 If RemoveLeafNodesWithText Then
 XmlNodes = XmlDoc.SelectNodes("//*[not(child::*)]")
 For Each XmlNode In XmlNodes
 If XmlNode.InnerText <> "" Then
 XmlNode.ParentNode.RemoveChild(XmlNode)
 End If
 Next
 Save()
 End If

 If RemoveAllAttributes Then
 XmlNodes = XmlDoc.SelectNodes("//*[@*]")
 Dim XmlAttributes As Xml.XmlAttributeCollection
 Dim XmlAttribute As Xml.XmlAttribute
 Dim i As Integer
 For Each XmlNode In XmlNodes
 XmlAttributes = XmlNode.Attributes
 For i = 1 To XmlAttributes.Count
 XmlNode.Attributes.Remove(XmlNode.Attributes.Item(0))
 Next
 Next
 Save()
 XmlAttributes = Nothing
 XmlAttribute = Nothing
 End If

 'If LowerCaseAllNodes Then
 ' XmlNodes = XmlDoc.SelectNodes("//*")
 ' For Each XmlNode In XmlNodes
 ' RenameElement(XmlNode, LCase(XmlNode.Name))
 ' Save()
 ' Next
 'End If

 End Sub

 'Private Sub RenameElement(ByVal XmlElement As Xml.XmlNode, ByVal newName As String)
 ' 'XmlDocument doc = e.OwnerDocument;
 ' Dim NewXMLNode As Xml.XmlNode = XmlDoc.CreateElement(newName)
 ' NewXMLNode.InnerText = XmlElement.InnerText
 ' 'XmlElement newElement = doc.CreateElement(newName);
 ' 'While (XmlElement.HasChildNodes)
 ' ' NewXMLNode.AppendChild(XmlElement.FirstChild)
 ' ' 'newElement.AppendChild(e.FirstChild);
 ' 'End While
 ' 'Dim XmlAttributes As Xml.XmlAttributeCollection = XmlElement.Attributes

 ' ''Dim XMlAttribute As Xml.XmlAttribute
 ' 'Dim NewXMlAttribute As Xml.XmlNode

 ' 'For Each XMlAttribute In XmlElement.Attributes
 ' ' NewXMlAttribute = XmlDoc.CreateElement(LCase(XMlAttribute.Name))
 ' ' NewXMlAttribute.Value = LCase(XMlAttribute.Value)
 ' ' NewXMLNode.Attributes.Append(NewXMlAttribute)
 ' 'Next

 ' 'While (ac.Count > 0)
 ' 'newElement.Attributes.Append(ac[0]);
 ' 'End While
 ' XmlElement.ParentNode.ReplaceChild(NewXMLNode, XmlElement)
 ' 'XmlNode parent = e.ParentNode;
 ' 'parent.ReplaceChild(newElement, e);
 ' 'return newElement;
 'End Sub

 Protected Overrides Sub Finalize()
 System.GC.Collect()
 MyBase.Finalize()
 End Sub

End Class
'End Namespace

My Blog

Sunday, July 31, 2011

New Com Lib