高分求控制IIS的VB函数,进来的有分.!!!!QQ:34468071

Question

请根据以下函数功能要求,给出VB中的实现代码:
工程名:nuofei
类名:iisctrl '*************************************************************************
 ' 目的：    建立目录
 ' 输入：    HostAddr:   目标服务器
 '           Dir:        要建立的目录
 ' 返回：    正确返回 0  失败返回 -1
 '*************************************************************************Function CreateDirectory(ByVal HostAddr,ByVal Dir)
Dim ASPObj, Param(1)

Param(0) = "METHOD=CreateDirectory"
Param(1) = "Dir=" & Dir

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
CreateDirectory = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
End Function '*************************************************************************
 ' 目的：    删除目录
 ' 输入：    HostAddr:   目标服务器
 '           Dir:        要删除的目录
 ' 返回：    成功返回 0  失败返回 -1
 '*************************************************************************Function DeleteDirectory(ByVal HostAddr, ByVal Dir)
Dim ASPObj, Param(1)

Param(0) = "METHOD=DeleteDirectory"
Param(1) = "Dir=" & Dir

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
DeleteDirectory = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
End Function '*************************************************************************
 ' 目的：    取得用户目录
 ' 输入：    HostAddr:   目标服务器
 '           User:       用户名称
 ' 返回：    返回用户目录(最后有"\") 失败返回 -1
 '*************************************************************************Function GetUserHomeDir(ByVal HostAddr, ByVal User)
Dim ASPObj, Param(1)

Param(0) = "METHOD=GetUserHomeDir"
Param(1) = "User=" & User

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
GetUserHomeDir = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
End Function '*************************************************************************
 ' 目的：    建立一个WEB目录
 ' 输入：    HostAddr:   目标服务器
 '           Dir:        要删除的目录
 ' 返回：    成功返回 0  失败返回 -1
 '*************************************************************************Function CreateWebDirectory(ByVal HostAddr, ByVal Dir)
Dim ASPObj, Param(1)

Param(0) = "METHOD=CreateWebDirectory"
Param(1) = "Dir=" & Dir

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
CreateWebDirectory = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
End Function '*************************************************************************
 ' 目的：    建立IIS虚拟站点
 ' 输入：    HostAddr:   目标服务器
 '           Comment:    站点描述
 '           HomeDir:    主目录
 '           Bindings(): 绑定数组
 '           ServerType: 站点类型  可能的值: HTML、ASP、CGI
 '         * SiteNum:    返回建立的虚拟站点序号
 ' 返回：    成功返回 0
 '*************************************************************************Function CreateIISServer(ByVal HostAddr, ByVal Comment, ByVal HomeDir, ByVal Bindings(), ByVal ServerType, ByRef SiteNum)
Dim I,M,Binding
Dim ASPObj, Param(5), ReturnValue, Result

M = UBound(Bindings)
For I = 0 to M
if I = M then
Binding = Binding & Bindings(I)
else
Binding = Binding & Bindings(I) & "|"
end if
Next

Param(0) = "METHOD=CreateIISSite"
Param(1) = "Bindings=" & Binding
Param(2) = "Comment=" & Comment
Param(3) = "Path=" & HomeDir
Param(4) = "Type=" & ServerType
Param(5) = "Run=TRUE"

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
Result = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
ReturnValue = Split(Result,"|")
CreateIISServer = ReturnValue(0)
if ReturnValue(0)=0 then
SiteNum = ReturnValue(1)
end if
End Function '*************************************************************************
 ' 目的：    删除IIS虚拟站点
 ' 输入：    HostAddr:   目标服务器
 '           SiteNum:    虚拟站点序号
 ' 返回：    成功返回 0
 '*************************************************************************Function DeleteIISServer(ByVal HostAddr, ByVal SiteNum)
Dim ASPObj, Param(1)

Param(0) = "METHOD=DeleteIISSite"
Param(1) = "SiteNum=" & SiteNum

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
DeleteIISServer = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
End Function '*************************************************************************
 ' 目的：    运行IIS虚拟站点
 ' 输入：    HostAddr:   目标服务器
 '           SiteNum:    虚拟站点序号
 ' 返回：    成功返回 0
 '*************************************************************************Function RunIISServer(ByVal HostAddr, ByVal SiteNum)
Dim ASPObj, Param(2)

Param(0) = "METHOD=SetIISSiteRun"
Param(1) = "SiteNum=" & SiteNum
Param(2) = "Run=0"

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
RunIISServer = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
End Function '*************************************************************************
 ' 目的：    停止IIS虚拟站点
 ' 输入：    HostAddr:   目标服务器
 '           SiteNum:    虚拟站点序号
 ' 返回：    成功返回 0
 '*************************************************************************Function StopIISServer(ByVal HostAddr, ByVal SiteNum)
Dim ASPObj, Param(2)

Param(0) = "METHOD=SetIISSiteRun"
Param(1) = "SiteNum=" & SiteNum
Param(2) = "Run=1"

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
StopIISServer = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
End Function '*************************************************************************
 ' 目的：    取得IIS虚拟站点的运行状态
 ' 输入：    HostAddr:   目标服务器
 '           SiteNum:    虚拟站点序号
 '         * Status: 1 (starting), 2 (started), 3 (stopping), 4 (stopped)
 '                   5 (pausing), 6 (paused), or 7 (continuing). 
 ' 返回：    成功返回 0
 '*************************************************************************Function GetServerStatus(ByVal HostAddr, ByVal SiteNum, ByRef Status)
Dim ASPObj, Param(2), ReturnValue, Result

Param(0) = "METHOD=GetIISSiteProperty"
Param(1) = "SiteNum=" & SiteNum
Param(2) = "Property=ServerState"

Set ASPObj = Server.CreateObject("Nuofei.Iisctrl")
Result = ASPObj.CtrlWeb(HostAddr, Param)
Set ASPObj = Nothing
ReturnValue = Split(Result,"|")
GetServerStatus = ReturnValue(0)
if ReturnValue(0) = 0 then
Status = ReturnValue(1)
end if
End Function待续...

Answer 1

不用最贴了！“Nuofei.Iisctrl”不是通用部件,是某个程序安装进去的，你是代码对别人是没用的。

Answer 2

如果已有“Nuofei.Iisctrl”，把“Server.CreateObject”改成"CreateObject",其它的不用改，就是VB代码了，

Answer 3

我要的就是
Nuofei.Iisctrl
的VB实现代码啊.实现以上的调用

Answer 4

如果不用VB封装成组组件好话.那直接用adminscript里面的脚下本就可以实现了.就是要封装好的组件.我本人没学过VB.所以要找人做.

Answer 5

在activex dll中调用ADSI（代码有很多），把需要的功能封装成函数就可以了

Answer 6

ADSI
从前想用，可是后来项目泡汤了
也没搞成

Answer 7

好了，提供一个Win2003中的帮助文件，对IIS的编程十分详细，再不够就没法了。
ftp://ts:[email protected]/iismmc.chm

Answer 8

我有上面功能的全部VB代码，原创，只须1000元
http://www.bhdata.com

Answer 9

自己安装iis管理器的web版，仔细研究一下实现代码就可以了。

Answer 10

希望能帮上忙'在现有的站点上发布一个虚拟目录
Public Function WebVirtualDir(ByVal strWebSite As String, ByVal strFriendlyName As String, ByVal strWebPath As String, ByVal strDefaultDoc As String) As Boolean
    Dim objADSI As Object
    Dim objWebVDir As Object
    On Error GoTo Lib_Err
    Set objADSI = GetObject("IIS://LocalHost/W3SVC/1/Root")
    Set objWebVDir = objADSI.Create("IIsWebVirtualDir", strWebSite)
    objWebVDir.SetInfo
    Set objWebVDir = objADSI.GetObject("IIsWebVirtualDir", strWebSite)
    objWebVDir.AppCreate True
    objWebVDir.Put "AppFriendlyName", strFriendlyName
    objWebVDir.Put "AppRoot", "/LM/W3SVC/1/Root/" & strWebSite
    objWebVDir.Put "Path", strWebPath
    objWebVDir.Put "AppIsolated", 0
    objWebVDir.Put "DefaultDoc", strDefaultDoc
    objWebVDir.Put "AccessFlags", 535
    objWebVDir.SetInfo
    WebVirtualDir = True
Lib_End:
    Set objWebVDir = Nothing
    Set objADSI = Nothing
    Exit Function
Lib_Err:
    WebVirtualDir = False
    strError = Err.Description
    Err.Clear
    Resume Lib_End
End Function
'调用时
'Call WebVirtualDir(站点编号, 虚拟目录名称.文件路径, "index.htm")
'举个例子
Call WebVirtualDir(1, "VirtualDir"."D:\MyWeb", "index.htm")

Answer 11

see  the  example  at  
 
http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&oe=UTF-8&selm=Ob59%23ZYdBHA.1488%40tkmsftngp02  
 
---------------------------------------------------------------  
 
发布虚拟站点  
'参数：  
'    strWebSite                    虚拟站点名称  
'    strFriendlyName        程序名称  
'    strWebPath                    网页文件路径  
'    strDefaultDoc            默认网站首页  
 
Public  Function  WebVirtualDir(ByVal  strWebSite  As  String,  ByVal  strFriendlyName  As  String,  ByVal  strWebPath  As  String,  ByVal  strDefaultDoc  As  String)  As  Boolean  
       Dim  objADSI            As  Object  
       Dim  objWebVDir        As  Object  
         
       On  Error  GoTo  Lib_Err  
         
       Set  objADSI  =  GetObject("IIS://LocalHost/W3SVC/1/Root")  
       Set  objWebVDir  =  objADSI.Create("IIsWebVirtualDir",  strWebSite)  
       objWebVDir.SetInfo  
         
       Set  objWebVDir  =  objADSI.GetObject("IIsWebVirtualDir",  strWebSite)  
       objWebVDir.AppCreate  True  
       objWebVDir.Put  "AppFriendlyName",  strFriendlyName  
       objWebVDir.Put  "AppRoot",  "/LM/W3SVC/1/Root/"  &  strWebSite  
       objWebVDir.Put  "Path",  strWebPath  
       objWebVDir.Put  "AppIsolated",  0  
       objWebVDir.Put  "DefaultDoc",  strDefaultDoc  
       objWebVDir.Put  "AccessFlags",  535  
       objWebVDir.SetInfo  
         
       WebVirtualDir  =  True  
         
Lib_End:  
       Set  objWebVDir  =  Nothing  
       Set  objADSI  =  Nothing  
       Exit  Function  
         
Lib_Err:  
       WebVirtualDir  =  False  
       strError  =  Err.Description  
       Err.Clear  
       Resume  Lib_End  
         
End  Function