用ASP.NET(VB版)创建WINDOWS 2000 SERVER站点

原创 2004年07月17日 10:28:00
用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

Ftp服务器的配置(Windows 2000 Server IIS)与访问

一、配置Ftp服务器   Ftp服务器也是IIS的一个组件,如果没有安装IIS,可参看上一节配置Web服务器中IIS的安装。Ftp服务器的配置方法与Web服务器的配置方法基本上相同。   IIS安...
  • xumin07061133
  • xumin07061133
  • 2012-02-22 20:36:57
  • 1590

用ASP.NET(VB)创建WINDOWS 2000/2003 SERVER站点

用ASP.NET(VB)创建的WEB站点,我们的调用方式非常简单:Dim test As New Class1()test.CreateWebSit(webname,port, "D:/VB", "l...
  • jxufewbt
  • jxufewbt
  • 2006-06-29 16:17:00
  • 1184

asp在IIS上创建一个web站点

 %**********************************************************************************  创建一个WebServer ...
  • china_skag
  • china_skag
  • 2007-03-16 09:56:00
  • 1014

用Windows Server 2003/2000/XP自带的IIS建网站

一、安装 Internet 信息服务Microsoft Internet信息服务(IIS)是与Windows Server 2003/2000/XP集成的Web服务。要安装 IIS、添加可选组件或...
  • yakoo5
  • yakoo5
  • 2010-03-01 10:25:00
  • 5364

windows 2000 server资源大全(PDF)

  • 2006年02月23日 15:31
  • 92.36MB
  • 下载

windows server 2000补丁

  • 2012年08月11日 23:50
  • 2.59MB
  • 下载

xp安装sql server 2000企业版

  • 2012年09月27日 18:06
  • 821B
  • 下载

ArcGIS Server新建站点异常的解决

ArcGIS Server新建站点异常的解决问题描述安装Server后在Manager网页无法创建新站点,提示如下图: 这种情况多出现于在虚拟机中安装ArcGIS Server。配置环境VM...
  • lrspace
  • lrspace
  • 2017-08-24 18:00:28
  • 384

如何开启 Windows 2000 Server 的远程桌面

Windows XP , Windows Server 2003 ,windows server 2000 都有远程桌面的功能,非常好用,我觉得比pcanywhere要好用一些,因为pcanywher...
  • liuyuan_jq
  • liuyuan_jq
  • 2007-11-14 19:10:00
  • 3168

Windows 2000 Advanced Server CD

  • 2011年06月16日 09:38
  • 12.03MB
  • 下载
收藏助手
不良信息举报
您举报文章:用ASP.NET(VB版)创建WINDOWS 2000 SERVER站点
举报原因:
原因补充:

(最多只允许输入30个字)