Vb教程 Vb.net教程 Vfp教程 C/C++教程 Vc/Vc++教程 Delphi教程 Java教程 Powerbuilder
  杀毒频道 | 短信频道 | 网络电视 | 论文中心 | 学上网 | 学软件 | 网页特效 | 电脑基础 | 论坛  
  NCRE | 软考 | CET | 职称英语 | 司法考试 | 报关员 | 公务员 | CATTI | CPA考试  
  Html教程 | Css教程 | Xml教程 | Asp教程 | Asp.net | Php教程 | Jsp教程 | Linux教程 | QQ技巧  
Photoshop Illustrator ImageReady Maya教程 3D Max教程 Lightscape Coredraw教程 Authorware Autocad教程 Freehand教程
Access教程 Mysql教程 Sql server Oracle教程 Word教程 Excel教程 Powerpoint Frontpage Asp.net源码 Php源代码
Flash教程 Fireworks Dreamweaver C#教程 outlook教程 系统安装 vbscript教程 Javascript Jsp源代码 Asp源代码
您的位置:首页 >> Vb.net教程 >> 正文

用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.Accessscript = 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.Description
        If (HandleSameCase = True) Then
            GoTo CreateSite
        Else
            MsgBox(Err.Description)
            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.Accessscript = 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

[返回]

编程语言 web开发 数据库 网络技术 操作系统 服务器 网页设计 图形设计 办公软件 常用软件 学电脑

Copyright© www.bianceng.cn Powered by 编程入门网 All Rights Reserved.
关于本站 | 版权声明 | 联系我们 | 友情链接 |
编程入门网 版权所有