iCeSnaker - Program rhapsody

谱写程序的狂想曲

导航

24个关于Install/Setup方面非常实用的函数

Posted on 2004-07-02 14:21  iCeSnaker  阅读(606)  评论(0编辑  收藏  举报

24个关于Install/Setup方面非常实用的函数

小气的神整理
2004-04-11

文章类型: 工具和代码
难度等级:4/10     
版本:1.40

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.InteropServices

Module 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