如何得到IIS虚拟目录列表(298分)

' 以下是VBS代码：
dim websvc, site, root, dir
set websvc = GetObject("IIS://localhost/W3svc&quot
set site = websvc.GetObject("IIsWebServer", "1&quot
set root = site.GetObject("IISWebVirtualDir", "Root&quot
for each dir in root
if dir.class = "IIsWebVirtualDir" then
MsgBox dir.Name + "=" + dir.Path
end if
next

// 以下是Delphi代码，就是VBS的for each部分不知Delphi的如何写？
procedure GetIISWebVirtualDirList(AList: TStrings);
var
WebSite, WebService, WebServer, WebRoot: Variant;
begin
AList.Clear;
WebSite := CreateOleObject('IISNamespace');
WebService := WebSite.GetObject('IISWebService', 'localhost/w3svc');
WebServer := WebService.GetObject('IISWebServer', '1');
WebRoot := WebServer.GetObject('IISWebVirtualDir', 'Root');
//AList.Add(WebRoot.Name + '=' + WebRoot.Path);
//WebRoot.GetObject('IISWebVirtualDir',Edit1.Text);
// ... TODO
end;

For Each dir In root的意思是:循环root中的每个元素,每次调用的时候将值赋给变量dir
一般这样写:
for i:=0 to root.count-1 do begin
if root is IIsWebVirtualDir then begin
dir:=root;
...
end;
end;
具体的写法等待其他高手了

IISWebVirtualDir 没有 count 属性
楼上的写法是行不通的，已试过

搞定，送分

type
// 摘自 ActiveX.pas
IEnumVariant = interface(IUnknown)
['{00020404-0000-0000-C000-000000000046}']
function Next(celt: LongWord; var rgvar : OleVariant;
out pceltFetched: LongWord): HResult; stdcall;
function Skip(celt: LongWord): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out Enum: IEnumVariant): HResult; stdcall;
end;

// 摘自 system32/activeds.tlb -> ActiveDs_TLB.pas
IADsContainer = interface(IDispatch)
['{001677D0-FD16-11CE-ABC4-02608C9E7553}']
function Get_Count: Integer; safecall;
function Get__NewEnum: IUnknown; safecall;
function Get_Filter: OleVariant; safecall;
procedure Set_Filter(pVar: OleVariant); safecall;
function Get_Hints: OleVariant; safecall;
procedure Set_Hints(pvFilter: OleVariant); safecall;
function GetObject(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
function Create(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
procedure Delete(const bstrClassName: WideString; const bstrRelativeName: WideString); safecall;
function CopyHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
function MoveHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
property Count: Integer read Get_Count; // 该属性IIS没有实现，不能用
property _NewEnum: IUnknown read Get__NewEnum;
property Filter: OleVariant read Get_Filter write Set_Filter;
property Hints: OleVariant read Get_Hints write Set_Hints;
end;

procedure GetIISWebVirtualDirList(AList: TStrings);
var
WebSite, WebService, WebServer, WebRoot: Variant;
Container: IADsContainer;
Enum: IEnumVariant;
WebDir: OleVariant;
sRootPath, sClassName, sName: string;
function DoMoveNext: Boolean;
var
Fetched: Cardinal;
begin
if Enum <> nil then
begin
Enum.Next(1, WebDir, Fetched); // fetch the next element from the collection list
if Fetched = 1 then
Result := True // another object was fetched
else
Result := False; // no more objects in enumaration
end
else
Result := False;
end;
begin
AList.Clear;
WebSite := CreateOleObject('IISNamespace');
WebService := WebSite.GetObject('IISWebService', 'localhost/w3svc');
WebServer := WebService.GetObject('IISWebServer', '1');
WebRoot := WebServer.GetObject('IISWebVirtualDir', 'Root');
sRootPath := WebRoot.Path;
if VarSupports(WebRoot, IADsContainer, Container) then
begin
Supports(Container._NewEnum, IEnumVariant, Enum);
while DoMoveNext do
begin
sClassName := WebDir.Class;
sName := WebDir.Name;
if SameText(sClassName, 'IIsWebVirtualDir') then
AList.Add(sName + '= ' + WebDir.Path)
else if SameText(sClassName, 'IIsWebDirectory') then
AList.Add(sName + '= ' + sRootPath + '/' + sName)
end;
end;
end;