用ASP.NET（VB版）创建WINDOWS 2000 SERVER站点

用ASP.NET（VB）创建的WEB站点，我们的调用方式非常简单：
Dim test As New Class1()
test.CreateWebSit(webname,port, "D:VB", "localhost")

下面是Class1的代码，该代码做的工作就是建立站点，如果有此站点的名称则自动覆盖（注意：本类需要引用Actice DS Type Library）
Public Class Class1

用localhost
'===========================

Function CreateWebSit(ByVal WWWSiteName As String, _
      ByVal WWWTCPPort As String, _
      ByVal WWWFilesPath As String, _
      ByVal ComputerName As String) As Boolean

      CreateWebSit = True
      Dim TCPPort() As Object
      '建立活动桌面'（IADS）对象。首先要在 VB 中的 'prject'菜单中的'references'中引'用 Active DS 'Type 'library 组件
      Dim WWWServer As ActiveDs.IADs
      Dim WWWService
      Dim WWWVdir, WWWVdir2, WWWVdirRes As ActiveDs.IADs
      Dim i As Integer
      Dim HandleSameCase As Boolean
      '取得W3SVC服务
      WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
      i = 1
      HandleSameCase = True
      On Error GoTo ErrWouldDo
      '在IIS中查找每一个WEB站点
      For Each WWWServer In WWWService
         WWWServer = Nothing
         WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)
         'Debug.Print WWWServer.ServerComment
         '如果在安装时系统中已经有了要加的站点，则要先删除干净
         If UCase(WWWServer.ServerComment) = UCase(WWWSiteName) Then
            WWWService.Delete("IISWebServer", i) '再删除
            Exit For
         End If
         ReDim TCPPort(1)
         TCPPort(0) = ""
         TCPPort = WWWServer.Serverbindings
         '如果端口已经有了则也要先删除
         If TCPPort(0) = ":" & WWWTCPPort & ":" Then
            WWWService.Delete("IISWebServer", i) '删除
         Else
            i = i + 1
         End If
      Next
      HandleSameCase = False
CreateSite:
      'MsgBox I
      WWWServer = WWWService.Create("IISWebServer", i)    '创建新站点
      WWWServer.ServerComment = WWWSiteName '设置站点名
      WWWServer.Serverbindings = ":" & WWWTCPPort & ":" '设置端口号
      WWWServer.DefaultDoc = "default.asp,index.asp,default.htm,index.htm" '设置默认启动文件
      WWWServer.Accesss cript = True '设置权限
      WWWServer.AccessRead = True
      WWWServer.SetInfo()

      '创建设置主目录
      WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)
      WWWVdir = WWWServer.Create("IISWebVirtualDir", "root")
      WWWVdir.Path = WWWFilesPath '主目录的实际磁盘路径
      WWWVdir.SetInfo()
      WWWVdir.AppCreate(True)
      WWWServer.Start() '启动新站点

      '建立虚拟目录
      'Set WWWVdirRes = WWWVdir.Create("IISWebVirtualDir", "Resource") '创建虚拟目录
      'WWWVdirRes.Path = WWWFilesPath + "Resource"
      'WWWVdirRes.AccessRead = True
      'WWWVdirRes.AccessWrite = True
      'WWWVdirRes.SetInfo

      '下面为自定义IIS Web Server的错误信息，等发生404错误时候指定调用网站主目录下的404.htm页面显示

      WWWServer.HttpErrors = "404,0,FILE," + WWWFilesPath + "404.htm"
      WWWServer.SetInfo()

      CreateWebSit = True

      Exit Function
ErrWouldDo:
      'MsgBox Err.Des cription
      If (HandleSameCase = True) Then
         GoTo CreateSite
      Else
         MsgBox(Err.Des cription)
         CreateWebSit = False
         Exit Function
      End If
End Function

REM 建立虚拟目录程序
'ComputerName    服务器名（可以为localhost）
'DirName          要建立的虚拟目录名
'LinkAddr          该虚拟目录的真实路径
'WWWSiteName       站点名称
Function CreateVirtualDir(ByVal ComputerName As String, _
         ByVal DirName As String, ByVal LinkAddr As String, _
         ByVal WWWSiteName As String) As Boolean

      Dim i As Integer
      CreateVirtualDir = True
      '取得W3SVC服务
      Dim WWWServer As ActiveDs.IADs
      Dim WWWService
      WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
      i = 1
      Dim HandleSameCase As Boolean
      HandleSameCase = True
      Dim temp As Boolean
      temp = False
      For Each WWWServer In WWWService
         WWWServer = Nothing
         WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)

         If UCase(WWWServer.ServerComment) = UCase(WWWSiteName) Then
            temp = True
            Exit For
         End If

         i = i + 1
      Next

      If Not temp Then
         CreateVirtualDir = False
         Exit Function
      End If

      Dim WWWVirtualDir, WWWIF As ActiveDs.IADs

      WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i & "/Root")

      REM 检查是否该站点中已有该虚拟目录
      On Error GoTo ErrHandle
      WWWIF = GetObject("IIS://" & ComputerName & "/W3SVC/" & i & "/Root/" & DirName)
      REM 如果有，则返回False
      If WWWIF.Name <> "" Then
         CreateVirtualDir = False
         Exit Function
      End If

ErrHandle:
      'Debug.Print Err.Number
      If Err.Number = -2147024893 Then
         Err.Clear()
         REM 如果是因为没有找到该虚拟目录出错的话则进行CreateVirtualDir建立虚拟目录
         GoTo ReturnCreate
      Else
         CreateVirtualDir = False
         Exit Function
      End If

      REM 建立虚拟目录
ReturnCreate:
      WWWVirtualDir = WWWServer.Create("IISWebVirtualDir", DirName)
      WWWVirtualDir.Path = LinkAddr
      WWWVirtualDir.AccessRead = True
      WWWVirtualDir.Accesss cript = True
      WWWVirtualDir.AppCreate(True)
      WWWVirtualDir.SetInfo()

      CreateVirtualDir = True
End Function

Function GetDBConnStr(ByVal DBName As String) As String
      Select Case DBName
         Case "friend"
            GetDBConnStr = CStr(GetSetting("HostTask", "DBini", "ConnStr"))
         Case "wuye"
            GetDBConnStr = Replace$(CStr(GetSetting("HostTask", "DBini", "ConnStr")), "friend", "wuye")
         Case Else
            GetDBConnStr = CStr(GetSetting("HostTask", "DBini", "ConnStr"))
      End Select
End Function

End Class

	资讯中心	软件分类	最新软件	推荐下载	热门软件
	免费资源	热门文章	推荐文章	最近更新	控制面板

下载：
资讯：