急,请帮忙,如何用VB创建FTP虚拟目录?

Question

请问如何用VB创建FTP虚拟目录?如:创建一个book虚拟目录.ftp://localhost/book/

Answer 1

这一段是建立iis web站点的
找找相关的资料，改称ftp的
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 FunctionPrivate Sub Command2_Click()
Call WebVirtualDir("aa", "aa", "E:\", "Default.asp")
End Sub

Answer 2

这是我们开发FTP文件上传和下载用的源代码：
Option ExplicitPrivate Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _
                (ByVal lpBuffer As String, ByVal nSize As Long) As LongPublic Function CreateFTPDirectory(ByVal VirtrueName As String, ByVal LocalPath As String) As Boolean
    Dim ExistFTP As Boolean
    Dim ServerObj As Object
    Dim VirtrueDirObj As Object
    Dim MyVirtrueDir As Object
    
    ExistFTP = False
    CreateFTPDirectory = False
    
    On Error GoTo ErrFTP
    If CheckExistIIS Then
        Set ServerObj = GetObject("IIS://LocalHost/MSFTPSVC/1/ROOT")
        For Each MyVirtrueDir In ServerObj
            If UCase(MyVirtrueDir.Class) = UCase("IIsFtpVirtualDir") Then
                If UCase(MyVirtrueDir.Name) = UCase(Trim(VirtrueName)) Then
                    ExistFTP = True
                End If
            End If
        Next
        
        If ExistFTP Then
            Set VirtrueDirObj = ServerObj.GetObject("IIsFtpVirtualDir", VirtrueName)
        Else
            Set VirtrueDirObj = ServerObj.Create("IIsFtpVirtualDir", VirtrueName)
        End If
        
        VirtrueDirObj.Path = LocalPath
        VirtrueDirObj.AccessRead = True
        VirtrueDirObj.AccessWrite = True
        VirtrueDirObj.SetInfo
        Set ServerObj = Nothing
        Set VirtrueDirObj = Nothing
    End If
    CreateFTPDirectory = True
    Exit Function
    
ErrFTP:
    Call WriteLog("clsServer", "CreateFTPDirectory", Err.Description)
    MsgBox "Error: " & Err.Description, vbCritical, "Create FTP Directory Error"
    Err.Clear
End FunctionPublic Function DeleteFTPDirectory(ByVal VirtrueName As String) As Boolean
    Dim ServerObj As Object
    Dim MyVirtrueDir As Object
    
    DeleteFTPDirectory = False
    
    On Error GoTo ErrFTP
    If CheckExistIIS Then
        Set ServerObj = GetObject("IIS://LocalHost/MSFTPSVC/1/ROOT")
        For Each MyVirtrueDir In ServerObj
            If UCase(MyVirtrueDir.Class) = UCase("IIsFtpVirtualDir") Then
                If UCase(MyVirtrueDir.Name) = UCase(Trim(VirtrueName)) Then
                    ServerObj.Delete "IIsObject", VirtrueName
                End If
            End If
        Next
        Set ServerObj = Nothing
    End If
    DeleteFTPDirectory = True
    Exit FunctionErrFTP:
    Call WriteLog("clsServer", "DeleteFTPDirectory", Err.Description)
    MsgBox "Error: " & Err.Description, vbCritical, "Delete FTP Directory Error"
    Err.Clear
End FunctionPrivate Function CheckExistIIS() As Boolean
    Dim SysDir As String, IISStartPath As String
    Dim FTP As Object, WWW As Object
    
    On Error GoTo CheckErr
    
    Set WWW = GetObject("IIS://LocalHost/W3SVC")
    Set FTP = GetObject("IIS://LocalHost/MSFTPSVC")
    If Not (IsObject(FTP) And IsObject(WWW)) Then
        MsgBox "Not exist the service of WEB.", vbInformation, "Information"
        CheckExistIIS = False
    Else
        SysDir = Space(127)
        GetSystemDirectory SysDir, Len(SysDir)
        SysDir = Left(SysDir, InStr(1, SysDir, Chr(0)) - 1)
        IISStartPath = SysDir & "\iisreset.exe /start"
        If Shell(IISStartPath, vbHide) = 0 Then
            CheckExistIIS = False
            MsgBox "Can not start the service."
        Else
            CheckExistIIS = True
        End If
    End If
    Set FTP = Nothing
    Set WWW = Nothing
    Exit Function
    
CheckErr:
    Call WriteLog("clsServer", "CheckExistIIS", Err.Description)
    MsgBox Err.Description
    CheckExistIIS = False
    Err.Clear
End Function

Answer 3

使用Delphi创建IIS虚拟目录
http://www.csdn.net/develop/Read_Article.asp?Id=25785你看看能不能改成vb的

Answer 4

我要的是创建一个FTP的虚拟目录,不是FTP的站点啊.请兄弟帮忙啊.

Answer 5

......
         
            On Error Resume Next
            Set ftpserverif = GetObject("IIS://" & ComputerName & "/MSFTPSVC/" & I & "/Root/" & Dirname)
    
            If Err.Number = -2147024893 Then
            Set virtualdir = ftpServer.Create("IISFTPVirtualDir", Dirname)
                virtualdir.path = Realpath
                    Select Case limitset
                        Case 1: virtualdir.AccessRead = True
                                virtualdir.accesswrite = False
                        Case 2: virtualdir.accesswrite = True
                                virtualdir.AccessRead = False
                        Case 3:
                                virtualdir.AccessRead = True
                                virtualdir.accesswrite = True
                                
                        Case Else:
                                MsgBox "错误的参数！"
                                CreateVirFTPDir = False
                                Set ftpServer = Nothing
                                Set ftpservice = Nothing
                                Set virtualdir = Nothing
                                Exit Function
                    End Select
                virtualdir.SetInfo
                '创建成功
                CreateVirFTPDir = True
                
                Set ftpServer = Nothing
                Set ftpserverif = Nothing
                Set virtualdir = Nothing
                Exit Function
        End If
     ..............