#Region "Status"
Private WithEvents StatusTimer As New Timer()
Public Sub SetStatusText(ByVal value As String)
lblStatus.Text = value
End Sub
''' <summary>Set status text and auto-clear after fixed number seconds</summary>
''' <param name="value">Text to display on status bar</param>
''' <param name="interval">Seconds to wait before clearing the status</param>
Public Sub SetStatusText(ByVal value As String, ByVal interval As Int32)
statusTimer.Interval = interval * 1000
statusTimer.Start()
SetStatusText(value)
End Sub
Public Sub ClearStatusText()
lblStatus.Text = ""
End Sub
''' <summary>Clear StatusBar</summary>
Private Sub ClearStatusText(ByVal sender As Object, ByVal e As EventArgs) Handles statusTimer.Tick
lblStatus.Text = ""
statusTimer.Stop()
End Sub
#End Region
Imports Microsoft.Win32
#Region "Registry"
Public Shared Function GetRegKey(ByVal name As String) As String
Dim reg As RegistryKey = Nothing
'regkey is built from CompanyName\ProductName\MajorVersion.MinorVersion
Dim version As String = Convert.ToString(My.Application.Info.Version.Major) & "." & _
Convert.ToString(My.Application.Info.Version.Minor)
Try
reg = Registry.CurrentUser.OpenSubKey("Software\" & _
My.Application.Info.CompanyName & "\" & My.Application.Info.ProductName & "\" & version)
If reg IsNot Nothing Then
Return Convert.ToString(reg.GetValue(name))
End If
Finally
If reg IsNot Nothing Then reg.Close()
End Try
Return Nothing
End Function
Public Shared Function SetRegKey(ByVal name As String, ByVal value As String) As Boolean
Dim reg As RegistryKey = Nothing
'regkey is built from CompanyName\ProductName\MajorVersion.MinorVersion
Dim version As String = Convert.ToString(My.Application.Info.Version.Major) & "." & _
Convert.ToString(My.Application.Info.Version.Minor)
Try
reg = Registry.CurrentUser.CreateSubKey("Software\" & _
My.Application.Info.CompanyName & "\" & My.Application.Info.ProductName & "\" & version)
reg.SetValue(name, value)
Return True
Catch ex As Exception
Return False
Finally
If reg IsNot Nothing Then reg.Close()
End Try
End Function
Public Shared Function DeleteRegKey(ByVal name As String) As Boolean
Dim reg As RegistryKey = Nothing
'regkey is built from CompanyName\ProductName\MajorVersion.MinorVersion
Dim version As String = Convert.ToString(My.Application.Info.Version.Major) & "." & _
Convert.ToString(My.Application.Info.Version.Minor)
Try
Registry.CurrentUser.DeleteSubKey("Software\" & _
My.Application.Info.CompanyName & "\" & My.Application.Info.ProductName & "\" & version & "\" & name, False)
Return True
Catch aex As ArgumentException
Return True
Catch ex As Exception
Return False
Finally
If reg IsNot Nothing Then reg.Close()
End Try
End Function
Public Shared Function DeleteRegKeyAll() As Boolean
Dim reg As RegistryKey = Nothing
'regkey is built from CompanyName\ProductName\MajorVersion.MinorVersion
Dim version As String = Convert.ToString(My.Application.Info.Version.Major) & "." & _
Convert.ToString(My.Application.Info.Version.Minor)
Try
Registry.CurrentUser.DeleteSubKeyTree("Software\" & _
My.Application.Info.CompanyName & "\" & My.Application.Info.ProductName & "\" & version)
Return True
Catch aex As ArgumentException
'key doesnt exist
Return True
Catch ex As Exception
Return False
Finally
If reg IsNot Nothing Then reg.Close()
End Try
End Function
#End Region
'set version number label
Dim ver As String = Application.ProductVersion
lblVersion.Text = "v" & ver.Substring(0, ver.Length-2)
'set title on application
Me.Text = My.Application.Info.ProductName & " " & lblVersion.Text
Option Strict On
Imports System.ComponentModel
Public Class SevenZip
Private Shared ZipPath As String = AppController.RootPath & "7z.exe"
Public Event OnZipComplete(ByVal ZipFileName As String)
Public Shared Function Extract(ByVal filename As String, ByVal zipname As String) As Process
Dim p As New Process()
p.StartInfo.FileName = ZipPath
p.StartInfo.Arguments = "x -y -o""" & filename & """ """ & zipname & """"
p.StartInfo.CreateNoWindow = True
p.Start()
Return p
End Function
Public Shared Function Compress(ByVal filename As String, ByVal zipname As String) As Process
Dim p As New Process()
p.StartInfo.FileName = ZipPath
p.StartInfo.Arguments = "a -r -tzip """ & zipname & """ """ & filename & """"
p.StartInfo.CreateNoWindow = True
p.Start()
Return p
End Function
Public Shared Function Compress(ByVal filename As String, ByVal zipnames() As String) As Process
Dim p As New Process()
p.StartInfo.FileName = ZipPath
Dim args As String = "a -r -tzip "
Dim s As String
For Each s In zipnames
args &= """" & s & """ "
Next
p.StartInfo.Arguments = args & filename & """"
p.StartInfo.CreateNoWindow = True
p.Start()
Return p
End Function
Private Structure FileCopy
Public Source As String
Public Destination As String
Public Sub New(ByVal source As String, ByVal dest As String)
Me.Source = source
Me.Destination = dest
End Sub
End Structure
Public Sub CompressInNewThread(ByVal filename As String, ByVal zipname As String)
Dim fc As New FileCopy(filename, zipname)
'run zip compress in another thread
bw = New System.ComponentModel.BackgroundWorker()
bw.RunWorkerAsync(fc)
End Sub
Private WithEvents bw As BackgroundWorker
Private Sub StartZip(ByVal sender As Object, ByVal e As DoWorkEventArgs) Handles bw.DoWork
Dim fc As FileCopy = DirectCast(e.Argument, FileCopy)
Dim p As New Process()
p.StartInfo.FileName = ZipPath
p.StartInfo.Arguments = "a -r -tzip """ & fc.Destination & """ """ & fc.Source & """"
p.Start()
p.WaitForExit()
'return the zip filepath
e.Result = fc.Destination
End Sub
Private Sub EndZip(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs) Handles bw.RunWorkerCompleted
RaiseEvent OnZipComplete(Convert.ToString(e.Result))
End Sub
End Class
Imports System.Timers
Public Class StopWatch
Private WithEvents timer As Timers.Timer 'use system timer
Private _StartTime As Date
Private _CurrentTime As Date
Private _TargetTime As Date
Public Delegate Sub ElapsedEventHandler(ByVal sender As System.Object, ByVal e As ElapsedEventArgs)
Public Event Elapsed As ElapsedEventHandler
Public ReadOnly Property ElapsedTime() As TimeSpan
Get
Return Me._CurrentTime.Subtract(Me._StartTime)
End Get
End Property
Public ReadOnly Property RemainingTime() As TimeSpan
Get
If Me._TargetTime = Nothing Then
Return Nothing
ElseIf TimeSpan.Compare(Me._TargetTime.Subtract(Me._CurrentTime), TimeSpan.Zero) = -1 Then
Return TimeSpan.Zero
Else
Return Me._TargetTime.Subtract(Me._CurrentTime)
End If
End Get
End Property
Public Sub SetTargetTime(ByVal mins As Double)
Me._TargetTime = Me._StartTime.AddMinutes(mins)
End Sub
Public Sub New()
'create timer object
Me.timer = New Timers.Timer()
'initialise internal timer
Me._StartTime = Date.Now
Me._CurrentTime = Me._StartTime
End Sub
Public Sub Start()
Me.PrevTime = Now 'initialise timer
Me.timer.Start()
End Sub
Public Sub [Stop]()
Me.timer.Stop()
End Sub
Public Sub Reset()
Me.Stop()
'recreate timer object
Me.timer = New Timers.Timer()
'initialise internal timer
Me._StartTime = Date.Now
Me._CurrentTime = Me._StartTime
End Sub
Private PrevTime As Date 'record real time for diff
Private DiffTime As TimeSpan
Private Sub Timer_Tick(ByVal sender As System.Object, ByVal e As Timers.ElapsedEventArgs) Handles timer.Elapsed
'retrieve time diff from last tick
Me.DiffTime = e.SignalTime.Subtract(Me.PrevTime)
'increment internal timer
Me._CurrentTime = Me._CurrentTime.Add(Me.DiffTime)
'check reached target time
If Not Me._TargetTime = Nothing Then
If Me._CurrentTime >= Me._TargetTime Then Me.Stop()
End If
'record event time for next tick
Me.PrevTime = e.SignalTime
'raise event to main form
RaiseEvent Elapsed(sender, New ElapsedEventArgs(Me._CurrentTime))
End Sub
End Class
Public Class ElapsedEventArgs
Inherits EventArgs
Private _SignalTime As DateTime
Public ReadOnly Property SignalTime As DateTime
Get
Return _SignalTime
End Get
End Property
Friend Sub New(ByVal SignalTime As DateTime)
_SignalTime = SignalTime
End Sub
End Class
''' <summary>Pad an int with an arbitary number of chars</summary>
''' <param name="n">Integer to pad</param>
''' <param name="len">Length of the resulting padded string</param>
''' <param name="c">Char to pad</param>
''' <returns>Padded string</returns>
Private Function Pad(ByVal n As Int32, ByVal len As Int32, ByVal c As Char) As String
If n > (10^len) Then
Return Convert.ToString(n)
ElseIf n < (10^len) And n > (10^(len-1)) Then
Return Pad(n, len-1, c)
Else
Dim t As String = Convert.ToString(n)
Dim s As String = ""
For j As Int32 = 1 To len - t.Length
s &= c
Next
Return s & n
End If
End Function
''' <summary>Pad an int with an arbitary number of zeros</summary>
''' <param name="n">Integer to pad</param>
''' <param name="len">Length of the resulting padded string</param>
''' <returns>Padded string</returns>
Private Function Pad(ByVal n As Int32, ByVal len As Int32) As String
Return Pad(n, len, "0"c)
End Function
Public Function GetUrl() As String
Dim strTemp As String = ""
If (Request.ServerVariables("HTTPS") = "on") Then
strTemp = "https://"
Else
strTemp = "http://"
End If
strTemp = (strTemp + Request.ServerVariables("SERVER_NAME"))
If (Request.ServerVariables("SERVER_PORT") <> "80") Then
strTemp = (strTemp + (":" + Request.ServerVariables("SERVER_PORT")))
End If
strTemp = (strTemp + Request.ApplicationPath)
Return strTemp
End Function
Private Sub RegisterJavascript()
' Define the name and type of the client scripts on the page.
Dim ClientScriptName As String = "LinkClick"
Dim PageType As Type = Me.GetType()
' Get a ClientScriptManager reference from the Page class.
Dim csm As ClientScriptManager = Page.ClientScript
' Check to see if the client script is already registered.
If (Not csm.IsClientScriptBlockRegistered(PageType, ClientScriptName)) Then
Dim ClientScriptText As New StringBuilder()
ClientScriptText.AppendLine("function ToAccountDetails(un) {")
ClientScriptText.AppendLine(" document.getElementById(""UserName"").value = un;")
ClientScriptText.AppendLine(" document.getElementById(""frmToAccountDetails"").submit();")
ClientScriptText.AppendLine("}")
csm.RegisterClientScriptBlock(PageType, ClientScriptName, ClientScriptText.ToString(), True)
End If
End Sub
''' <summary>
''' Determines whether provided email address is properly formatted.
''' </summary>
''' <param name="s"></param>
''' <returns></returns>
''' <remarks></remarks>
Private Function IsValidEmailFormat(ByVal s As String) As Boolean
Dim result As Boolean = False
If Not String.IsNullOrEmpty(s) Then
'^[_a-zA-Z0-9-]+(\.[_a-zA-Z0-9-]+)*@[a-zA-Z0-9-]+(\.[a-zA-Z0-9-]+)*\.(([0-9]{1,3})|([a-zA-Z]{2,3})|(aero|coop|info|museum|name))$
Dim pattern As String = My.Settings.Email_Validation_Pattern
Dim match As RegularExpressions.Match = RegularExpressions.Regex.Match(s, pattern)
result = match.Success
End If
Return result
End Function