551 lines
20 KiB
VB.net
551 lines
20 KiB
VB.net
Imports GBM.My.Resources
|
|
Imports System.Net
|
|
Imports System.IO
|
|
Imports System.Security.Principal
|
|
Imports System.Text.RegularExpressions
|
|
Imports System.Runtime.Serialization
|
|
Imports System.Runtime.Serialization.Formatters.Binary
|
|
|
|
Public Class mgrCommon
|
|
|
|
'These need to be updated when upgrading the packaged 7z utility
|
|
Private Shared sUtility64Hash As String = "F558DFBB7F2BF5D9A002AC68843A2E79E4EC045EDD7F56213562ACFA75CC77AD" 'v18.01 7za.exe x64
|
|
Private Shared sUtility32Hash As String = "E6855553350FA6FB23E05839C7F3EF140DAD29D9A0E3495DE4D1B17A9FBF5CA4" 'v18.01 7za.exe x86
|
|
|
|
Public Shared ReadOnly Property UtilityHash As String
|
|
Get
|
|
Select Case mgrPath.ReleaseType
|
|
Case 64
|
|
Return sUtility64Hash
|
|
Case 32
|
|
Return sUtility32Hash
|
|
Case Else
|
|
Return sUtility32Hash
|
|
End Select
|
|
End Get
|
|
End Property
|
|
|
|
Public Shared ReadOnly Property BuildVersion As Integer
|
|
Get
|
|
Return My.Application.Info.Version.Build
|
|
End Get
|
|
End Property
|
|
|
|
Public Shared ReadOnly Property AppVersion As Integer
|
|
Get
|
|
Return (My.Application.Info.Version.Major * 100) + (My.Application.Info.Version.Minor * 10) + My.Application.Info.Version.Build
|
|
End Get
|
|
End Property
|
|
|
|
Public Shared ReadOnly Property DisplayAppVersion As String
|
|
Get
|
|
Return My.Application.Info.Version.Major & "." & My.Application.Info.Version.Minor & "." & My.Application.Info.Version.Build
|
|
End Get
|
|
End Property
|
|
|
|
'Source - https://stackoverflow.com/questions/18873152/deep-copy-of-ordereddictionary
|
|
Public Shared Function GenericClone(ByVal oOriginal As Object) As Object
|
|
'Construct a temporary memory stream
|
|
Dim oStream As MemoryStream = New MemoryStream()
|
|
|
|
'Construct a serialization formatter that does all the hard work
|
|
Dim oFormatter As BinaryFormatter = New BinaryFormatter()
|
|
|
|
'This line Is explained in the "Streaming Contexts" section
|
|
oFormatter.Context = New StreamingContext(StreamingContextStates.Clone)
|
|
|
|
'Serialize the object graph into the memory stream
|
|
oFormatter.Serialize(oStream, oOriginal)
|
|
|
|
'Seek back to the start of the memory stream before deserializing
|
|
oStream.Position = 0
|
|
|
|
'Deserialize the graph into a New set of objects
|
|
'Return the root of the graph (deep copy) to the caller
|
|
Return oFormatter.Deserialize(oStream)
|
|
End Function
|
|
|
|
Public Shared Function CheckAddress(ByVal URL As String) As Boolean
|
|
Try
|
|
Dim request As WebRequest = WebRequest.Create(URL)
|
|
Dim response As WebResponse = request.GetResponse()
|
|
response.Close()
|
|
Catch ex As Exception
|
|
Return False
|
|
End Try
|
|
Return True
|
|
End Function
|
|
|
|
Public Shared Function DateToUnix(ByVal dDate As DateTime) As Int64
|
|
Return DateDiff(DateInterval.Second, #1/1/1970#, dDate)
|
|
End Function
|
|
|
|
Public Shared Function UnixToDate(ByVal iDate As Int64) As DateTime
|
|
Return DateAdd(DateInterval.Second, iDate, #1/1/1970#)
|
|
End Function
|
|
|
|
Public Shared Function BooleanYesNo(ByVal bBool As Boolean) As String
|
|
If bBool Then
|
|
Return mgrCommon_Yes
|
|
Else
|
|
Return mgrCommon_No
|
|
End If
|
|
End Function
|
|
|
|
Public Shared Function SaveFileBrowser(ByVal sName As String, ByVal sTitle As String, ByVal sExtension As String, ByVal sFileType As String, ByVal sDefaultFolder As String,
|
|
ByVal sDefaultFile As String, Optional ByVal bSavedPath As Boolean = True) As String
|
|
Dim fbBrowser As New SaveFileDialog
|
|
Dim oSavedPath As New clsSavedPath
|
|
|
|
fbBrowser.Title = sTitle
|
|
fbBrowser.DefaultExt = sExtension
|
|
fbBrowser.Filter = FormatString(mgrCommon_FilesFilter, New String() {sFileType, sExtension, sExtension})
|
|
fbBrowser.FileName = sDefaultFile
|
|
fbBrowser.InitialDirectory = sDefaultFolder
|
|
|
|
If bSavedPath Then
|
|
oSavedPath = mgrSavedPath.GetPathByName(sName)
|
|
If oSavedPath.Path <> String.Empty Then
|
|
If Directory.Exists(oSavedPath.Path) Then
|
|
fbBrowser.InitialDirectory = oSavedPath.Path
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If fbBrowser.ShowDialog() = Windows.Forms.DialogResult.OK Then
|
|
If bSavedPath Then
|
|
oSavedPath.PathName = sName
|
|
oSavedPath.Path = Path.GetDirectoryName(fbBrowser.FileName)
|
|
mgrSavedPath.AddUpdatePath(oSavedPath)
|
|
End If
|
|
|
|
Return fbBrowser.FileName
|
|
End If
|
|
|
|
Return String.Empty
|
|
End Function
|
|
|
|
Public Shared Function OpenFileBrowser(ByVal sName As String, ByVal sTitle As String, ByVal sExtension As String, ByVal sFileType As String, ByVal sDefaultFolder As String,
|
|
ByVal bMulti As Boolean, Optional ByVal bSavedPath As Boolean = True) As String
|
|
Dim fbBrowser As New OpenFileDialog
|
|
Dim oSavedPath As New clsSavedPath
|
|
|
|
fbBrowser.Title = sTitle
|
|
fbBrowser.DefaultExt = sExtension
|
|
fbBrowser.Filter = FormatString(mgrCommon_FilesFilter, New String() {sFileType, sExtension, sExtension})
|
|
fbBrowser.Multiselect = bMulti
|
|
fbBrowser.InitialDirectory = sDefaultFolder
|
|
|
|
If bSavedPath Then
|
|
oSavedPath = mgrSavedPath.GetPathByName(sName)
|
|
If oSavedPath.Path <> String.Empty Then
|
|
If Directory.Exists(oSavedPath.Path) Then
|
|
fbBrowser.InitialDirectory = oSavedPath.Path
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If fbBrowser.ShowDialog() = Windows.Forms.DialogResult.OK Then
|
|
If bSavedPath Then
|
|
oSavedPath.PathName = sName
|
|
oSavedPath.Path = Path.GetDirectoryName(fbBrowser.FileName)
|
|
mgrSavedPath.AddUpdatePath(oSavedPath)
|
|
End If
|
|
|
|
If bMulti Then
|
|
Dim sFileNames As String = String.Empty
|
|
For Each sFileName As String In fbBrowser.FileNames
|
|
sFileNames &= sFileName & "|"
|
|
Next
|
|
sFileNames = sFileNames.TrimEnd("|")
|
|
Return sFileNames
|
|
Else
|
|
Return fbBrowser.FileName
|
|
End If
|
|
End If
|
|
|
|
Return String.Empty
|
|
End Function
|
|
|
|
Public Shared Function OpenFolderBrowser(ByVal sName As String, ByVal sTitle As String, ByVal sDefaultFolder As String, ByVal bEnableNewFolder As Boolean,
|
|
Optional ByVal bSavedPath As Boolean = True) As String
|
|
Dim fbBrowser As New FolderBrowserDialog
|
|
Dim oSavedPath As New clsSavedPath
|
|
|
|
fbBrowser.Description = sTitle
|
|
fbBrowser.SelectedPath = sDefaultFolder
|
|
fbBrowser.ShowNewFolderButton = bEnableNewFolder
|
|
|
|
If bSavedPath Then
|
|
oSavedPath = mgrSavedPath.GetPathByName(sName)
|
|
If oSavedPath.Path <> String.Empty Then
|
|
If Directory.Exists(oSavedPath.Path) Then
|
|
fbBrowser.SelectedPath = oSavedPath.Path
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If fbBrowser.ShowDialog() = Windows.Forms.DialogResult.OK Then
|
|
If bSavedPath Then
|
|
oSavedPath.PathName = sName
|
|
oSavedPath.Path = fbBrowser.SelectedPath
|
|
mgrSavedPath.AddUpdatePath(oSavedPath)
|
|
End If
|
|
|
|
Return fbBrowser.SelectedPath
|
|
End If
|
|
|
|
Return String.Empty
|
|
End Function
|
|
|
|
Public Shared Function IsProcessNotSearchable(ByVal oGame As clsGame) As Boolean
|
|
Dim sExemptList As String() = {"dosbox", "scummvm"}
|
|
Dim bFound As Boolean = False
|
|
|
|
'We can't search if we don't have a configuration
|
|
If oGame.Temporary Then
|
|
Return True
|
|
End If
|
|
|
|
For Each s As String In sExemptList
|
|
If oGame.ProcessName.ToLower.Contains(s) Then bFound = True
|
|
Next
|
|
|
|
If bFound Or oGame.Duplicate = True Then
|
|
Return True
|
|
Else
|
|
Return False
|
|
End If
|
|
End Function
|
|
|
|
Public Shared Function IsUnix() As Boolean
|
|
If Path.DirectorySeparatorChar = "/" Then
|
|
Return True
|
|
End If
|
|
|
|
Return False
|
|
End Function
|
|
|
|
Public Shared Function IsElevated() As Boolean
|
|
Dim oID As WindowsIdentity = WindowsIdentity.GetCurrent
|
|
Dim oPrincipal As New WindowsPrincipal(oID)
|
|
Return oPrincipal.IsInRole(WindowsBuiltInRole.Administrator)
|
|
End Function
|
|
|
|
Public Shared Sub RestartAsAdmin()
|
|
Dim oProcess As New Process
|
|
|
|
oProcess.StartInfo.FileName = Application.ExecutablePath
|
|
oProcess.StartInfo.UseShellExecute = True
|
|
oProcess.StartInfo.CreateNoWindow = True
|
|
oProcess.StartInfo.Verb = "runas"
|
|
|
|
oProcess.Start()
|
|
End Sub
|
|
|
|
'Get a file size
|
|
Public Shared Function GetFileSize(ByVal sFile As String) As Long
|
|
Dim oFileInfo As FileInfo
|
|
Dim dFileSize As Long = 0
|
|
|
|
Try
|
|
oFileInfo = New FileInfo(sFile)
|
|
dFileSize = oFileInfo.Length
|
|
Catch ex As Exception
|
|
'Do Nothing
|
|
End Try
|
|
|
|
Return dFileSize
|
|
End Function
|
|
|
|
Public Shared Function WildcardToRegex(ByVal sPattern As String) As String
|
|
Dim sRegEx As String
|
|
sRegEx = sPattern.Replace("*", ".*")
|
|
sRegEx = sRegEx.Replace("?", ".")
|
|
Return sRegEx
|
|
End Function
|
|
|
|
Public Shared Function CompareValueToArrayRegEx(ByVal sValue As String, ByVal sValues As String()) As Boolean
|
|
For Each se As String In sValues
|
|
If Regex.IsMatch(sValue, WildcardToRegex(se)) Then
|
|
Return True
|
|
End If
|
|
Next
|
|
Return False
|
|
End Function
|
|
|
|
Public Shared Function IsRegExValid(ByVal sPattern As String) As Boolean
|
|
Dim oRegEx As Regex
|
|
Try
|
|
oRegEx = New Regex(sPattern)
|
|
Return True
|
|
Catch ex As Exception
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
'Calculate the current size of a folder
|
|
Public Shared Function GetFolderSize(ByVal sPath As String, ByVal sInclude As String(), ByVal sExclude As String()) As Long
|
|
Dim oFolder As DirectoryInfo
|
|
Dim bInclude As Boolean
|
|
Dim bExclude As Boolean
|
|
Dim lSize As Long = 0
|
|
|
|
Try
|
|
If Not Directory.Exists(sPath) Then Return lSize
|
|
|
|
oFolder = New DirectoryInfo(sPath)
|
|
|
|
'Files
|
|
For Each fi As FileInfo In oFolder.EnumerateFiles()
|
|
If sInclude.Length > 0 Then
|
|
bInclude = CompareValueToArrayRegEx(fi.Name, sInclude) Or CompareValueToArrayRegEx(fi.DirectoryName, sInclude)
|
|
Else
|
|
bInclude = True
|
|
End If
|
|
|
|
If sExclude.Length > 0 Then
|
|
bExclude = CompareValueToArrayRegEx(fi.Name, sExclude) Or CompareValueToArrayRegEx(fi.DirectoryName, sExclude)
|
|
Else
|
|
bExclude = False
|
|
End If
|
|
|
|
If bInclude And Not bExclude Then
|
|
lSize += fi.Length
|
|
End If
|
|
Next
|
|
|
|
'Sub Folders
|
|
For Each di As DirectoryInfo In oFolder.EnumerateDirectories()
|
|
If Not ((di.Attributes And FileAttributes.ReparsePoint) = FileAttributes.ReparsePoint) Then
|
|
If sExclude.Length > 0 Then
|
|
bExclude = CompareValueToArrayRegEx(di.Name, sExclude)
|
|
Else
|
|
bExclude = False
|
|
End If
|
|
If Not bExclude Then
|
|
lSize += GetFolderSize(di.FullName, sInclude, sExclude)
|
|
End If
|
|
End If
|
|
Next
|
|
Catch
|
|
'Do Nothing
|
|
End Try
|
|
|
|
Return lSize
|
|
End Function
|
|
|
|
'Format Disk Space Amounts
|
|
Public Shared Function FormatDiskSpace(ByVal lSize As Long)
|
|
|
|
Select Case lSize
|
|
Case >= 1125899906842624
|
|
Return FormatString(mgrCommon_PB, Math.Round(lSize / 1125899906842624, 2))
|
|
Case >= 1099511627776
|
|
Return FormatString(mgrCommon_TB, Math.Round(lSize / 1099511627776, 2))
|
|
Case >= 1073741824
|
|
Return FormatString(mgrCommon_GB, Math.Round(lSize / 1073741824, 2))
|
|
Case >= 1048576
|
|
Return FormatString(mgrCommon_MB, Math.Round(lSize / 1048576, 2))
|
|
Case >= 1024
|
|
Return FormatString(mgrCommon_KB, Math.Round(lSize / 1024, 2))
|
|
Case >= 0
|
|
Return FormatString(mgrCommon_B, lSize)
|
|
End Select
|
|
|
|
Return lSize
|
|
End Function
|
|
|
|
'Get available disk space on a drive (Unix)
|
|
Private Shared Function GetAvailableDiskSpaceUnix(ByVal sPath As String) As Long
|
|
Dim prsdf As Process
|
|
Dim sOutput As String
|
|
Dim sAvailableSpace As String
|
|
Try
|
|
prsdf = New Process
|
|
prsdf.StartInfo.FileName = "/bin/df"
|
|
prsdf.StartInfo.Arguments = sPath
|
|
prsdf.StartInfo.UseShellExecute = False
|
|
prsdf.StartInfo.RedirectStandardOutput = True
|
|
prsdf.StartInfo.CreateNoWindow = True
|
|
prsdf.Start()
|
|
sOutput = prsdf.StandardOutput.ReadToEnd
|
|
'Parse df output to grab "Available" value
|
|
sAvailableSpace = sOutput.Split(vbLf)(1).Split(New Char() {" "}, StringSplitOptions.RemoveEmptyEntries)(3)
|
|
'Return value in bytes
|
|
Return CLng(sAvailableSpace) * 1024
|
|
Catch
|
|
Return 0
|
|
End Try
|
|
End Function
|
|
|
|
'Get available disk space on a drive (Windows)
|
|
Private Shared Function GetAvailableDiskSpaceWindows(ByVal sPath As String) As Long
|
|
Dim oDrive As DriveInfo
|
|
Dim lAvailableSpace As Long = 0
|
|
Try
|
|
oDrive = New DriveInfo(Path.GetPathRoot(sPath))
|
|
lAvailableSpace = oDrive.AvailableFreeSpace
|
|
Catch
|
|
'Do Nothing
|
|
End Try
|
|
Return lAvailableSpace
|
|
End Function
|
|
|
|
'Get available disk space on a drive
|
|
Public Shared Function GetAvailableDiskSpace(ByVal sPath As String) As Long
|
|
If IsUnix() Then
|
|
Return GetAvailableDiskSpaceUnix(sPath)
|
|
Else
|
|
Return GetAvailableDiskSpaceWindows(sPath)
|
|
End If
|
|
End Function
|
|
|
|
'Delete file based on OS type
|
|
Public Shared Sub DeleteFile(ByVal sPath As String, Optional ByVal bRecycle As Boolean = True)
|
|
If File.Exists(sPath) Then
|
|
If IsUnix() Then
|
|
File.Delete(sPath)
|
|
Else
|
|
If bRecycle Then
|
|
My.Computer.FileSystem.DeleteFile(sPath, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
|
|
Else
|
|
File.Delete(sPath)
|
|
End If
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
'Delete directory based on OS type
|
|
Public Shared Sub DeleteDirectory(ByVal sPath As String, Optional ByVal bRecursive As Boolean = False)
|
|
If Directory.Exists(sPath) Then
|
|
If IsUnix() Then
|
|
Directory.Delete(sPath, bRecursive)
|
|
Else
|
|
My.Computer.FileSystem.DeleteDirectory(sPath, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
'Delete a sub-folder based on the provided backup information
|
|
Public Shared Sub DeleteDirectoryByBackup(ByVal sBackupFolder As String, ByVal oBackup As clsBackup)
|
|
Dim oDir As DirectoryInfo
|
|
Dim sDir As String = sBackupFolder & oBackup.SafeName
|
|
|
|
'Delete sub directory if it's empty
|
|
If oBackup.FileName.StartsWith(oBackup.SafeName & Path.DirectorySeparatorChar) Then
|
|
If Directory.Exists(sDir) Then
|
|
'Check if there's any sub-directories or files remaining
|
|
oDir = New DirectoryInfo(sDir)
|
|
If oDir.GetDirectories.Length = 0 And oDir.GetFiles.Length = 0 Then
|
|
'Folder is empty, delete the empty sub-folder
|
|
If Directory.Exists(sDir) Then DeleteDirectory(sDir)
|
|
End If
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
'Save string as text file
|
|
Public Shared Sub SaveText(ByVal sText As String, ByVal sPath As String)
|
|
Dim oStream As StreamWriter
|
|
|
|
Try
|
|
If File.Exists(sPath) Then DeleteFile(sPath, False)
|
|
oStream = New StreamWriter(sPath)
|
|
oStream.Write(sText)
|
|
oStream.Flush()
|
|
oStream.Close()
|
|
Catch ex As Exception
|
|
ShowMessage(mgrCommon_ErrorWritingTextFile, ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
End Sub
|
|
|
|
'Handles no extra parameters
|
|
Public Shared Function ShowMessage(ByVal sMsg As String, ByVal oType As MsgBoxStyle) As MsgBoxResult
|
|
Dim oResult As MsgBoxResult
|
|
oResult = MsgBox(FormatString(sMsg), oType, My.Resources.App_NameLong)
|
|
Return oResult
|
|
End Function
|
|
|
|
'Handles single parameter stings
|
|
Public Shared Function ShowMessage(ByVal sMsg As String, ByVal sParam As String, ByVal oType As MsgBoxStyle) As MsgBoxResult
|
|
Dim oResult As MsgBoxResult
|
|
oResult = MsgBox(FormatString(sMsg, sParam), oType, My.Resources.App_NameLong)
|
|
Return oResult
|
|
End Function
|
|
|
|
'Handles multi-parameter strings
|
|
Public Shared Function ShowMessage(ByVal sMsg As String, ByVal sParams As String(), ByVal oType As MsgBoxStyle) As MsgBoxResult
|
|
Dim oResult As MsgBoxResult
|
|
oResult = MsgBox(FormatString(sMsg, sParams), oType, My.Resources.App_NameLong)
|
|
Return oResult
|
|
End Function
|
|
|
|
'Handles no extra parameters
|
|
Public Shared Function FormatString(ByVal sString As String) As String
|
|
sString = sString.Replace("[BR]", vbCrLf)
|
|
|
|
Return sString
|
|
End Function
|
|
|
|
'Handles single parameter stings
|
|
Public Shared Function FormatString(ByVal sString As String, ByVal sParam As String) As String
|
|
sString = sString.Replace("[BR]", vbCrLf)
|
|
sString = sString.Replace("[PARAM]", sParam)
|
|
|
|
Return sString
|
|
End Function
|
|
|
|
'Handles multi-parameter strings
|
|
Public Shared Function FormatString(ByVal sString As String, ByVal sParams As String()) As String
|
|
Dim iParam As Integer
|
|
|
|
sString = sString.Replace("[BR]", vbCrLf)
|
|
|
|
For Each s As String In sParams
|
|
iParam = sString.IndexOf("[PARAM]")
|
|
sString = sString.Remove(iParam, 7)
|
|
sString = sString.Insert(iParam, s)
|
|
Next
|
|
|
|
Return sString
|
|
End Function
|
|
|
|
'Compare functions
|
|
Public Shared Function CompareImportTagsByName(oItem1 As Tag, oItem2 As Tag) As Integer
|
|
Return String.Compare(oItem1.Name, oItem2.Name)
|
|
End Function
|
|
|
|
Public Shared Function CompareByListBoxItemByValue(sItem1 As KeyValuePair(Of String, String), sItem2 As KeyValuePair(Of String, String)) As Integer
|
|
Return String.Compare(sItem1.Value, sItem2.Value)
|
|
End Function
|
|
|
|
'Maintenance Only - Function for string management
|
|
Public Shared Sub GetAllStrings(ByVal ctlParent As Control, ByRef sResource As String, ByRef sCode As String, ByVal sFormName As String)
|
|
For Each ctl As Control In ctlParent.Controls
|
|
If TypeOf ctl Is GroupBox Then
|
|
sResource &= sFormName & "_" & ctl.Name & vbTab & ctl.Text & vbCrLf
|
|
sCode &= ctl.Name & ".Text = " & sFormName & "_" & ctl.Name & vbCrLf
|
|
GetAllStrings(ctl, sResource, sCode, sFormName)
|
|
ElseIf TypeOf ctl Is TabControl Then
|
|
For Each tb As TabPage In ctl.Controls
|
|
GetAllStrings(tb, sResource, sCode, sFormName)
|
|
Next
|
|
ElseIf TypeOf ctl Is Label Then
|
|
sResource &= sFormName & "_" & ctl.Name & vbTab & ctl.Text & vbCrLf
|
|
sCode &= ctl.Name & ".Text = " & sFormName & "_" & ctl.Name & vbCrLf
|
|
ElseIf TypeOf ctl Is Button Then
|
|
sResource &= sFormName & "_" & ctl.Name & vbTab & ctl.Text & vbCrLf
|
|
sCode &= ctl.Name & ".Text = " & sFormName & "_" & ctl.Name & vbCrLf
|
|
ElseIf TypeOf ctl Is RadioButton Then
|
|
sResource &= sFormName & "_" & ctl.Name & vbTab & ctl.Text & vbCrLf
|
|
sCode &= ctl.Name & ".Text = " & sFormName & "_" & ctl.Name & vbCrLf
|
|
ElseIf TypeOf ctl Is CheckBox Then
|
|
sResource &= sFormName & "_" & ctl.Name & vbTab & ctl.Text & vbCrLf
|
|
sCode &= ctl.Name & ".Text = " & sFormName & "_" & ctl.Name & vbCrLf
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
End Class
|