Imports System.Drawing.Drawing2D Imports System.Globalization Imports System.IO Imports System.Reflection Imports System.Runtime.CompilerServices Imports System.Security.Cryptography Imports System.Text Imports Microsoft.Win32 Imports VB6 = Microsoft.VisualBasic Imports vbnet.UI Module StringExtensions Public Function Multiply(instance As String, multiplier As Integer) As String Dim sb As New StringBuilder(multiplier * instance.Length) For i = 0 To multiplier - 1 sb.Append(instance) Next Return sb.ToString() End Function Function IsValidFileName(instance As String) As Boolean If instance = "" Then Return False Dim chars = """*/:<>?\|" For Each i In instance If chars.Contains(i) Then Return False If Convert.ToInt32(i) < 32 Then Return False Next Return True End Function Function IsANSICompatible(instance As String) As Boolean If instance = "" Then Return True Dim bytes = Encoding.Convert(Encoding.Unicode, Encoding.Default, Encoding.Unicode.GetBytes(instance)) Return instance = Encoding.Unicode.GetString(Encoding.Convert(Encoding.Default, Encoding.Unicode, bytes)) End Function Function FileName(instance As String) As String If instance = "" Then Return "" Dim index = instance.LastIndexOf(Path.DirectorySeparatorChar) If index > -1 Then Return instance.Substring(index + 1) Return instance End Function Function Upper(instance As String) As String If instance = "" Then Return "" Return instance.ToUpperInvariant End Function Function Lower(instance As String) As String If instance = "" Then Return "" Return instance.ToLowerInvariant End Function Function ChangeExt(instance As String, value As String) As String If instance = "" Then Return "" If value = "" Then Return instance If Not value.StartsWith(".") Then value = "." + value Return instance.DirAndBase + value.ToLower End Function Function Escape(instance As String) As String If instance = "" Then Return "" Dim chars = " ()".ToCharArray For Each i In chars If instance.Contains(i) Then Return """" + instance + """" Next Return instance End Function Function Parent(instance As String) As String Return DirPath.GetParent(instance) End Function Function ExistingParent(instance As String) As String Dim ret = instance.Parent If Not Directory.Exists(ret) Then ret = ret.Parent Else Return ret If Not Directory.Exists(ret) Then ret = ret.Parent Else Return ret If Not Directory.Exists(ret) Then ret = ret.Parent Else Return ret If Not Directory.Exists(ret) Then ret = ret.Parent Else Return ret If Not Directory.Exists(ret) Then ret = ret.Parent Else Return ret Return ret End Function Function Ext(instance As String) As String Return FilePath.GetExt(instance) End Function Function ExtFull(instance As String) As String Return FilePath.GetExtFull(instance) End Function Function Base(instance As String) As String Return FilePath.GetBase(instance) End Function Function Dir(instance As String) As String Return FilePath.GetDir(instance) End Function Function DirName(instance As String) As String Return DirPath.GetName(instance) End Function Function DirAndBase(instance As String) As String Return FilePath.GetDirAndBase(instance) End Function Function ContainsAll(instance As String, all As IEnumerable(Of String)) As Boolean If instance <> "" Then Return all.All(Function(arg) instance.Contains(arg)) End Function Function ContainsAny(instance As String, any As IEnumerable(Of String)) As Boolean If instance <> "" Then Return any.Any(Function(arg) instance.Contains(arg)) End Function Function EqualsAny(instance As String, ParamArray values As String()) As Boolean If instance = "" OrElse values.NothingOrEmpty Then Return False Return values.Contains(instance) End Function Function FixDir(instance As String) As String If instance = "" Then Return "" While instance.EndsWith(DirPath.Separator + DirPath.Separator) instance = instance.Substring(0, instance.Length - 1) End While If instance.EndsWith(DirPath.Separator) Then Return instance Return instance + DirPath.Separator End Function Function FixBreak(value As String) As String value = value.Replace(VB6.ChrW(13) + VB6.ChrW(10), VB6.ChrW(10)) value = value.Replace(VB6.ChrW(13), VB6.ChrW(10)) Return value.Replace(VB6.ChrW(10), VB6.ChrW(13) + VB6.ChrW(10)) End Function Function ContainsUnicode(value As String) As Boolean If value = "" Then Return False For Each i In value If Convert.ToInt32(i) > 255 Then Return True Next End Function Function ToTitleCase(value As String) As String 'TextInfo.ToTitleCase won't work on all upper strings Return CultureInfo.CurrentCulture.TextInfo.ToTitleCase(value.ToLower) End Function Function IsInt(value As String) As Boolean Return Integer.TryParse(value, Nothing) End Function Function ToInt(value As String, Optional defaultValue As Integer = 0) As Integer If Not Integer.TryParse(value, Nothing) Then Return defaultValue Return CInt(value) End Function Function IsSingle(value As String) As Boolean If value <> "" Then If value.Contains(",") Then value = value.Replace(",", ".") Return Single.TryParse(value, NumberStyles.Float Or NumberStyles.AllowThousands, CultureInfo.InvariantCulture, Nothing) End If End Function Function ToSingle(value As String, Optional defaultValue As Single = 0) As Single If value <> "" Then If value.Contains(",") Then value = value.Replace(",", ".") Dim ret As Single If Single.TryParse(value, NumberStyles.Float Or NumberStyles.AllowThousands, CultureInfo.InvariantCulture, ret) Then Return ret End If End If Return defaultValue End Function Function IsDouble(value As String) As Boolean If value <> "" Then If value.Contains(",") Then value = value.Replace(",", ".") Return Double.TryParse(value, NumberStyles.Float Or NumberStyles.AllowThousands, CultureInfo.InvariantCulture, Nothing) End If End Function Function ToDouble(value As String, Optional defaultValue As Single = 0) As Double If value <> "" Then If value.Contains(",") Then value = value.Replace(",", ".") Dim ret As Double If Double.TryParse(value, NumberStyles.Float Or NumberStyles.AllowThousands, CultureInfo.InvariantCulture, ret) Then Return ret End If End If Return defaultValue End Function Function FormatColumn(value As String, delimiter As String) As String If value = "" Then Return "" Dim lines = value.SplitKeepEmpty(BR) Dim leftSides As New List(Of String) For Each i In lines Dim pos = i.IndexOf(delimiter) If pos > 0 Then leftSides.Add(i.Substring(0, pos).Trim) Else leftSides.Add(i) End If Next Dim highest = Aggregate i In leftSides Into Max(i.Length) Dim ret As New List(Of String) For i = 0 To lines.Length - 1 Dim line = lines(i) If line.Contains(delimiter) Then ret.Add(leftSides(i).PadRight(highest) + " " + delimiter + " " + line.Substring(line.IndexOf(delimiter) + 1).Trim) Else ret.Add(leftSides(i)) End If Next Return ret.Join(BR) End Function Sub WriteANSIFile(instance As String, path As String) WriteFile(instance, path, Encoding.Default) End Sub Sub WriteUTF8File(instance As String, path As String) WriteFile(instance, path, Encoding.UTF8) End Sub Sub WriteFile(value As String, path As String, encoding As Encoding) Try File.WriteAllText(path, value, encoding) Catch ex As Exception MsgException(ex) End Try End Sub Function Left(value As String, index As Integer) As String If value = "" OrElse index < 0 Then Return "" If index > value.Length Then Return value Return value.Substring(0, index) End Function Function Left(value As String, start As String) As String If value = "" OrElse start = "" Then Return "" If Not value.Contains(start) Then Return "" Return value.Substring(0, value.IndexOf(start)) End Function Function LeftLast(value As String, start As String) As String If Not value.Contains(start) Then Return "" Return value.Substring(0, value.LastIndexOf(start)) End Function Function Right(value As String, start As String) As String If value = "" OrElse start = "" Then Return "" If Not value.Contains(start) Then Return "" Return value.Substring(value.IndexOf(start) + start.Length) End Function Function RightLast(value As String, start As String) As String If value = "" OrElse start = "" Then Return "" If Not value.Contains(start) Then Return "" Return value.Substring(value.LastIndexOf(start) + start.Length) End Function Function EqualIgnoreCase(a As String, b As String) As Boolean If a = "" OrElse b = "" Then Return False Return String.Compare(a, b, StringComparison.OrdinalIgnoreCase) = 0 End Function Function Shorten(value As String, maxLength As Integer) As String If value = "" OrElse value.Length <= maxLength Then Return value End If Return value.Substring(0, maxLength) End Function Function SplitNoEmpty(value As String, ParamArray delimiters As String()) As String() Return value.Split(delimiters, StringSplitOptions.RemoveEmptyEntries) End Function Function SplitKeepEmpty(value As String, ParamArray delimiters As String()) As String() Return value.Split(delimiters, StringSplitOptions.None) End Function Function SplitNoEmptyAndWhiteSpace(value As String, ParamArray delimiters As String()) As String() If value = "" Then Return {} Dim a = SplitNoEmpty(value, delimiters) For i = 0 To a.Length - 1 a(i) = a(i).Trim Next Dim l = a.ToList While l.Contains("") l.Remove("") End While Return l.ToArray End Function Function SplitLinesNoEmpty(value As String) As String() Return SplitNoEmpty(value, Environment.NewLine) End Function Function RemoveChars(value As String, chars As String) As String Dim ret = value For Each i In value If chars.IndexOf(i) >= 0 Then ret = ret.Replace(i, "") End If Next Return ret End Function Function DeleteRight(value As String, count As Integer) As String Return Left(value, value.Length - count) End Function Function ReplaceUnicode(value As String) As String If value.Contains(Convert.ToChar(&H2212)) Then value = value.Replace(Convert.ToChar(&H2212), "-"c) End If Return value End Function Function SHA512Hash(value As String) As String Dim crypt = SHA512CryptoServiceProvider.Create() Dim hash = crypt.ComputeHash(ASCIIEncoding.ASCII.GetBytes(value)) Dim sb As New StringBuilder() For Each i In hash sb.Append(i.ToString("x2")) Next Return sb.ToString() End Function Sub ToClipboard(value As String) If value <> "" Then Clipboard.SetText(value) Else Clipboard.Clear() End If End Sub End Module Module MiscExtensions Function ToInvariantString(instance As Double, format As String) As String Dim ret = instance.ToString(format, CultureInfo.InvariantCulture) If (ret.Contains(".") OrElse ret.Contains(",")) AndAlso ret.EndsWith("0") Then ret = ret.TrimEnd("0"c) End If Return ret End Function Function ToInvariantString(instance As IConvertible) As String If Not instance Is Nothing Then Return instance.ToString(CultureInfo.InvariantCulture) End Function Function ContainsAny(Of T)(instance As IEnumerable(Of T), ParamArray values As T()) As Boolean Return instance.Where(Function(arg) values.Contains(arg)).Count > 0 End Function Function Sort(Of T)(instance As IEnumerable(Of T)) As IEnumerable(Of T) Dim ret = instance.ToArray Array.Sort(Of T)(ret) Return ret End Function Function Join(instance As IEnumerable(Of String), delimiter As String, Optional removeEmpty As Boolean = False) As String If instance Is Nothing Then Return Nothing Dim containsEmpty As Boolean For Each item In instance If item = "" Then containsEmpty = True Exit For End If Next If containsEmpty AndAlso removeEmpty Then instance = instance.Where(Function(arg) arg <> "") Return String.Join(delimiter, instance) End Function Function GetAttribute(Of T)(mi As MemberInfo) As T Dim attributes = mi.GetCustomAttributes(True) If Not attributes.NothingOrEmpty Then If attributes.Length = 1 Then If TypeOf attributes(0) Is T Then Return DirectCast(attributes(0), T) End If Else For Each i In attributes If TypeOf i Is T Then Return DirectCast(i, T) End If Next End If End If End Function Function IsDigit(c As Char) As Boolean Return Char.IsDigit(c) End Function Function EnsureRange(value As Integer, min As Integer, max As Integer) As Integer If value < min Then value = min ElseIf value > max Then value = max End If Return value End Function Function NeutralCulture(ci As CultureInfo) As CultureInfo If ci.IsNeutralCulture Then Return ci Else Return ci.Parent End Function Function NothingOrEmpty(strings As IEnumerable(Of String)) As Boolean If strings Is Nothing OrElse strings.Count = 0 Then Return True For Each i In strings If i = "" Then Return True Next End Function Function NothingOrEmpty(objects As IEnumerable(Of Object)) As Boolean If objects Is Nothing OrElse objects.Count = 0 Then Return True For Each i In objects If i Is Nothing Then Return True Next End Function End Module Module RegistryKeyExtensions Private Function GetValue(Of T)(rootKey As RegistryKey, key As String, name As String) As T Using k = rootKey.OpenSubKey(key) If Not k Is Nothing Then Dim r = k.GetValue(name) If Not r Is Nothing Then Try Return CType(r, T) Catch ex As Exception End Try End If End If End Using End Function Function GetString(rootKey As RegistryKey, subKey As String, name As String) As String Return GetValue(Of String)(rootKey, subKey, name) End Function Function GetInt(rootKey As RegistryKey, subKey As String, name As String) As Integer Return GetValue(Of Integer)(rootKey, subKey, name) End Function Function GetBoolean(rootKey As RegistryKey, subKey As String, name As String) As Boolean Return GetValue(Of Boolean)(rootKey, subKey, name) End Function Function GetValueNames(rootKey As RegistryKey, subKeyName As String) As IEnumerable(Of String) Using k = rootKey.OpenSubKey(subKeyName) If Not k Is Nothing Then Return k.GetValueNames End If End Using Return {} End Function Sub GetSubKeys(rootKey As RegistryKey, keys As List(Of RegistryKey)) If Not rootKey Is Nothing Then keys.Add(rootKey) For Each i In rootKey.GetSubKeyNames GetSubKeys(rootKey.OpenSubKey(i), keys) Next End If End Sub Sub Write(rootKey As RegistryKey, subKey As String, valueName As String, valueValue As Object) Dim k = rootKey.OpenSubKey(subKey, True) If k Is Nothing Then k = rootKey.CreateSubKey(subKey, RegistryKeyPermissionCheck.ReadWriteSubTree) End If k.SetValue(valueName, valueValue) k.Close() End Sub Sub DeleteValue(rootKey As RegistryKey, key As String, valueName As String) Using k = rootKey.OpenSubKey(key, True) If Not k Is Nothing Then k.DeleteValue(valueName, False) End If End Using End Sub End Module Module ControlExtension Sub ScaleClientSize(instance As Control, width As Single, height As Single) instance.ClientSize = New Size(CInt(instance.Font.Height * width), CInt(instance.Font.Height * height)) End Sub Sub SetFontStyle(instance As Control, style As FontStyle) instance.Font = New Font(instance.Font.FontFamily, instance.Font.Size, style) End Sub Sub AddClickAction(instance As Control, action As Action) AddHandler instance.Click, Sub() action() End Sub Function ClientMousePos(instance As Control) As Point Return instance.PointToClient(Control.MousePosition) End Function Function GetMaxTextSpace(instance As Control, ParamArray values As String()) As String Dim ret As String For x = 4 To 2 Step -1 ret = values.Join("".PadRight(x)) Dim testWidth = TextRenderer.MeasureText(ret, instance.Font).Width If testWidth < instance.Width - 2 OrElse x = 2 Then Return ret Next Return ret End Function End Module Module UIExtensions Sub ClearAndDisplose(instance As ToolStripItemCollection) For Each i In instance.OfType(Of IDisposable).ToArray i.Dispose() Next instance.Clear() End Sub Function ResizeToSmallIconSize(img As Image) As Image If Not img Is Nothing AndAlso img.Size <> SystemInformation.SmallIconSize Then Dim s = SystemInformation.SmallIconSize Dim r As New Bitmap(s.Width, s.Height) Using g = Graphics.FromImage(DirectCast(r, Image)) g.SmoothingMode = SmoothingMode.AntiAlias g.InterpolationMode = InterpolationMode.HighQualityBicubic g.PixelOffsetMode = PixelOffsetMode.HighQuality g.DrawImage(img, 0, 0, s.Width, s.Height) End Using Return r End If Return img End Function Function ResizeImage(image As Image, ByVal height As Integer) As Image Dim percentHeight = height / image.Height Dim ret = New Bitmap(CInt(image.Width * percentHeight), CInt(height)) Using g = Graphics.FromImage(ret) g.InterpolationMode = InterpolationMode.HighQualityBicubic g.DrawImage(image, 0, 0, ret.Width, ret.Height) End Using Return ret End Function Sub SetSelectedPath(d As FolderBrowserDialog, path As String) If Not Directory.Exists(path) Then path = path.ExistingParent If Directory.Exists(path) Then d.SelectedPath = path End Sub Sub SetInitDir(d As FileDialog, ParamArray paths As String()) For Each i In paths If Not Directory.Exists(i) Then i = i.ExistingParent If Directory.Exists(i) Then d.InitialDirectory = i Exit For End If Next End Sub Sub SetFilter(d As FileDialog, values As IEnumerable(Of String)) d.Filter = GetFilter(values) End Sub Function GetFilter(values As IEnumerable(Of String)) As String Return "*." + values.Join(";*.") + "|*." + values.Join(";*.") + "|All Files|*.*" End Function Sub SendMessageCue(tb As TextBox, value As String, hideWhenFocused As Boolean) Dim wParam = If(hideWhenFocused, 0, 1) Native.SendMessage(tb.Handle, Native.EM_SETCUEBANNER, wParam, value) End Sub Sub SendMessageCue(c As ComboBox, value As String) Native.SendMessage(c.Handle, Native.CB_SETCUEBANNER, 1, value) End Sub Function GetPropertyValue(obj As String, propertyName As String) As Object obj.GetType.GetProperty(propertyName).GetValue(obj) End Function Sub RemoveSelection(dgv As DataGridView) For Each i As DataGridViewRow In dgv.SelectedRows dgv.Rows.Remove(i) Next If dgv.SelectedRows.Count = 0 AndAlso dgv.RowCount > 0 Then dgv.Rows(dgv.RowCount - 1).Selected = True End If End Sub Function CanMoveUp(dgv As DataGridView) As Boolean Return dgv.SelectedRows.Count > 0 AndAlso dgv.SelectedRows(0).Index > 0 End Function Function CanMoveDown(dgv As DataGridView) As Boolean Return dgv.SelectedRows.Count > 0 AndAlso dgv.SelectedRows(0).Index < dgv.RowCount - 1 End Function Sub MoveSelectionUp(dgv As DataGridView) If CanMoveUp(dgv) Then Dim bs = DirectCast(dgv.DataSource, BindingSource) Dim pos = bs.Position bs.RaiseListChangedEvents = False Dim current = bs.Current bs.Remove(current) pos -= 1 bs.Insert(pos, current) bs.Position = pos bs.RaiseListChangedEvents = True bs.ResetBindings(False) End If End Sub Sub MoveSelectionDown(dgv As DataGridView) If CanMoveDown(dgv) Then Dim bs = DirectCast(dgv.DataSource, BindingSource) Dim pos = bs.Position bs.RaiseListChangedEvents = False Dim current = bs.Current bs.Remove(current) pos += 1 bs.Insert(pos, current) bs.Position = pos bs.RaiseListChangedEvents = True bs.ResetBindings(False) End If End Sub End Module