VB.NET 写一个文件

Const ForWriting = 2
Set gfs = CreateObject("GRFSL.FileSystemLib")
Set ts = gfs.OpenTextStream("<FILENAME>", ForWriting)
ts.WriteLine "<CONTENT>"
ts.CloseStream

VB.NET 状态标签

#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

VB.NET 注册处

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

VB.NET 应用版本

'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

VB.NET SevenZip

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

VB.NET 精密定时器

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

VB.NET Ultimate Pad String

''' <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

VB.NET 获取网址

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

VB.NET 以编程方式注册客户端JavaScript

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

VB.NET 电子邮件地址格式验证

''' <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