解决本问题，散分1000分？

mingnuo 2003-03-18 05:16:32

第一如何在VB中利用代码实现创建一个本机用户
第二如何在VB中利用代码实现FTP站点的创建（指定读写权限），并指定刚创建的用户为FTP站点的管理员
第三如何在VB中利用代码实现FTP站点的连接（指定用户），文件的上传下载删除。

以上三个部份最终以ASP组件DLL形式出现。

...全文

83 17 打赏收藏转发到动态举报

写回复

用AI写文章

17 条回复

切换为时间正序

请发表友善的回复…

发表回复

cbr7619 2003-03-20

打赏
举报

呵呵学习

Cooly 2003-03-20

打赏
举报

楼主跑哪里去了,就这么一声不响的?
问题如果解决了,出来说一声,谁也不是冲着你的1000分去的.

:(

Cooly 2003-03-19

打赏
举报

下面是ADSI对FTP的操作的一些属性和方法。

Properties 属性
=======================
AccessFlags
AccessRead
AccessWrite
AdminACL
AllowAnonymous
AnonymousOnly
AnonymousPasswordSync
AnonymousUserName
AnonymousUserPass
ConnectionTimeout
DefaultLogonDomain
DisableSocketPooling
DontLog
ExitMessage
FtpDirBrowseShowLongDate
GreetingMessage
IPSecurity

LogAnonymous
LogExtFileTimeTaken
LogExtFileBytesRecv
LogExtFileUriQuery
LogExtFileBytesSent
LogExtFileUriStem
LogExtFileClientIp
LogExtFileUserAgent
LogExtFileComputerName
LogExtFileUserName
LogExtFileCookie
LogExtFileWin32Status
LogExtFileDate
LogFileDirectory
LogExtFileFlags
LogFileLocaltimeRollover
LogExtFileHttpStatus
LogFilePeriod
LogExtFileMethod
LogFileTruncateSize
LogExtFileProtocolVersion
LogNonAnonymous
LogExtFileReferer
LogOdbcDataSource
LogExtFileServerIp
LogOdbcPassword
LogExtFileServerPort
LogOdbcTableName
LogExtFileSiteName
LogOdbcUserName
LogExtFileTime
LogPluginClsId
LogType

MaxClientsMessage
MaxConnections
MaxEndpointConnections
MSDOSDirOutput
ServerBindings
ServerComment
ServerListenBacklog
ServerListenTimeout
ServerSize
ServerAutoStart
ServerState
Realm

=========================
Methods 方法
-------------------------
Continue
Pause
Start
Status
Stop

foreverforyou 2003-03-19

打赏
举报

up...

Cooly 2003-03-19

打赏
举报

下面是一个创建用户和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

recip = "CN=" & strLoginName

'得到指定的用户容器
Set objContainer = GetObject("LDAP://" + strServerFullName + "/CN=Users," + strDomainName)

'检查要创建的用户是否存在
For Each Child In objContainer
If LCase(Right(Child.Name, Len(Child.Name) - 3)) = LCase(strLoginName) Then CreateUser = 1: Exit Function
Next

'创建用户
Set objUser = objContainer.Create("User", recip)
objUser.Put "samAccountName", strLoginName
objUser.Put "sn", strLastName
objUser.Put "givenName", strFirstName
objUser.Put "userPrincipalName", strLoginName
objUser.Put "userAccountControl", 66048
objUser.SetInfo
objUser.SetPassword strPassword
objUser.AccountDisabled = False
objUser.SetInfo

CreateUser = 0
End Function

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

'创建新的FTP站点.其中站点索引号为递增号码,一般默认FTP站点为1.在实际使用中,可以判断一共有多少个站点.然后索引号加一即可.
'如果需要创建虚拟目录,操作完全一样.

Set oNewFtpServer = oMsFtpSvc.Create("IIsFtpServer", iSiteNumber)
oNewFtpServer.SetInfo
If (Err.Number <> 0) Then
MsgBox "不能创建FTP站点. 可能是站点索引号已存在. 站点索引号: " & iSiteNumber
Exit Function
End If

Err.Clear

'设置新FTP站点的属性
oNewFtpServer.ServerBindings = strIPAddress & ":" & iPortNum & ":"
oNewFtpServer.ServerComment = strServerComment
oNewFtpServer.SetInfo

Set oNewDir = oNewFtpServer.Create("IIsFtpVirtualDir", "ROOT")
oNewDir.Path = strRootDirectory

oNewDir.AccessRead = True '允许读访问
oNewDir.AccessWrite = True '允许写访问
oNewDir.SetInfo

'设置匿名访问账号
oMsFtpSvc.AllowAnonymous = True
oMsFtpSvc.AnonymousUserName = strUserName
oMsFtpSvc.Anonymouspassword = strPassword
oMsFtpSvc.SetInfo

'启动新的FTP站点
If bStart = True Then
Err.Clear
oNewFtpServer.Start
If Err.Number <> 0 Then
MsgBox strServerComment & "无法自动启动,请察看是否有使用相同端口的FTP服务正在运行"
End If
End If

MsgBox "FTP站点创建成功! : " & "IIS://" & strComputerName & "/MSFTPSVC/" & iSiteNumber

End Function

dreamfan 2003-03-19