通过编程建立IIS的FTP虚拟目录，高手请进(300分)(300分)

通过编程建立IIS的FTP虚拟目录,开发工具使用Delphi。
各位高手请不吝赐教，谢谢！

看一MS help

好像VBScript就可以做到，MS有例子，是引用对象的

看看MS的ADSI资料
到cn.yahoo.com上输入ADSI就可以找到一大堆！

这一段是VBScript的建立Virtual FTP directory的代码，MSDN上的，改成Delphi的应该不会
太吃力
WSH Sample ADSI Script
Save the following code as Mkftpdir.vbs in your %SystemDrive%/InetPub/AdminScripts folder:
'------------------------------------------------------------
'
' This is a simple script to create a new virtual FTP directory.
'
' Call this script with "-?" for usage instructions
'
'------------------------------------------------------------
' Force explicit declaration of all variables.
Option Explicit
On Error Resume Next
Dim oArgs, ArgNum
Dim ArgComputer, ArgFtpSites, ArgVirtualDirs, ArgDirNames(), ArgDirPaths(), DirIndex
Dim ArgComputers
Set oArgs = WScript.Arguments
ArgComputers = Array("LocalHost")
ArgNum = 0
While ArgNum < oArgs.Count
If (ArgNum + 1) >= oArgs.Count then
Call DisplayUsage
End If
Select Case LCase(oArgs(ArgNum))
Case "--computer", "-c":
ArgNum = ArgNum + 1
ArgComputers = Split(oArgs(ArgNum), ",", -1)
Case "--ftpsite", "-f":
ArgNum = ArgNum + 1
ArgFtpSites = oArgs(ArgNum)
Case "--virtualdir", "-v":
ArgNum = ArgNum + 1
ArgVirtualDirs = Split(oArgs(ArgNum), ",", -1)
Case "--help", "-?"
Call DisplayUsage
End Select
ArgNum = ArgNum + 1
Wend
ArgNum = 0
DirIndex = 0
ReDim ArgDirNames((UBound(ArgVirtualDirs) + 1) / 2)
ReDim ArgDirPaths((UBound(ArgVirtualDirs) + 1) / 2)
If IsArray(ArgVirtualDirs) then
While ArgNum <= UBound(ArgVirtualDirs)
ArgDirNames(DirIndex) = ArgVirtualDirs(ArgNum)
If (ArgNum + 1) > UBound(ArgVirtualDirs) then
WScript.Echo "Error understanding virtual directories"
Call DisplayUsage
End If
ArgNum = ArgNum + 1
ArgDirPaths(DirIndex) = ArgVirtualDirs(ArgNum)
ArgNum = ArgNum + 1
DirIndex = DirIndex + 1
Wend
End If
If (ArgFtpSites = "") Or (IsArray(ArgDirNames) = False Or IsArray(ArgDirPaths) = False) then
Call DisplayUsage
else
Dim compIndex
For compIndex = 0 To UBound(ArgComputers)
Call ASTCreateVirtualFtpDir(ArgComputers(compIndex), ArgFtpSites, ArgDirNames, ArgDirPaths)
Next
End If
'------------------------------------------------------------
Sub Display(Msg)
WScript.Echo Now &amp;
". Error Code: " &amp;
Hex(Err) &amp;
" - " &amp;
Msg
End Sub
Sub Trace(Msg)
WScript.Echo Now &amp;
" : " &amp;
Msg
End Sub
Sub DisplayUsage()
WScript.Echo "Usage: mkftpdir [--computer|-c COMPUTER1,COMPUTER2]"
WScript.Echo " <--ftpsite|-f FTPSITE1>"
WScript.Echo " <--virtualdir|-v NAME1,PATH1,NAME2,PATH2,...>"
WScript.Echo " [--help|-?]"
WScript.Echo ""
WScript.Echo "Note, FTPSITE is the Ftp Site on which the directory will be created."
WScript.Echo "The name can be specified as one of the following, in the priority specified:"
WScript.Echo " Server Number (i.e. 1, 2, 10, etc.)"
WScript.Echo " Server Description (i.e ""My Server"")"
WScript.Echo " Server Host name (i.e. ""ftp.domain.com"")"
WScript.Echo " IP Address (i.e., 127.0.0.1)"
WScript.Echo ""
WScript.Echo ""
WScript.Echo "Example : mkftpdir -c MyComputer -f ""Default Ftp Site"""
WScript.Echo " -v ""dir1"",""c:/inetpub/ftproot/dir1"",""dir2"",""c:/inetpub/ftproot/dir2"""
WScript.Quit
End Sub
'------------------------------------------------------------
Sub ASTCreateVirtualFtpDir(ComputerName, FtpSiteName, DirNames, DirPaths)
Dim computer, ftpSite, FtpSiteID, vRoot, vDir, DirNum
On Error Resume Next

Set ftpSite = findFtp(ComputerName, FtpSiteName)
If IsObject(ftpSite) then
Set vRoot = ftpSite.GetObject("IIsFtpVirtualDir", "Root")
Trace "Accessing root for " &amp;
ftpSite.ADsPath
If (Err <> 0) then
Display "Unable to access root for " &amp;
ftpSite.ADsPath
else
DirNum = 0
If (IsArray(DirNames) = True) And (IsArray(DirPaths) = True) And (UBound(DirNames) = UBound(DirPaths)) then
While DirNum < UBound(DirNames)
'Create the new virtual directory
Set vDir = vRoot.Create("IIsFtpVirtualDir", DirNames(DirNum))
If (Err <> 0) then
Display "Unable to create " &amp;
vRoot.ADsPath &amp;
"/" &amp;
DirNames(DirNum) &amp;
"."
else
'Set the new virtual directory path
vDir.AccessRead = True
vDir.Path = DirPaths(DirNum)
If (Err <> 0) then
Display "Unable to bind path " &amp;
DirPaths(DirNum) &amp;
" to " &amp;
vRootName &amp;
"/" &amp;
DirNames(DirNum) &amp;
". Path may be invalid."
else
'Save the changes
vDir.SetInfo
If (Err <> 0) then
Display "Unable to save configuration for " &amp;
vRootName &amp;
"/" &amp;
DirNames(DirNum) &amp;
"."
else
Trace "Ftp virtual directory " &amp;
vRootName &amp;
"/" &amp;
DirNames(DirNum) &amp;
" created successfully."
End If
End If
End If
Err = 0
DirNum = DirNum + 1
Wend
End If
End If
else
Display "Unable to find " &amp;
FtpSiteName &amp;
" on " &amp;
ComputerName
End If
Trace "Done."
End Sub
Function getBinding(bindstr)
Dim one, two, ia, ip, hn

one = InStr(bindstr, ":")
two = InStr((one + 1), bindstr, ":")

ia = Mid(bindstr, 1, (one - 1))
ip = Mid(bindstr, (one + 1), ((two - one) - 1))
hn = Mid(bindstr, (two + 1))

getBinding = Array(ia, ip, hn)
End Function
Function findFtp(computer, ftpname)
On Error Resume Next
Dim ftpsvc, site
Dim ftpinfo
Dim aBinding, binding
Set ftpsvc = GetObject("IIS://" &amp;
computer &amp;
"/MsFtpSvc")
If (Err <> 0) then
Exit Function
End If
' First try to open the ftpname.
Set site = ftpsvc.GetObject("IIsFtpServer", ftpname)
If (Err = 0) And (Not IsNull(site)) then
If (site.Class = "IIsFtpServer") then
' Here we found a site that is a ftp server.
Set findFtp = site
Exit Function
End If
End If
Err.Clear
For Each site In ftpsvc
If site.Class = "IIsFtpServer" then
' First, check to see if the ServerComment matches
If site.ServerComment = ftpname then
Set findFtp = site
Exit Function
End If
aBinding = site.ServerBindings
If (IsArray(aBinding)) then
If aBinding(0) = "" then
binding = Null
else
binding = getBinding(aBinding(0))
End If
else
If aBinding = "" then
binding = Null
else
binding = getBinding(aBinding)
End If
End If
If IsArray(binding) then
If (binding(2) = ftpname) Or (binding(0) = ftpname) then
Set findFtp = site
Exit Function
End If
End If
End If
Next
End Function

Call this script with the following syntax for full usage instructions:
CSCRIPT %SystemDrive%/InetPub/AdminScripts/MKFTPDIR.VBS -?

我夜想要。关注。[]

1.先引入类型库(Project|Import Type Library)adsiis.dll、iisext.dll和activeds.tlb
2.声明
unit ActiveDs;
interface
function ADsGetObject(const PathName: WideString;
const GUID: TGUID;
out I: IUnknown): HRESULT;
stdcall;
implementation
function ADsGetObject;
external 'activeds.dll' name 'ADsGetObject';
end.

3.引用
uses ActiveDs_TLB,IISExt_TLB;
具体实现暂时只有IIS身成WEB的 FTP没有做
我做了一个范例在http://jp.njuct.edu.cn/crystal/program_view.asp?id=7

to kindly:
谢谢你贴了这么多代码，这些代码我实现过，我需要的是在Delphi中直接使用，而不是
用VBScript
to 房客：
能否给出建立FTP虚拟目录的代码？ 建立IIS虚拟目录的方法我已经知道了
请房客先生继续。。。。。。。先谢谢了

真是分不值钱了，delphi的ftp的demo什么都有，就是没人看。

使用ICServer 的FTPServer实现比较好，我就打算那么做。

这个问题我做过。关键是要掌握IIS的对象和接口层次。 至于代码，和建立IIS
WebVirtualDirectory 类似。
请看我在这贴的回答.
http://www.delphibbs.com/delphibbs/dispq.asp?lid=507661

请各位继续，小猪同志要考虑考虑，问题不是那么简单

没有办法的了，唯有多去看看MSDN了。[]

我在用BCB5做多层结构系统时，我在Server端加入了一个取得服务器IP地址的方法：GetServerIP它的参数是vIP：Variant *,IN方式，并在服务端实现了这个方法，
加入的代码如下：
*vIP="192.168.0.01";最后我注册成功。
可是在我开发客户端程序时，我用TSocketConnection
当取得它的服务时我是这样做的：
Variant* vip;
SocketConnection1->AppServer.GetServerIP(vip);
Edit1->Tex=vip;
可 是我在运行程序时出错，没有编译通过。
它说getserverIP不是variant的成员
getserverIP is not a memober of variant
请问？
我该如何去调用这个方法呢？
请各位大侠多多指教？
小生的QQ：65466700(24小时在线恭候)
MAIL： alongsun@sina.com

思考中、、、

呵呵，我前几天刚写完的代码，绝对好用[]
procedure CreateFtpVDir(VDirName, Path: string);
var
Site, Server, VRoot, VDir: Variant;
begin
Site := CreateOleObject('IISNamespace');
Site := Site.GetObject('IIsFtpService', 'localhost/MSFTPSVC');
Server := Site.GetObject('IIsFtpServer', '1');
VRoot := Server.GetObject('IIsFtpVirtualDir', 'Root');

VDir := VRoot.Create('IIsFtpVirtualDir', VDirName);
VDir.Path := Path;
VDir.AccessRead := true;
VDir.AccessWrite := true;
VDir.SetInfo;

Site := Unassigned;
Server := Unassigned;
VRoot := Unassigned;
VDir := Unassigned;
end;

zcgly2,我现在来不及试，不过相信你，分数给你了