怎样用adsi建ftp虚拟目录？

[gp]

[black_fox]

Option Explicit
Public Function CreateFtpServer(ByVal FtpServerComments As String, ByVal FtpServerLocalPath As String, ByVal Port As Integer, Optional ByVal IP As String = "", Optional ByVal HostHead As String, Optional ByVal EnableAnonymous As Boolean = True, Optional ByVal EnableRead As Boolean = True, Optional ByVal EnableWrite As Boolean = False) As Boolean
Dim W3svc As Object
Dim FtpServer As Object
Dim HostName As String
Dim index As Integer
Dim bDone As Boolean
Dim Siteobj As Object
Dim NewFtpServer As Object
Dim newdir As Object
Dim Bindings, Bindingstring, NewBindings
CreateFtpServer = False
On Error Resume Next
Err.Clear
Set W3svc = GetObject("IIS://LocalHost/MSFTPSVC")
If Err.Number <> 0 Then
Exit Function
End If
HostName = HostHead
Bindingstring = IP & ":" & Port & ":" & HostName
For Each FtpServer In W3svc
If FtpServer.Class = "IIsFtpServer" Then
Bindings = FtpServer.ServerBindings
If Bindingstring = Bindings(0) And FtpServer.servercomment = FtpServerComments Then
Exit Function
End If
End If
Next
index = 1
bDone = False

While (Not bDone)
Err.Clear
Set Siteobj = GetObject("IIS://Localhost/Msftpsvc/" & index)
If (Err.Number = 0) Then
index = index + 1
Else
Err.Clear
Set NewFtpServer = W3svc.Create("IIsFtpServer", index)
If (Err.Number <> 0) Then
index = index + 1
Else
bDone = True
End If
End If
If (index > 10000) Then
Exit Function
End If
Wend
Err.Clear
NewBindings = Array(0)
NewBindings(0) = Bindingstring
NewFtpServer.ServerBindings = NewBindings
NewFtpServer.servercomment = FtpServerComments
NewFtpServer.KeyType = "IIsFtpServer"
NewFtpServer.AllowAnonymous = EnableAnonymous
NewFtpServer.ServerAutoStart = True
NewFtpServer.AnonymousOnly = False
NewFtpServer.setinfo
Err.Clear
Set newdir = NewFtpServer.Create("IIsFtpVirtualDir", "ROOT")
newdir.Path = FtpServerLocalPath
newdir.AccessRead = EnableRead
newdir.accesswrite = EnableWrite
Err.Clear
newdir.setinfo
If (Err.Number <> 0) Then Exit Function
Err.Clear
CreateFtpServer = True
Set newdir = Nothing
Set NewFtpServer = Nothing
Set W3svc = Nothing
Set FtpServer = Nothing
Set Siteobj = Nothing
End Function

Public Function StartFtpServer(ByVal ServerComments As String) As Boolean
Dim W3svc As Object
Dim webserver As Object
Dim adspath As String
On Error GoTo AdsiError
Set W3svc = GetObject("IIS://localhost/MSFTPSVC")
For Each webserver In W3svc

If webserver.Class = "IIsFtpServer" Then
If webserver.servercomment = ServerComments Then
adspath = webserver.adspath
Exit For

End If
End If
Next
Set webserver = GetObject(adspath)
webserver.start


StartFtpServer = True
Set W3svc = Nothing
Set webserver = Nothing

Exit Function
AdsiError:
StartFtpServer = False
Set W3svc = Nothing
Set webserver = Nothing

End Function
Public Function StopFtpServer(ByVal ServerComments As String) As Boolean
Dim W3svc As Object
Dim webserver As Object
Dim adspath As String
On Error GoTo AdsiError
Set W3svc = GetObject("IIS://localhost/MSFTPSVC")
For Each webserver In W3svc
If webserver.Class = "IIsFtpServer" Then
If webserver.servercomment = ServerComments Then
adspath = webserver.adspath
Exit For
End If
End If
Next
Set webserver = GetObject(adspath)
webserver.stop
StopFtpServer = True
Set W3svc = Nothing
Set webserver = Nothing

Exit Function
AdsiError:
StopFtpServer = False
Set W3svc = Nothing
Set webserver = Nothing


End Function

Public Function DelFtpServer(ByVal ServerComments As String) As Boolean
Dim W3svc As Object
Dim webserver As Object
On Error GoTo AdsiError
Set W3svc = GetObject("IIS://localhost/MSFTPSVC")
For Each webserver In W3svc
If webserver.Class = "IIsFtpServer" Then
If webserver.servercomment = ServerComments Then
W3svc.Delete "IIsFtpServer", GetIndex(webserver.adspath)
Exit For
End If
End If
Next
DelFtpServer = True
Set W3svc = Nothing
Set webserver = Nothing
Exit Function
AdsiError:
Set W3svc = Nothing
Set webserver = Nothing
DelFtpServer = False


End Function

这是用VB做的简单的一个dll，在asp调可能会更好

[hydnoahark]

MKFTPSITE.VBS :
'------------------------------------------------------------
'
' This is a simple script to create a new virtual FTP server.
'
' Call this script with "-?" for usage instructions
'
'------------------------------------------------------------

' Force explicit declaration of all variables
Option Explicit

On Error Resume Next

Dim bArgStart
Dim bVerbose
Dim iArgPort
Dim iArgSiteNumber
Dim iArgNum
Dim oArgs
Dim szArgComputers
Dim szArgIPAddress
Dim szArgRootDirectory
Dim szArgServerComment

bArgStart = True
bVerbose = False
iArgPort = 21
iArgSiteNumber = 0
szArgIPAddress = ""
szArgComputers = Array(1)
szArgComputers(0) = "LocalHost"

Set oArgs = WScript.Arguments
iArgNum = 0

While iArgNum < oArgs.Count

Select Case LCase(oArgs(iArgNum))
Case "-o","--port":
iArgNum = iArgNum + 1
iArgPort = oArgs(iArgNum)
Case "-i","--ipaddress":
iArgNum = iArgNum + 1
szArgIPAddress = oArgs(iArgNum)
Case "-r","--rootdirectory":
iArgNum = iArgNum + 1
szArgRootDirectory = oArgs(iArgNum)
Case "-t","--comment":
iArgNum = iArgNum + 1
szArgServerComment = oArgs(iArgNum)
Case "-c","--computer":
iArgNum = iArgNum + 1
szArgComputers = Split(oArgs(iArgNum),",",-1)
Case "-n","--sitenumber":
iArgNum = iArgNum + 1
iArgSiteNumber = CLng(oArgs(iArgNum))
Case "-d","--dontstart":
bArgStart = False
Case "-?","--help":
Call DisplayUsage
Case "-v","--verbose":
bVerbose = True
Case Else:
WScript.Echo "Unknown argument " & oArgs(iArgNum)
Call DisplayUsage
End Select

iArgNum = iArgNum + 1
Wend

If (szArgRootDirectory = "") Or (szArgServerComment = "") Then
If (szArgRootDirectory = "") Then
WScript.Echo "Missing Root Directory"
Else
WScript.Echo "Missing Server Comment"
End If
Call DisplayUsage
WScript.Quit(1)
End If

Call ASTCreateFtpSite(szArgIPAddress, szArgRootDirectory, szArgServerComment, iArgPort, szArgComputers, iArgSiteNumber, bArgStart)

Sub ASTCreateFtpSite(szIPAddress, szRootDirectory, szServerComment, iPortNum, szComputers, iSiteNumber, bStart)
Dim bDone
Dim iComputerIndex
Dim iIndex
Dim oFtpServer
Dim oFtpSite
Dim oMsFtpSvc
Dim oNewFtpServer
Dim oNewDir
Dim szBindings
Dim szBindingString
Dim szComp
Dim szNewBindings

On Error Resume Next

For iComputerIndex = 0 To UBound(szComputers)
szComp = szComputers(iComputerIndex)
If iComputerIndex <> UBound(szComputers) Then
Trace "Creating FTP site on " & szComp & "."
End If

' Grab the ftp service object
Err.Clear
Set oMsFtpSvc = GetObject("IIS://" & szComp & "/MSFTPSVC")
If Err.Number <> 0 Then
Display "Unable to open: " & "IIS://" & szComp & "/MSFTPSVC"
End If

szBindingString = szIPAddress & ":" & iPortNum & ":"
Trace "Making sure this FTP server doesn't conflict with another..."
For Each oFtpServer in oMsFtpSvc
If oFtpServer.Class = "IIsFtpServer" Then
szBindings = oFtpServer.ServerBindings
If szBindingString = szBindings(0) Then
Display "The server bindings you specified are duplicated in another virtual FTP server."
WScript.Quit (1)
End If
End If
Next

iIndex = 1
bDone = False
Trace "Creating new FTP server..."

' If the user specified a SiteNumber, then use that. Otherwise,
' test successive numbers under MSFTPSVC until an unoccupied slot is found
If iSiteNumber <> 0 Then
Set oNewFtpServer = oMsFtpSvc.Create("IIsFtpServer", iSiteNumber)
oNewFtpServer.SetInfo
If (Err.Number <> 0) Then
WScript.Echo "Couldn't create a FTP site with the specified number: " & iSiteNumber
WScript.Quit (1)
Else
Err.Clear
' Verify that the newly created site can be retrieved
Set oFtpSite = GetObject("IIS://" & szComp & "/MSFTPSVC/" & iSiteNumber)
If (Err.Number = 0) Then
bDone = True
Trace "FTP server created. Path is - " & "IIS://" & szComp & "/MSFTPSVC/" & iSiteNumber
Else
WScript.Echo "Couldn't create a FTP site with the specified number: " & iSiteNumber
WScript.Quit (1)
End If
End If
Else
While (Not bDone)
Err.Clear
Set oFtpSite = GetObject("IIS://" & szComp & "/MSFTPSVC/" & iIndex)

If (Err.Number = 0) Then
' A ftp server is already defined at this position so increment
iIndex = iIndex + 1
Else
Err.Clear
Set oNewFtpServer = oMsFtpSvc.Create("IIsFtpServer", iIndex)
oNewFtpServer.SetInfo
If (Err.Number <> 0) Then
' If call to Create failed then try the next number
iIndex = iIndex + 1
Else
Err.Clear
' Verify that the newly created site can be retrieved
Set oFtpSite = GetObject("IIS://" & szComp & "/MSFTPSVC/" & iIndex)
If (Err.Number = 0) Then
bDone = True
Trace "FTP server created. Path is - " & "IIS://" & szComp & "/MSFTPSVC/" & iIndex
Else
iIndex = iIndex + 1
End If
End If
End If

' sanity check at 10K sites
If (iIndex > 10000) Then
Display "Seem to be unable to create new FTP server. Server number is " & iIndex & "."
WScript.Quit (1)
End If
Wend
End If

szNewBindings = Array(0)
szNewBindings(0) = szBindingString
oNewFtpServer.ServerBindings = szNewBindings
oNewFtpServer.ServerComment = szServerComment
oNewFtpServer.SetInfo

' Now create the root directory object.
Trace "Setting the home directory..."
Set oNewDir = oNewFtpServer.Create("IIsFtpVirtualDir", "ROOT")
oNewDir.Path = szRootDirectory
oNewDir.AccessRead = True
Err.Clear
oNewDir.SetInfo

If (Err.Number = 0) Then
Trace "Home directory set."
Else
Display "Error setting home directory."
End If

Trace "FTP site created!"

If bStart = True Then
Trace "Attempting to start new FTP server..."
Err.Clear
Set oNewFtpServer = GetObject("IIS://" & szComp & "/MSFTPSVC/" & iIndex)
oNewFtpServer.Start
' the next line "debounces" some startup errors
WScript.Sleep 5000
If (Err.Number <> 0) Or (oNewFtpServer.ServerState <> 2) Then
Display "Error starting FTP server!"
Err.Clear
Else
Trace "FTP server started succesfully!"
End If
End If
Next
End Sub

' Display the usage message
Sub DisplayUsage
WScript.Echo "Usage: mkftpsite <-r|--RootDirectory ""ROOT DIRECTORY"">"
WScript.Echo " <-t|--Comment ""SERVER COMMENT"">"
WScript.Echo " [-c|--Computer COMPUTER1[,COMPUTER2...]]"
WScript.Echo " [-o|--Port PORT NUM]"
WScript.Echo " [-i|--IPAddress IP ADDRESS]"
WScript.Echo " [-n|--SiteNumber SITENUMBER]"
WScript.Echo " [-d|--DontStart]"
WScript.Echo " [-v|--Verbose]"
WScript.Echo " [-?|--Help]"
WScript.Echo ""
WScript.Echo "IP ADDRESS Optional - The IP Address to assign to the new server"
WScript.Echo "PORT NUM Optional - The port to which the server should bind"
WScript.Echo "ROOT DIRECTORY Required - Full path to the root directory for the new server"
WScript.Echo "SERVER COMMENT Required - The server comment (this is the name that appears"
WScript.Echo " in the MMC)"
WScript.Echo "SITENUMBER Optional - The site number is the number in the ADSI path that"
WScript.Echo " the FTP server will be created at (i.e. MSFTPSVC/3)"
WScript.Echo ""
WScript.Echo "Example 1: mkftpsite -r D:\Roots\MyCompany --DontStart -t ""My Company Site"""
WScript.Echo "Example 2: mkftpsite -r C:\Inetpub\ftproot -t Test -o 1021"
WScript.Quit (1)
End Sub

Sub Display(Msg)
WScript.Echo Now & " : ERROR: " & Msg
WScript.Echo Now & " : ERROR: 0x" & Hex(Err.Number) & " - " & Err.Description
End Sub

Sub Trace(Msg)
If bVerbose = True then
WScript.Echo Now & " : " & Msg
End If
End Sub

C:\>CSCRIPT MKFTPSITE.VBS -?

[tigerlet]

@_@