Windows Service code example in VB.Net
A VB.Net Windows service code example with stand-alone compilation and installation scripts. The service contains a simple scheduler, enabling it to perform an arbitrary task you write yourself at configurable intervals.Download example code package
Instructions for editing, compiling and installing service:
- Rename TestService.vb and TestService.exe.config to <YourServiceName>.vb and <YourServiceName>.exe.config (no spaces in the name, please)
- Do a search/replace on all instances of the string "TestService" in <YourServiceName>.vb to name your service. Use the same <YourServiceName> as in step 1
- Set the service process account (Me.ServiceProcessInstaller1.Account) to either "ServiceAccount.NetworkService", "ServiceAccount.LocalService", "ServiceAccount.LocalSystem" or "ServiceAccount.User" according to your security design. Note that the NetworkService and LocalService accounts may need explicit read/execute NTFS permissions on the folder containing the service files for the service to be allowed to start
- Set ActionInterval in the .config file. This determines the interval in seconds between your service payload code execution
- Add your code and functions to <YourServiceName>.vb. The payload execution starts in the function RunPayload()
- Run Compile.vbs to build <YourServiceName>.exe
- Run ServiceInstall.vbs to install the service
- Look in the Windows application event log for messages from the service
Imports System
Imports System.Threading
Imports System.ServiceProcess
Imports System.Diagnostics
Imports System.Configuration
Imports System.Reflection
' Todo before using service:
' 1. Rename TestService.vb and TestService.exe.config to <YourServiceName>.vb and <YourServiceName>.exe.config (no spaces in the name, please)
' 2. Do a search/replace on all instances of the string "TestService" in this source file to name your service. Use the same <YourServiceName> as in step 1
' 3. Set the service process account (Me.ServiceProcessInstaller1.Account) to either "ServiceAccount.NetworkService", "ServiceAccount.LocalService", "ServiceAccount.LocalSystem" or "ServiceAccount.User" according to your security design. Note that the NetworkService and LocalService accounts may need explicit read/execute NTFS permissions on the folder containing the service files for the service to be allowed to start
' 4. Set ActionInterval in the .config file. This determines the interval in seconds between your service payload code execution
' 5. Add your code and functions to <YourServiceName>.vb. The payload execution starts in the function RunPayload()
' 6. Run Compile.vbs to build <YourServiceName>.exe
' 7. Run ServiceInstall.vbs to install the service. There is also a corresponding ServiceUnInstall.vbs that can be used to uninstall the service
' 8. Look in the Windows application event log for messages from the service
<Assembly: AssemblyTitle("TestService")>
<Assembly: AssemblyDescription(".NET Windows Test Service")>
<Assembly: AssemblyCompany("MyCompanyName")>
<Assembly: AssemblyProduct("TestService")>
<Assembly: AssemblyCopyright("Copyright (C) MyCompanyName")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: CLSCompliant(True)>
Public Class TestService
Private Shared ServiceThread As Thread
Private Shared PollingInterval As Integer = 10000
Private Shared ActionInterval As Integer = ConfigurationManager.AppSettings("ActionInterval")
Private Shared KeepRunning As Boolean = True
Public Sub RunPayload()
' Put your service payload code and/or function calls here. For example:
Try
WriteToEventLog("TestService payload execution", 1000)
Catch e As Exception
WriteToEventLog("An error occurred: " & e.Message, 2000, EventLogEntryType.Error)
End Try
End Sub
Public Sub StartWorkerThread()
Dim WorkerThread As Thread = New Thread(AddressOf RunPayload)
WorkerThread.Name = "TestService payload thread"
WorkerThread.Start()
End Sub
Public Sub RunScheduler()
Dim LastActionTime As Date = DateAdd(DateInterval.Day, -1, Date.Now)
Do While KeepRunning
If DateDiff(DateInterval.Second, LastActionTime, Date.Now) >= ActionInterval Then
LastActionTime = Date.Now
StartWorkerThread()
End If
Thread.Sleep(PollingInterval)
Loop
End Sub
Public Function WriteToEventLog( _
ByVal Entry As String, _
Optional ByVal EventID As Integer = 0, _
Optional ByVal EventType As EventLogEntryType = EventLogEntryType.Information, _
Optional ByVal AppName As String = "TestService", _
Optional ByVal LogName As String = "Application") As Boolean
Dim objEventLog As New EventLog()
Try
If Not Diagnostics.EventLog.SourceExists(AppName) Then
Diagnostics.EventLog.CreateEventSource(AppName, LogName)
End If
objEventLog.Source = AppName
objEventLog.WriteEntry(Entry, EventType, EventID)
Return True
Catch Ex As Exception
Return False
End Try
objEventLog.Dispose()
End Function
Protected Overrides Sub OnStart(ByVal args() As String)
WriteToEventLog("TestService starting", 1000)
ServiceThread = New Thread(AddressOf RunScheduler)
ServiceThread.Name = "TestService scheduler thread"
ServiceThread.Start()
End Sub
Protected Overrides Sub OnStop()
KeepRunning = False
WriteToEventLog("TestService stopping. " & _
"Please note: the worker process will live on for up to " & _
PollingInterval / 1000 & " seconds before it terminates.", 1000)
End Sub
End Class
<System.ComponentModel.RunInstaller(True)> _
Public Class ProjectInstaller
Inherits System.Configuration.Install.Installer
Public Sub New()
MyBase.New()
InitializeComponent()
End Sub
Private components As System.ComponentModel.IContainer
Private Sub InitializeComponent()
Me.ServiceProcessInstaller1 = New ServiceProcessInstaller
Me.ServiceInstaller1 = New ServiceInstaller
Me.ServiceProcessInstaller1.Account = ServiceAccount.LocalSystem
Me.ServiceProcessInstaller1.Password = Nothing
Me.ServiceProcessInstaller1.Username = Nothing
Me.ServiceInstaller1.ServiceName = "TestService"
Me.ServiceInstaller1.StartType = ServiceStartMode.Automatic
Me.Installers.AddRange(New System.Configuration.Install.Installer() {Me.ServiceProcessInstaller1, Me.ServiceInstaller1})
End Sub
Friend WithEvents ServiceProcessInstaller1 As ServiceProcessInstaller
Friend WithEvents ServiceInstaller1 As ServiceInstaller
End Class
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class TestService
Inherits System.ServiceProcess.ServiceBase
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
<MTAThread()> _
<System.Diagnostics.DebuggerNonUserCode()> _
Shared Sub Main()
Dim ServicesToRun() As System.ServiceProcess.ServiceBase
ServicesToRun = New System.ServiceProcess.ServiceBase() {New TestService}
System.ServiceProcess.ServiceBase.Run(ServicesToRun)
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
components = New System.ComponentModel.Container()
Me.ServiceName = "TestService"
End Sub
End Class
Imports System.Threading
Imports System.ServiceProcess
Imports System.Diagnostics
Imports System.Configuration
Imports System.Reflection
' Todo before using service:
' 1. Rename TestService.vb and TestService.exe.config to <YourServiceName>.vb and <YourServiceName>.exe.config (no spaces in the name, please)
' 2. Do a search/replace on all instances of the string "TestService" in this source file to name your service. Use the same <YourServiceName> as in step 1
' 3. Set the service process account (Me.ServiceProcessInstaller1.Account) to either "ServiceAccount.NetworkService", "ServiceAccount.LocalService", "ServiceAccount.LocalSystem" or "ServiceAccount.User" according to your security design. Note that the NetworkService and LocalService accounts may need explicit read/execute NTFS permissions on the folder containing the service files for the service to be allowed to start
' 4. Set ActionInterval in the .config file. This determines the interval in seconds between your service payload code execution
' 5. Add your code and functions to <YourServiceName>.vb. The payload execution starts in the function RunPayload()
' 6. Run Compile.vbs to build <YourServiceName>.exe
' 7. Run ServiceInstall.vbs to install the service. There is also a corresponding ServiceUnInstall.vbs that can be used to uninstall the service
' 8. Look in the Windows application event log for messages from the service
<Assembly: AssemblyTitle("TestService")>
<Assembly: AssemblyDescription(".NET Windows Test Service")>
<Assembly: AssemblyCompany("MyCompanyName")>
<Assembly: AssemblyProduct("TestService")>
<Assembly: AssemblyCopyright("Copyright (C) MyCompanyName")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: CLSCompliant(True)>
Public Class TestService
Private Shared ServiceThread As Thread
Private Shared PollingInterval As Integer = 10000
Private Shared ActionInterval As Integer = ConfigurationManager.AppSettings("ActionInterval")
Private Shared KeepRunning As Boolean = True
Public Sub RunPayload()
' Put your service payload code and/or function calls here. For example:
Try
WriteToEventLog("TestService payload execution", 1000)
Catch e As Exception
WriteToEventLog("An error occurred: " & e.Message, 2000, EventLogEntryType.Error)
End Try
End Sub
Public Sub StartWorkerThread()
Dim WorkerThread As Thread = New Thread(AddressOf RunPayload)
WorkerThread.Name = "TestService payload thread"
WorkerThread.Start()
End Sub
Public Sub RunScheduler()
Dim LastActionTime As Date = DateAdd(DateInterval.Day, -1, Date.Now)
Do While KeepRunning
If DateDiff(DateInterval.Second, LastActionTime, Date.Now) >= ActionInterval Then
LastActionTime = Date.Now
StartWorkerThread()
End If
Thread.Sleep(PollingInterval)
Loop
End Sub
Public Function WriteToEventLog( _
ByVal Entry As String, _
Optional ByVal EventID As Integer = 0, _
Optional ByVal EventType As EventLogEntryType = EventLogEntryType.Information, _
Optional ByVal AppName As String = "TestService", _
Optional ByVal LogName As String = "Application") As Boolean
Dim objEventLog As New EventLog()
Try
If Not Diagnostics.EventLog.SourceExists(AppName) Then
Diagnostics.EventLog.CreateEventSource(AppName, LogName)
End If
objEventLog.Source = AppName
objEventLog.WriteEntry(Entry, EventType, EventID)
Return True
Catch Ex As Exception
Return False
End Try
objEventLog.Dispose()
End Function
Protected Overrides Sub OnStart(ByVal args() As String)
WriteToEventLog("TestService starting", 1000)
ServiceThread = New Thread(AddressOf RunScheduler)
ServiceThread.Name = "TestService scheduler thread"
ServiceThread.Start()
End Sub
Protected Overrides Sub OnStop()
KeepRunning = False
WriteToEventLog("TestService stopping. " & _
"Please note: the worker process will live on for up to " & _
PollingInterval / 1000 & " seconds before it terminates.", 1000)
End Sub
End Class
<System.ComponentModel.RunInstaller(True)> _
Public Class ProjectInstaller
Inherits System.Configuration.Install.Installer
Public Sub New()
MyBase.New()
InitializeComponent()
End Sub
Private components As System.ComponentModel.IContainer
Private Sub InitializeComponent()
Me.ServiceProcessInstaller1 = New ServiceProcessInstaller
Me.ServiceInstaller1 = New ServiceInstaller
Me.ServiceProcessInstaller1.Account = ServiceAccount.LocalSystem
Me.ServiceProcessInstaller1.Password = Nothing
Me.ServiceProcessInstaller1.Username = Nothing
Me.ServiceInstaller1.ServiceName = "TestService"
Me.ServiceInstaller1.StartType = ServiceStartMode.Automatic
Me.Installers.AddRange(New System.Configuration.Install.Installer() {Me.ServiceProcessInstaller1, Me.ServiceInstaller1})
End Sub
Friend WithEvents ServiceProcessInstaller1 As ServiceProcessInstaller
Friend WithEvents ServiceInstaller1 As ServiceInstaller
End Class
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class TestService
Inherits System.ServiceProcess.ServiceBase
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
<MTAThread()> _
<System.Diagnostics.DebuggerNonUserCode()> _
Shared Sub Main()
Dim ServicesToRun() As System.ServiceProcess.ServiceBase
ServicesToRun = New System.ServiceProcess.ServiceBase() {New TestService}
System.ServiceProcess.ServiceBase.Run(ServicesToRun)
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
components = New System.ComponentModel.Container()
Me.ServiceName = "TestService"
End Sub
End Class
TestService.exe.config
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
<appSettings>
<!-- ActionInterval is the interval in seconds between execution of the service payload. Minimum is 10 seconds and please use multiples of 10 -->
<add key="ActionInterval" value="600" />
</appSettings>
</configuration>
<configuration>
<appSettings>
<!-- ActionInterval is the interval in seconds between execution of the service payload. Minimum is 10 seconds and please use multiples of 10 -->
<add key="ActionInterval" value="600" />
</appSettings>
</configuration>
ServiceInstall.vbs
Option Explicit
Dim strCurPath
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
If GetOsMajorVersion() >= 6 Then ' UAC elevation needed in Windows Vista, 2008 and 7
If WScript.Arguments.Length = 0 Then
Dim objShell
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " """ & strCurPath & """", "", "runas", 1
Else
CheckServiceExe(WScript.Arguments.Item(0))
InstallService(WScript.Arguments.Item(0))
End If
Else
CheckServiceExe(strCurPath)
InstallService(strCurPath)
End If
Function InstallService(strCurPath)
Dim strPathToInstallUtil
Dim strInstallOptions
Dim strCommandOutput
strCommandOutput = ""
strPathToInstallUtil = GetNewestInstalledFrameworkPath() & "\installutil.exe"
strInstallOptions = ""
Dim objFs
Dim objFolder
Dim objFile
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(strCurPath)
For Each objFile in objFolder.Files
If Right(objFile.Name, 4) = ".exe" Then
strCommandOutput = "Service installation summary:" & vbcrlf & vbcrlf
strCommandOutput = strCommandOutput & runCMD(strPathToInstallUtil & " " & strInstallOptions & """" & strCurPath & "\" & objFile.Name & """")
strCommandOutput = strCommandOutput & runCMD("NET START " & Replace(objFile.Name, ".exe", ""))
If strCommandOutput <> "" Then
Wscript.Echo(strCommandOutput)
End If
End If
Next
End Function
Function CheckServiceExe(strCurPath)
Dim blnExeFound
blnExeFound = False
Dim objFs
Dim objFolder
Dim objFile
Dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(strCurPath)
For Each objFile in objFolder.Files
If Right(objFile.Name, 4) = ".exe" Then
blnExeFound = True
Exit For
End If
Next
If blnExeFound = False Then ' No exe file found in service folder. Run compile script to generate it
objShell.currentdirectory = strCurPath
objShell.Run "Compile.vbs", 1, true
End If
Set objShell = Nothing
Set objFs = Nothing
Set objFolder = Nothing
End Function
Function GetNewestInstalledFrameworkPath()
Dim objWsh
Set objWsh = CreateObject("Wscript.Shell")
Dim strFoundPath
Dim objFs
Set objFs = CreateObject("Scripting.FileSystemObject")
Dim i
Dim strArrayPaths
Dim strArrayRegKeys
strFoundPath = ""
strArrayPaths = _
Array("C:\Windows\Microsoft.NET\Framework64\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework64\v2.0.50727", _
"C:\Windows\Microsoft.NET\Framework\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework\v2.0.50727")
strArrayRegKeys = _
Array("HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install")
For i = 0 To Ubound(strArrayPaths)
If objFs.FileExists(strArrayPaths(i) & "\installutil.exe") Then
On Error Resume Next
If objWsh.RegRead(strArrayRegKeys(i)) = 1 Then
If Err.number = 0 Then
strFoundPath = strArrayPaths(i)
Exit For
End If
End If
On Error Goto 0
End If
Next
Set objFs = Nothing
Set objWsh = Nothing
GetNewestInstalledFrameworkPath = strFoundPath
End Function
Function GetOsMajorVersion()
Dim objWSHShell
Set objWSHShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
GetOsMajorVersion = CInt(Left(objWSHShell.RegRead("HKLM\Software\Microsoft\Windows NT\CurrentVersion\CurrentVersion"), 1))
If err.number <> 0 Then
GetOsMajorVersion = 1000
End If
On Error Goto 0
End Function
Function runCMD(strRunCmd)
Dim objShell, objExec, strOut
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExec = objShell.Exec(strRunCmd)
strOut = ""
Do While Not objExec.StdOut.AtEndOfStream
strOut = strOut & objExec.StdOut.ReadLine() & vbcrlf
Loop
Set objShell = Nothing
Set objExec = Nothing
runCMD = strOut
End Function
Dim strCurPath
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
If GetOsMajorVersion() >= 6 Then ' UAC elevation needed in Windows Vista, 2008 and 7
If WScript.Arguments.Length = 0 Then
Dim objShell
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " """ & strCurPath & """", "", "runas", 1
Else
CheckServiceExe(WScript.Arguments.Item(0))
InstallService(WScript.Arguments.Item(0))
End If
Else
CheckServiceExe(strCurPath)
InstallService(strCurPath)
End If
Function InstallService(strCurPath)
Dim strPathToInstallUtil
Dim strInstallOptions
Dim strCommandOutput
strCommandOutput = ""
strPathToInstallUtil = GetNewestInstalledFrameworkPath() & "\installutil.exe"
strInstallOptions = ""
Dim objFs
Dim objFolder
Dim objFile
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(strCurPath)
For Each objFile in objFolder.Files
If Right(objFile.Name, 4) = ".exe" Then
strCommandOutput = "Service installation summary:" & vbcrlf & vbcrlf
strCommandOutput = strCommandOutput & runCMD(strPathToInstallUtil & " " & strInstallOptions & """" & strCurPath & "\" & objFile.Name & """")
strCommandOutput = strCommandOutput & runCMD("NET START " & Replace(objFile.Name, ".exe", ""))
If strCommandOutput <> "" Then
Wscript.Echo(strCommandOutput)
End If
End If
Next
End Function
Function CheckServiceExe(strCurPath)
Dim blnExeFound
blnExeFound = False
Dim objFs
Dim objFolder
Dim objFile
Dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(strCurPath)
For Each objFile in objFolder.Files
If Right(objFile.Name, 4) = ".exe" Then
blnExeFound = True
Exit For
End If
Next
If blnExeFound = False Then ' No exe file found in service folder. Run compile script to generate it
objShell.currentdirectory = strCurPath
objShell.Run "Compile.vbs", 1, true
End If
Set objShell = Nothing
Set objFs = Nothing
Set objFolder = Nothing
End Function
Function GetNewestInstalledFrameworkPath()
Dim objWsh
Set objWsh = CreateObject("Wscript.Shell")
Dim strFoundPath
Dim objFs
Set objFs = CreateObject("Scripting.FileSystemObject")
Dim i
Dim strArrayPaths
Dim strArrayRegKeys
strFoundPath = ""
strArrayPaths = _
Array("C:\Windows\Microsoft.NET\Framework64\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework64\v2.0.50727", _
"C:\Windows\Microsoft.NET\Framework\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework\v2.0.50727")
strArrayRegKeys = _
Array("HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install")
For i = 0 To Ubound(strArrayPaths)
If objFs.FileExists(strArrayPaths(i) & "\installutil.exe") Then
On Error Resume Next
If objWsh.RegRead(strArrayRegKeys(i)) = 1 Then
If Err.number = 0 Then
strFoundPath = strArrayPaths(i)
Exit For
End If
End If
On Error Goto 0
End If
Next
Set objFs = Nothing
Set objWsh = Nothing
GetNewestInstalledFrameworkPath = strFoundPath
End Function
Function GetOsMajorVersion()
Dim objWSHShell
Set objWSHShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
GetOsMajorVersion = CInt(Left(objWSHShell.RegRead("HKLM\Software\Microsoft\Windows NT\CurrentVersion\CurrentVersion"), 1))
If err.number <> 0 Then
GetOsMajorVersion = 1000
End If
On Error Goto 0
End Function
Function runCMD(strRunCmd)
Dim objShell, objExec, strOut
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExec = objShell.Exec(strRunCmd)
strOut = ""
Do While Not objExec.StdOut.AtEndOfStream
strOut = strOut & objExec.StdOut.ReadLine() & vbcrlf
Loop
Set objShell = Nothing
Set objExec = Nothing
runCMD = strOut
End Function
ServiceUninstall.vbs
Option Explicit
Dim strCurPath
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
If GetOsMajorVersion() >= 6 Then ' UAC elevation needed in Windows Vista, 2008 and 7
If WScript.Arguments.Length = 0 Then
Dim objShell
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " """ & strCurPath & """", "", "runas", 1
Else
UnInstallService(WScript.Arguments.Item(0))
End If
Else
UnInstallService(strCurPath)
End If
Function UnInstallService(strCurPath)
Dim strPathToInstallUtil
Dim strInstallOptions
Dim strCommandOutput
strCommandOutput = ""
strPathToInstallUtil = GetNewestInstalledFrameworkPath() & "\installutil.exe"
strInstallOptions = "/u "
Dim objFs
Dim objFolder
Dim objFile
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(strCurPath)
For Each objFile in objFolder.Files
If Right(objFile.Name, 4) = ".exe" Then
strCommandOutput = "Service uninstallation summary:" & vbcrlf & vbcrlf
strCommandOutput = strCommandOutput & runCMD("NET STOP " & Replace(objFile.Name, ".exe", ""))
strCommandOutput = strCommandOutput & runCMD(strPathToInstallUtil & " " & strInstallOptions & """" & strCurPath & "\" & objFile.Name & """")
If strCommandOutput <> "" Then
Wscript.Echo(strCommandOutput)
End If
End If
Next
End Function
Function GetNewestInstalledFrameworkPath()
Dim objWsh
Set objWsh = CreateObject("Wscript.Shell")
Dim strFoundPath
Dim objFs
Set objFs = CreateObject("Scripting.FileSystemObject")
Dim i
Dim strArrayPaths
Dim strArrayRegKeys
strFoundPath = ""
strArrayPaths = _
Array("C:\Windows\Microsoft.NET\Framework64\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework64\v2.0.50727", _
"C:\Windows\Microsoft.NET\Framework\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework\v2.0.50727")
strArrayRegKeys = _
Array("HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install")
For i = 0 To Ubound(strArrayPaths)
If objFs.FileExists(strArrayPaths(i) & "\installutil.exe") Then
On Error Resume Next
If objWsh.RegRead(strArrayRegKeys(i)) = 1 Then
If Err.number = 0 Then
strFoundPath = strArrayPaths(i)
Exit For
End If
End If
On Error Goto 0
End If
Next
Set objFs = Nothing
Set objWsh = Nothing
GetNewestInstalledFrameworkPath = strFoundPath
End Function
Function GetOsMajorVersion()
Dim objWSHShell
Set objWSHShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
GetOsMajorVersion = CInt(Left(objWSHShell.RegRead("HKLM\Software\Microsoft\Windows NT\CurrentVersion\CurrentVersion"), 1))
If err.number <> 0 Then
GetOsMajorVersion = 1000
End If
On Error Goto 0
End Function
Function runCMD(strRunCmd)
Dim objShell, objExec, strOut
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExec = objShell.Exec(strRunCmd)
strOut = ""
Do While Not objExec.StdOut.AtEndOfStream
strOut = strOut & objExec.StdOut.ReadLine() & vbcrlf
Loop
Set objShell = Nothing
Set objExec = Nothing
runCMD = strOut
End Function
Dim strCurPath
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
If GetOsMajorVersion() >= 6 Then ' UAC elevation needed in Windows Vista, 2008 and 7
If WScript.Arguments.Length = 0 Then
Dim objShell
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " """ & strCurPath & """", "", "runas", 1
Else
UnInstallService(WScript.Arguments.Item(0))
End If
Else
UnInstallService(strCurPath)
End If
Function UnInstallService(strCurPath)
Dim strPathToInstallUtil
Dim strInstallOptions
Dim strCommandOutput
strCommandOutput = ""
strPathToInstallUtil = GetNewestInstalledFrameworkPath() & "\installutil.exe"
strInstallOptions = "/u "
Dim objFs
Dim objFolder
Dim objFile
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(strCurPath)
For Each objFile in objFolder.Files
If Right(objFile.Name, 4) = ".exe" Then
strCommandOutput = "Service uninstallation summary:" & vbcrlf & vbcrlf
strCommandOutput = strCommandOutput & runCMD("NET STOP " & Replace(objFile.Name, ".exe", ""))
strCommandOutput = strCommandOutput & runCMD(strPathToInstallUtil & " " & strInstallOptions & """" & strCurPath & "\" & objFile.Name & """")
If strCommandOutput <> "" Then
Wscript.Echo(strCommandOutput)
End If
End If
Next
End Function
Function GetNewestInstalledFrameworkPath()
Dim objWsh
Set objWsh = CreateObject("Wscript.Shell")
Dim strFoundPath
Dim objFs
Set objFs = CreateObject("Scripting.FileSystemObject")
Dim i
Dim strArrayPaths
Dim strArrayRegKeys
strFoundPath = ""
strArrayPaths = _
Array("C:\Windows\Microsoft.NET\Framework64\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework64\v2.0.50727", _
"C:\Windows\Microsoft.NET\Framework\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework\v2.0.50727")
strArrayRegKeys = _
Array("HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install")
For i = 0 To Ubound(strArrayPaths)
If objFs.FileExists(strArrayPaths(i) & "\installutil.exe") Then
On Error Resume Next
If objWsh.RegRead(strArrayRegKeys(i)) = 1 Then
If Err.number = 0 Then
strFoundPath = strArrayPaths(i)
Exit For
End If
End If
On Error Goto 0
End If
Next
Set objFs = Nothing
Set objWsh = Nothing
GetNewestInstalledFrameworkPath = strFoundPath
End Function
Function GetOsMajorVersion()
Dim objWSHShell
Set objWSHShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
GetOsMajorVersion = CInt(Left(objWSHShell.RegRead("HKLM\Software\Microsoft\Windows NT\CurrentVersion\CurrentVersion"), 1))
If err.number <> 0 Then
GetOsMajorVersion = 1000
End If
On Error Goto 0
End Function
Function runCMD(strRunCmd)
Dim objShell, objExec, strOut
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExec = objShell.Exec(strRunCmd)
strOut = ""
Do While Not objExec.StdOut.AtEndOfStream
strOut = strOut & objExec.StdOut.ReadLine() & vbcrlf
Loop
Set objShell = Nothing
Set objExec = Nothing
runCMD = strOut
End Function
Compile.vbs
Option Explicit
Dim strPathToCompiler
Dim strCompileOptions
Dim strSourceCodeExt
Dim strCurPath
Dim strCommandOutput
strCommandOutput = ""
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
strPathToCompiler = GetNewestInstalledFrameworkPath() & "\vbc.exe"
strCompileOptions = "/target:winexe /nologo"
strSourceCodeExt = ".vb"
Dim objFs
Dim objFolder
Dim objFile
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(strCurPath)
For Each objFile in objFolder.Files
If Right(objFile.Name, 3) = strSourceCodeExt Then
strCommandOutput = runCMD(strPathToCompiler & " /out:""" & strCurPath & "\" & Left(objFile.Name, InStr(objFile.Name, strSourceCodeExt)) & "exe"" " & strCompileOptions & " """ & objFile.Name & """")
If strCommandOutput <> "" Then
Wscript.Echo(strCommandOutput)
End If
End If
Next
Function GetNewestInstalledFrameworkPath()
Dim objWsh
Set objWsh = CreateObject("Wscript.Shell")
Dim strFoundPath
Dim objFs
Set objFs = CreateObject("Scripting.FileSystemObject")
Dim i
Dim strArrayPaths
Dim strArrayRegKeys
strFoundPath = ""
strArrayPaths = _
Array("C:\Windows\Microsoft.NET\Framework64\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework64\v2.0.50727", _
"C:\Windows\Microsoft.NET\Framework\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework\v2.0.50727")
strArrayRegKeys = _
Array("HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install")
For i = 0 To Ubound(strArrayPaths)
If objFs.FileExists(strArrayPaths(i) & "\vbc.exe") Then
On Error Resume Next
If objWsh.RegRead(strArrayRegKeys(i)) = 1 Then
If Err.number = 0 Then
strFoundPath = strArrayPaths(i)
Exit For
End If
End If
On Error Goto 0
End If
Next
Set objFs = Nothing
Set objWsh = Nothing
GetNewestInstalledFrameworkPath = strFoundPath
End Function
Function runCMD(strRunCmd)
Dim objShell, objExec, strOut
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExec = objShell.Exec(strRunCmd)
strOut = ""
Do While Not objExec.StdOut.AtEndOfStream
strOut = strOut & objExec.StdOut.ReadLine() & vbcrlf
Loop
Set objShell = Nothing
Set objExec = Nothing
runCMD = strOut
End Function
Dim strPathToCompiler
Dim strCompileOptions
Dim strSourceCodeExt
Dim strCurPath
Dim strCommandOutput
strCommandOutput = ""
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
strPathToCompiler = GetNewestInstalledFrameworkPath() & "\vbc.exe"
strCompileOptions = "/target:winexe /nologo"
strSourceCodeExt = ".vb"
Dim objFs
Dim objFolder
Dim objFile
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(strCurPath)
For Each objFile in objFolder.Files
If Right(objFile.Name, 3) = strSourceCodeExt Then
strCommandOutput = runCMD(strPathToCompiler & " /out:""" & strCurPath & "\" & Left(objFile.Name, InStr(objFile.Name, strSourceCodeExt)) & "exe"" " & strCompileOptions & " """ & objFile.Name & """")
If strCommandOutput <> "" Then
Wscript.Echo(strCommandOutput)
End If
End If
Next
Function GetNewestInstalledFrameworkPath()
Dim objWsh
Set objWsh = CreateObject("Wscript.Shell")
Dim strFoundPath
Dim objFs
Set objFs = CreateObject("Scripting.FileSystemObject")
Dim i
Dim strArrayPaths
Dim strArrayRegKeys
strFoundPath = ""
strArrayPaths = _
Array("C:\Windows\Microsoft.NET\Framework64\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework64\v2.0.50727", _
"C:\Windows\Microsoft.NET\Framework\v4.0.30319", _
"C:\Windows\Microsoft.NET\Framework\v2.0.50727")
strArrayRegKeys = _
Array("HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v4\Full\Install", _
"HKLM\Software\Microsoft\NET Framework Setup\NDP\v2.0.50727\Install")
For i = 0 To Ubound(strArrayPaths)
If objFs.FileExists(strArrayPaths(i) & "\vbc.exe") Then
On Error Resume Next
If objWsh.RegRead(strArrayRegKeys(i)) = 1 Then
If Err.number = 0 Then
strFoundPath = strArrayPaths(i)
Exit For
End If
End If
On Error Goto 0
End If
Next
Set objFs = Nothing
Set objWsh = Nothing
GetNewestInstalledFrameworkPath = strFoundPath
End Function
Function runCMD(strRunCmd)
Dim objShell, objExec, strOut
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExec = objShell.Exec(strRunCmd)
strOut = ""
Do While Not objExec.StdOut.AtEndOfStream
strOut = strOut & objExec.StdOut.ReadLine() & vbcrlf
Loop
Set objShell = Nothing
Set objExec = Nothing
runCMD = strOut
End Function
Tags: dotnet
Page last updated 2016-02-07 20:19. Some rights reserved (CC by 3.0)