如何编写一个创建FTP站点的函数?

来源:asp之家 时间:2009-11-07 18:51:00 

具体代码如下:

Function ASTCreateFtpSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computer, Start,LogFileDirectory)
    Dim MSFTPSVC, FtpServer, NewFtpServer, NewDir
    Dim Bindings, BindingString, NewBindings, Index, SiteObj, bDone
        On Error Resume Next
        Err.Clear
        Set MSFTPSVC = GetObject("IIS://" & Computer & "/MSFTPSVC")
        If Err.Number <> 0 Then
            WScript.Echo "无法打开: "&"IIS://" & Computer & "/MSFTPSVC" & VbCrlf & "程序将退出!"
            WScript.Quit (1)
        End If
        BindingString = IpAddress & ":" & PortNum & ":" & HostName
        For Each FtpServer in MSFTPSVC
            If FtpServer.Class="IIsFtpServer" Then
            Bindings = FtpServer.ServerBindings
            If BindingString = Bindings(0) Then
                WScript.Echo "噢,IP地址冲突:" & IpAddress & ",请检测IP地址!" & VbCrlf & "取消创建本站点."
                Exit Function
            End If
            End If
        Next
        Index = 1
        bDone = False
        While (Not bDone)
            Err.Clear
            Set SiteObj = GetObject("IIS://"&Computer&"/MSFTPSVC/" & Index)
            If (Err.Number = 0) Then
                Index = Index + 1
            Else
                Err.Clear
                Set NewFtpServer = MSFTPSVC.Create("IIsFtpServer", Index)
                If (Err.Number <> 0) Then
                    Index = Index + 1
                Else
                    Err.Clear
                    Set SiteObj = GetObject("IIS://"&Computer&"/MSFTPSVC/" & Index)
                    If (Err.Number = 0) Then
                        bDone = True
                    Else
                        Index = Index + 1
                    End If
                End If
            End If
            If (Index > 10000) Then
                WScript.Echo "噢,创建站点异常!正在创建的站点的序号为:"&Index&"." & VbCrlf & "取消创建本站点."
                Exit Function
            End If
        Wend
        NewBindings = Array(0)
        NewBindings(0) = BindingString
        NewFtpServer.ServerBindings = NewBindings
        NewFtpServer.ServerComment = ServerComment
        NewFtpServer.AllowAnonymous = False
        NewFtpServer.AccessWrite = True
        NewFtpServer.AccessRead = True
        NewFtpServer.DontLog = False
        NewFtpServer.LogFileDirectory = LogFileDirectory
        NewFtpServer.SetInfo
        Set NewDir = NewFtpServer.Create("IIsFtpVirtualDir", "ROOT")
        NewDir.Path = RootDirectory
        NewDir.AccessRead = true
        Err.Clear
        NewDir.SetInfo
        If (Err.Number = 0) Then
        Else
            WScript.Echo "噢,主目录创建时出错!"
        End If
    
        If Start = True Then
            Err.Clear
            Set NewFtpServer = GetObject("IIS://" & Computer & "/MSFTPSVC/" & Index)
            NewFtpServer.Start
            If Err.Number <> 0 Then
                WScript.Echo "噢,启动站点时出错!"
                Err.Clear
            Else
            End If
        End If    
        ASTCreateFtpSite = Index
End Function

标签:ftp,iis,函数,站点
0
投稿

猜你喜欢

  • 支持鼠标拖拽的简单目录树代码

    2011-07-01 12:34:09
  • delete from online where datediff

    2009-06-07 18:46:00
  • Mysql Innodb 引擎优化

    2010-10-25 20:01:00
  • CSS框架的利与弊

    2007-12-06 12:59:00
  • 网页设计中的层次感

    2007-11-05 18:19:00
  • 对SQL Server数据库进行优化的经验总结

    2010-07-26 14:52:00
  • msxml3.dll (0x80070005)拒绝访问 解决方法

    2010-03-11 21:26:00
  • 跨平台、多浏览器页面测试

    2008-06-24 11:54:00
  • 探讨链接打开方式

    2009-03-16 16:55:00
  • 从传文件功能看本地化

    2009-12-29 13:03:00
  • PHP结构型模式之外观模式

    2023-05-25 11:43:14
  • CSS Shadow Practice

    2009-04-01 18:37:00
  • :hover在IE6下的问题

    2009-06-18 21:09:00
  • select @@identity的应用(得到刚插入数据的ID)

    2009-09-10 11:24:00
  • sqlserver数据库主键的生成方式小结(sqlserver,mysql)

    2012-08-21 10:25:45
  • 用Dreamweaver MX轻松操作表格

    2009-05-29 18:41:00
  • 几个好用的Asp自定义函数

    2007-09-26 14:28:00
  • 开展全面的网站评估

    2007-09-27 19:21:00
  • CSS浏览器兼容问题整理(IE6.0、IE7.0 与FireFox)

    2008-10-27 13:45:00
  • 好用的asp防SQL注入代码

    2008-10-24 08:36:00
  • asp之家 网络编程 m.aspxhome.com