下面是一个创建用户和FTP站点的例子,昨天晚上没有时间了,所以Internet Transfer Control的例子没有写,你自己在调试一下吧。Inet很简单,自己看帮助就可以了。
'需要引用Active DS Type Library
Private Sub Command1_Click()
CreateUser "sever.gbztg.int", "DC=gbztg,DC=int", "testftp", "123", "test", "ftp"
CreateFtpSite "server.gbztg.int", "192.168.0.228", "C:\windows", "New FTP Site", 21, True, 2, "testftp", "123"
End Sub
Public Function CreateUser(ByVal strServerFullName As String, ByVal strDomainName As String, ByVal strLoginName As String, ByVal strPassword As String, ByVal strFirstName As String, ByVal strLastName As String) As Integer
Dim objUser As IADsUser
Dim objContainer As IADsContainer
Dim recip As String
Dim Child, objGroup As Object
'检查要创建的用户是否存在
For Each Child In objContainer
If LCase(Right(Child.Name, Len(Child.Name) - 3)) = LCase(strLoginName) Then CreateUser = 1: Exit Function
Next
Public Function CreateFtpSite(ByVal strComputerName As String, strIPAddress As String, ByVal strRootDirectory As String, ByVal strServerComment As String, ByVal iPortNum As Integer, ByVal bStart As Boolean, ByVal iSiteNumber As Integer, ByVal strUserName As String, ByVal strPassword As String)
Dim bDone
Dim oFtpServer
Dim oFtpSite
Dim oMsFtpSvc
Dim oNewFtpServer
Dim oNewDir
Dim oNewDirInfo
Err.Clear
On Error Resume Next
'取FTP服务地址
Set oMsFtpSvc = GetObject("IIS://" & strComputerName & "/MSFTPSVC")
If Err.Number <> 0 Then
MsgBox "不能打开: " & "IIS://" & strComputerName & "/MSFTPSVC"
Exit Function
End If
Set oNewFtpServer = oMsFtpSvc.Create("IIsFtpServer", iSiteNumber)
oNewFtpServer.SetInfo
If (Err.Number <> 0) Then
MsgBox "不能创建FTP站点. 可能是站点索引号已存在. 站点索引号: " & iSiteNumber
Exit Function
End If
'启动新的FTP站点
If bStart = True Then
Err.Clear
oNewFtpServer.Start
If Err.Number <> 0 Then
MsgBox strServerComment & "无法自动启动,请察看是否有使用相同端口的FTP服务正在运行"
End If
End If