'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, "<b>|</b>", "")
Text = ReplaceRegX(Text, "<i>|</i>", "")
Text = ReplaceRegX(Text, "<u>|</u>", "")
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 "<b>" : .Font.Bold = True
' Case "</b>" : .Font.Bold = False
' Case "<u>" : .Font.Underline = 1
' Case "</u>" : .Font.Underline = 0
' Case "<i>" : .Font.Italic = True
' Case "</i>" : .Font.Italic = False
' Case "<br>" : .TypeParagraph()
' Case "<red>" : .Font.ColorIndex = 6
' Case "<blue>" : .Font.ColorIndex = 2
' Case "<green>" : .Font.ColorIndex = 4
' Case "</font>" : .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 "<b>" : .Font.Bold = True
' Case "</b>" : .Font.Bold = False
' Case "<u>" : .Font.Underline = 1
' Case "</u>" : .Font.Underline = 0
' Case "<i>" : .Font.Italic = True
' Case "</i>" : .Font.Italic = False
' Case "<br>" : .TypeParagraph()
' Case "<red>" : .Font.ColorIndex = 6
' Case "<blue>" : .Font.ColorIndex = 2
' Case "<green>" : .Font.ColorIndex = 4
' Case "</font>" : .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
