installer.vb

是可以运行的电子光盘 有程序与PPT介绍 对于学习VB。NET的有参考意义


Imports System.ComponentModel
Imports System.Configuration.Install
Imports System.DirectoryServices
Imports System.io
Imports System.Security.AccessControl
Public Class Installer

    Public Sub New()
        MyBase.New()

        '组件设计器需要此调用。
        InitializeComponent()

        '调用 InitializeComponent 后添加初始化代码

    End Sub
    '自动设置虚拟目录
    Private Sub Installer_BeforeInstall(ByVal sender As Object, ByVal e As System.Configuration.Install.InstallEventArgs) Handles Me.BeforeInstall
        Dim SetupPath As String = System.IO.Directory.GetCurrentDirectory()

        '先检测并创建所需的目录
        If Not System.IO.Directory.Exists(SetupPath) Then
            System.IO.Directory.CreateDirectory(SetupPath)
        End If
        '设置相应目录的访问权限，Users组为完全控制或ASP.NET用户为完全控制，需设置的目录为MoneyLog
        Dim strMsg As String
        Try
            ' Add the access control entry to the directory.
            AddDirectorySecurity(SetupPath, "Users", FileSystemRights.FullControl, AccessControlType.Allow)
            strMsg = "设置" & SetupPath & "目录权限成功，该目录的Users组为完全控制。"
            strMsg &= vbCrLf
            MsgBox(strMsg, MsgBoxStyle.Information)
        Catch ex As Exception
            strMsg = "设置" & SetupPath & "目录权限失败，请手工设置该目录的Users组为完全控制,安装将继续进行"
            strMsg &= vbCrLf
            strMsg &= ex.Message
            MsgBox(strMsg, MsgBoxStyle.Information)
        End Try
        'Windows 2003系统没有ASP.NET用户
        'Try
        '    AddDirectorySecurity(C_MoneyLog, "ASP.NET", FileSystemRights.FullControl, AccessControlType.Allow)
        'Catch ex As Exception
        '    strMsg = "设置" & C_MoneyLog & "目录权限失败，ASP.NET用户访问控制失败,若Users组为完全控制则不受影响,安装将继续进行"
        '    strMsg &= vbCrLf
        '    strMsg &= ex.Message
        '    MsgBox(strMsg, MsgBoxStyle.Information)
        'End Try
        '建立虚拟目录
        strMsg = ""
        Try
            Dim path As String = "IIS://localhost/W3SVC/1/ROOT"
            Dim rootDir As New DirectoryEntry(path)    'System.Web.Hosting.VirtualPathProvider
            Dim vdir As DirectoryEntry = CType(rootDir.Invoke("Create", "IIsWebVirtualDir", "WebDisk"), DirectoryEntry)
            vdir.Invoke("Put", "Path", SetupPath)
            vdir.Invoke("Put", "AccessRead", True)
            vdir.Invoke("Put", "AccessScript", True)
            vdir.Invoke("Put", "AccessWrite", False)
            vdir.Invoke("Put", "EnableDirBrowsing", False)
            vdir.Invoke("Put", "AppFriendlyName", "WebDisk")
            vdir.Invoke("SetInfo")
            vdir.Invoke("AppCreate2", 2)
        Catch ex As Exception
            strMsg = "请查看虚拟目录/WebDisk是否已经存在，"
            strMsg &= vbCrLf
            strMsg &= "请确认虚拟目录/WebDisk的物理路径是否是："
            strMsg &= SetupPath
            strMsg &= vbCrLf
            strMsg &= "若是，请正常直接往下安装"
            MsgBox(strMsg, MsgBoxStyle.Information)
        End Try
    End Sub


    ' Adds an ACL entry on the specified directory for the specified account.
    Sub AddDirectorySecurity(ByVal DirName As String, ByVal Account As String, ByVal Rights As FileSystemRights, ByVal ControlType As AccessControlType)
        ' Create a new DirectoryInfoobject.
        Dim dInfo As New DirectoryInfo(DirName)

        ' Get a DirectorySecurity object that represents the 
        ' current security settings.
        Dim dSecurity As DirectorySecurity = dInfo.GetAccessControl()

        '设置目录为Users组完全控制，并且应用到该文件夹、其子文件夹及其下的文件
        dSecurity.AddAccessRule(New FileSystemAccessRule(Account, Rights, InheritanceFlags.ObjectInherit, PropagationFlags.InheritOnly, ControlType))

        ' Set the new access settings.
        dInfo.SetAccessControl(dSecurity)

    End Sub

End Class