24个关于非常实用的Install/Setup方面的函数
包括CreateUser、GetCurrentPath、ResetIIS、StopService、StartService、RegisterCOMDLL、InstallWebs、ReinstallWebApp、CreateWebApp、UninstallWebApplication、CreateDirectory、DeleteFile、DeleteAllSubFolders、DeleteFolder、RecursiveCopyFiles、CopyFolder、GetLastDirectoryName、CreateDatabase、ExecuteSQL、ExecuteOSQL、ExecuteProcess、GrantDBAccessNT、GrantDBAccessInteg 等二十多个有用的函数
使用方法：copy下面的代码到一个单独的vb文件中即可使用或单独使用
Imports System.IO
Imports System.Data
Imports System.Data.SqlClient
Imports System.ServiceProcess
Imports System.DirectoryServices
Imports System.Runtime.InteropServicesModule Utils
Public WebRoot As String = "C:\inetpub\wwwroot"#Region "Users and Groupd"
Const UF_SCRIPT As Integer = 1
Const UF_ACCOUNTDISABLE As Integer = 2
Const UF_HOMEDIR_REQUIRED As Integer = 8
Const UF_LOCKOUT As Integer = 16
Const UF_PASSWD_NOTREQD As Integer = 32
Const UF_PASSWD_CANT_CHANGE As Integer = 64
Const UF_TEMP_DUPLICATE_ACCOUNT As Integer = 256
Const UF_NORMAL_ACCOUNT As Integer = 512 Public Sub CreateUser(ByVal userName As String, ByVal password As String)
Dim NewUser As DirectoryEntry
Dim AD As New DirectoryEntry("WinNT://" + Environment.MachineName + ",computer")
Try
NewUser = AD.Children.Find(userName, "user")
AD.Children.Remove(NewUser)
Catch ex As COMException End Try
NewUser = AD.Children.Add(userName, "user")
NewUser.Properties("description").Add(userName) NewUser.Properties("userFlags").Add(UF_NORMAL_ACCOUNT)
' invoke native method 'SetPassword' before commiting
' for domain accounts this must be done after commiting NewUser.Invoke("SetPassword", New Object() {password})
NewUser.CommitChanges() ' Add user to guests
' DirectoryEntry(grp = AD.Children.Find("Guests", "group"))
'if (grp.Name != null)
'grp.Invoke("Add", new Object[] {NewUser.Path.ToString()});
Console.WriteLine(userName & " account created successfully") End Sub
#End Region #Region "Paths"
Public Function GetCurrentPath() As String
Return Directory.GetCurrentDirectory()
End Function
#End Region#Region "Services"
Public Sub ResetIIS()
Console.WriteLine("Restarting IIS")
Dim startInfo As New ProcessStartInfo("IISRESET")
startInfo.UseShellExecute = True
Dim proc As Process = Process.Start(startInfo)
proc.WaitForExit()
Console.WriteLine("IIS Restart Complete")
End Sub Public Sub StopService(ByVal ServiceName As String)
Console.WriteLine("Stopping Service: " & ServiceName)
Try
Dim srv As New ServiceController(ServiceName, Environment.MachineName)
srv.Stop()
srv.WaitForStatus(ServiceControllerStatus.Stopped)
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.WriteLine("Hit enter to exit")
Console.ReadLine()
End Try
End Sub Public Sub StartService(ByVal ServiceName As String)
Console.WriteLine("Starting Service: " & ServiceName)
Try
Dim srv As New ServiceController(ServiceName, Environment.MachineName)
srv.Start()
srv.WaitForStatus(ServiceControllerStatus.Running)
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.WriteLine("Hit enter to exit")
Console.ReadLine()
End Try
End Sub#End Region
#Region "COM"
Public Sub RegisterCOMDLL(ByVal component As String, ByVal Quiet As Boolean)
Try
Dim startInfo As New ProcessStartInfo("Regsvr32")
If Quiet Then
startInfo.Arguments = "/S " & component & ""
Else
startInfo.Arguments = component
End If
Dim proc As Process = Process.Start(startInfo)
proc.WaitForExit()
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.Write("Hit enter to exit")
Console.ReadLine()
End Try End Sub
#End Region#Region "WebApps"
Public Sub InstallWebs()
ResetIIS()
For Each webSite As String In Directory.GetDirectories(GetCurrentPath() & "\WebSites")
ReinstallWebApp(webSite)
Next
End Sub Public Sub ReinstallWebApp(ByVal webSite As String)
UninstallWebApplication(webSite)
CreateWebApp(webSite)
End Sub Public Sub CreateWebApp(ByVal webSite As String)
Dim DirObj As Object
Console.WriteLine("Creating Web Application for IIS://LocalHost/W3SVC/1/ROOT/" & webSite)
DirObj = GetObject("IIS://LocalHost/W3SVC/1/ROOT")
Console.WriteLine("Creating Virtual Directory for IIS://LocalHost/W3SVC/1/ROOT/" & webSite)
Dim mywd As Object = DirObj.Create("IIsWebVirtualDir", GetLastDirectoryName(webSite))
mywd.setinfo()
mywd.AppCreate(True)
mywd.path = webSite
mywd.setinfo()
End Sub Sub UninstallWebApplication(ByVal webSite As String)
Try
Dim DirObj As Object
DirObj = GetObject("IIS://LocalHost/W3SVC/1/ROOT")
DirObj.delete("IIsWebVirtualDir", GetLastDirectoryName(webSite))
Catch exc As Exception
End Try
End Sub
#End Region#Region "File I/O"
Public Sub CreateDirectory(ByVal DirectoryName As String)
Try
If Directory.Exists(DirectoryName) Then
Directory.Delete(DirectoryName, True)
End If
Directory.CreateDirectory(DirectoryName)
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.WriteLine("Hit enter to exit")
Console.ReadLine()
End Try
End Sub Public Sub DeleteFile(ByVal FileName As String)
Try
Console.WriteLine("Deleting : " & FileName)
File.Delete(FileName)
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.WriteLine("Hit enter to exit")
Console.ReadLine()
End Try
End Sub Public Sub DeleteAllSubFolders(ByVal FolderRoot As String)
Dim dir As New DirectoryInfo(FolderRoot)
Dim di As DirectoryInfo
For Each di In dir.GetDirectories()
di.Delete(True)
Next di
Dim fi As System.IO.FileInfo
For Each fi In dir.GetFiles()
fi.Delete()
Next fi
End Sub Public Sub DeleteFolder(ByVal FolderName As String)
Try
If Directory.Exists(FolderName) Then
Console.WriteLine("Deleting Folder: " & FolderName)
Directory.Delete(FolderName, True)
End If
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.WriteLine("Hit enter to exit")
Console.ReadLine()
End Try
End Sub
' Recursively copy all files and subdirectories from the
' specified source to the specified destination.
Public Sub RecursiveCopyFiles( _
ByVal sourceDir As String, _
ByVal destDir As String, _
ByVal fRecursive As Boolean) Dim i As Integer
Dim posSep As Integer
Dim sDir As String
Dim aDirs() As String
Dim sFile As String
Dim aFiles() As String ' Add trailing separators to the supplied paths if they don't exist.
If Not sourceDir.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString()) Then
sourceDir &= System.IO.Path.DirectorySeparatorChar
End If If Not destDir.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString()) Then
destDir &= System.IO.Path.DirectorySeparatorChar
End If If Not Directory.Exists(destDir) Then
Directory.CreateDirectory(destDir)
End If ' Recursive switch to continue drilling down into dir structure.
If fRecursive Then ' Get a list of directories from the current parent.
aDirs = Directory.GetDirectories(sourceDir)
For i = 0 To aDirs.GetUpperBound(0)
' Get the path of the source directory.
sDir = GetLastDirectoryName(aDirs(i))
' Create the new directory in the destination directory.
Directory.CreateDirectory(destDir + sDir)
' Since we are in recursive mode, copy the children also
RecursiveCopyFiles(aDirs(i), (destDir + sDir), fRecursive)
Next End If
' Get the files from the current parent.
aFiles = Directory.GetFiles(sourceDir)
' Copy all files.
For i = 0 To aFiles.GetUpperBound(0)
sFile = Path.GetFileName(aFiles(i))
' Copy the file.
File.Copy(aFiles(i), destDir + sFile, True)
Next i End Sub
Public Sub CopyFolder(ByVal source As String, ByVal destination As String)
Console.WriteLine("Copying folder " & source & " -> " & destination)
RecursiveCopyFiles(source, destination, True)
End Sub Public Sub CopyFile(ByVal source As String, ByVal destination As String)
Console.WriteLine("Copying file " & source & " -> " & destination)
File.Copy(source, destination)
End Sub Public Function GetLastDirectoryName(ByVal directory As String) As String
Dim posSep As Integer = directory.LastIndexOf("\")
' Get the path of the source directory.
Return directory.Substring((posSep + 1), directory.Length - (posSep + 1))
End Function
#End Region#Region "Database"
Public Sub CreateDatabase(ByVal DBName As String)
Try
Dim sqlConn As New SqlConnection("server=localhost;trusted_connection=true;database=master")
Dim sqlComm As New SqlCommand("CREATE DATABASE " & DBName, sqlConn)
sqlConn.Open()
sqlComm.ExecuteNonQuery()
sqlConn.Close()
Catch ex As Exception
Console.WriteLine("SqlException Message: " & ex.Message)
Console.WriteLine("Hit Enter to Exit")
Console.ReadLine()
End Try
End Sub
Public Function ExecuteSQL(ByVal Path As String, ByVal DBName As String) As Boolean
Dim sr As New StreamReader(Path)
Dim sql As String = sr.ReadToEnd()
sr.Close()
Try
Dim sqlConn As New SqlConnection("server=localhost;trusted_connection=true;database=" & DBName)
Dim sqlComm As New SqlCommand(sql, sqlConn)
sqlConn.Open()
sqlComm.ExecuteNonQuery()
sqlConn.Close()
Catch ex As Exception
Console.WriteLine("SqlException Message: " & ex.Message)
Console.WriteLine("Hit Enter to Exit")
Console.ReadLine()
End Try
End Function
Public Function ExecuteOSQL(ByVal Path As String)
Try
'Embed a quoted path
Dim appPath As String = GetCurrentPath()
Dim startInfo As New ProcessStartInfo("OSQL.EXE")
startInfo.Arguments = "-E -i """ & appPath & "\" & Path & ""
Dim proc As Process = Process.Start(startInfo)
proc.WaitForExit()
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.Write("Hit enter to exit")
Console.ReadLine()
End Try
End Function Public Function ExecuteProcess(ByVal cmd As String)
Dim startInfo As New ProcessStartInfo(cmd)
Dim proc As Process = Process.Start(startInfo)
proc.WaitForExit()
End Function Public Function GrantDBAccessNT(ByVal connectionString As String, ByVal account As String)
Dim cn As New SqlConnection(connectionString)
cn.Open() Dim cmd As New SqlCommand
cmd.Connection = cn
cmd.CommandText = "exec sp_grantlogin N'" + account + "'"
cmd.ExecuteNonQuery()
cmd.CommandText = "exec sp_defaultdb N'" + account + "', N'master'"
cmd.ExecuteNonQuery()
Try
cmd.CommandText = "exec sp_grantdbaccess N'" + account + "'"
cmd.ExecuteNonQuery()
cmd.CommandText = "exec sp_addrolemember N'db_owner', N'" + account + "'"
cmd.ExecuteNonQuery()
Catch ex As Exception End Try
cn.Close()
End Function Public Function GrantDBAccessInteg(ByVal connectionString As String, ByVal account As String, ByVal password As String)
Dim cn As New SqlConnection(connectionString)
cn.Open() Dim cmd As New SqlCommand
cmd.Connection = cn
Try
cmd.CommandText = "exec sp_addlogin N'" + account + "', N'" & password & "'"
cmd.ExecuteNonQuery()
cmd.CommandText = "exec sp_grantdbaccess N'" + account + "'"
cmd.ExecuteNonQuery()
cmd.CommandText = "exec sp_addrolemember N'db_owner', N'" + account + "'"
cmd.ExecuteNonQuery()
Catch ex As Exception End Try
cn.Close()
End Function#End Region
End Module
