有关IIS的虚拟目录的控制总结

[qxj]

最近自己做的项目中要有部分IIS的控制,且也有版民提出相应的IIS的问题,
现将自己的一点经验总结如下供大家参考,如有错误之处请与我联系.

程序中需USE COMOBJ单元
1.Q:如何得到机器上IIS中所有的WEB虚拟站点.

A:

var
InstallPath: String;
WebSite, WebServer, WebRoot: Variant;
count: Integer;
Flag: Boolean;
begin
Flag :=True;
count :=1;

while Flag do
begin
try

WebSite :=CreateOLEObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', inttostr(count));
Memo1.Lines.Add(WebServer.ServerComment);
inc(count);
except
flag :=False;
end;
end;

2. Q:通过程序控制默认WEB站点的启动,停止,暂停
A:
//停止WEB站点

procedure TForm1.btn_stopClick(Sender: TObject);
var
InstallPath: String;
WebSite, WebServer, WebRoot: Variant;
begin
try
WebSite :=CreateOLEObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', '1');
if string(webserver.ServerState) ='2' then
begin
webserver.stop;
showmessage('停止服务成功');
end;
except
showmessage('停止服务失败');
end;

end;

//启动WEB站点

procedure TForm1.btn_startClick(Sender: TObject);
var
InstallPath: String;
WebSite, WebServer, WebRoot: Variant;
begin
try
WebSite :=CreateOLEObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', '1');
if string(webserver.ServerState) ='4' then
begin
webserver.start;
showmessage('启动服务成功');
end;
except
showmessage('启动服务失败');
end;


end;

//暂停WEB站点

procedure TForm1.btn_pauseClick(Sender: TObject);
var
InstallPath: String;
WebSite, WebServer, WebRoot: Variant;
begin
try
WebSite :=CreateOLEObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', '1');
if string(webserver.ServerState) ='2' then
begin
webserver.pause;
showmessage('暂停服务成功');
end;
except
showmessage('暂停服务失败');
end;

end;



3.虚拟目录的创建
a:以程序在网上或超级猛料中也有,但都没有指定应用程序名,以下程序已完成此功能
var
InstallPath: String;
WebSite, WebServer, WebRoot, VDir: Variant;
begin
WebSite := CreateOleObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', '1');
webserver.setinfo;
WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
VDir := WebRoot.Create('IIsWebVirtualDir', 'VariantTest');
VDir.AccessRead := True;
VDir.Path := 'C:\test';
VDir.AppCreate(True); //如果没有这句的话,虚拟目录就要人为的手工创建应用程序名

VDir.SetInfo;
Q:如何得到WEB站点的IP和端口

A:此次以WEB站点为例

var
InstallPath: String;
WebSite, WebServer, WebRoot: Variant;
ar: array of variant;
begin
try
WebSite :=CreateOLEObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', '3');
ar := webserver.ServerBindings; //把IIS虚拟站点绑定的IP、端口、域名的值放入数组
showmessage(ar[0]);

except
end;

更多的请大家查看MSDN中有关ADSI的页面

[reallike]

沙发。blog看到了。

[reallike]

靠，Qxj JR，自己占自己的沙发。

[aiirii]

不錯,捧場

[nyf1220]

顶一下

[halfdream]

收藏

[Shiyl]

mark


----------------------------------------------------------------
花自飘零水自流，一种相思，两处闲愁。
此情无计可消除，才下眉头，又上心头。
----------------------------------------------------------------

[jinjazz]

学习

[cnhgj]

Mark

[xh416]

到处找，终于在这里找到，不知道能不能调试通过！
我也是一直建立虚拟目录无法建立应用程序名，希望你的是对的！

ADSI的我一直没调试成功！

[xh416]

提供我写注册表实现的建立IIS虚拟目录，希望大家再来完善！
procedure TForm1.Button1Click(Sender: TObject);
var
RegODBC:TRegistry;
registerTemp : TRegistry;
SysPath: array [0..255] of char;
begin
RegODBC:=TRegistry.create; //访问注册表
RegODBC.RootKey:=HKEY_LOCAL_MACHINE;
RegODBC.OpenKey('\SYSTEM\ControlSet001\Services\W3SVC\Parameters\Virtual Roots',True);
getsystemdirectory(SysPath,255);
if regodbc.ValueExists('/fire') then
begin
suimessage1.Text:='本机WEB已存在名为fire的虚拟目录。'+#13#10+'请将此fire删除或重命名。';
suimessage1.IconType:=suistop;
suimessage1.ButtonCount:=1;
suimessage1.Caption:='错误';
if suimessage1.ShowModal=mrok then
winexec(pchar(SysPath+'\inetsrv\inetmgr.exe'),sw_shownormal);
exit;
end
else
begin
registerTemp := TRegistry.Create; //建立一个Registry实例
with registerTemp do
begin
RootKey:=HKEY_LOCAL_MACHINE;//设置根键值为HKEY_LOCAL_MACHINE

//找到或创建\SYSTEM\ControlSet001\Services\W3SVC\Parameters\Virtual Roots,写入IIS配置信息
if OpenKey('\SYSTEM\ControlSet001\Services\W3SVC\Parameters\Virtual Roots',True) then
begin
WriteString('/fire','E:\fire,,205');
end
else//创建键值失败
begin
suimessage1.Text:='IIS配置失败，本程序即将关闭。'+#13#10+'关闭后请先检查Internet服务管理器，排除错误或安装后再运行本程序。';
suimessage1.IconType:=suistop;
suimessage1.ButtonCount:=1;
suimessage1.Caption:='错误';
if suimessage1.ShowModal=mrok then
application.Terminate ;
end;
CloseKey;
Free;
end;
end;
RegODBC.Free;
end;


说明：代码中用到了suipack4控件的suimessagedialog组件(起提示作用)，例子的确认窗口也可通过Application.MessageBox()来替代。代码在DELPHI6+WINDOWS2000中调试通过。如大家对此有兴趣的话可以与我联系。[e-mail] QQ:49055028

附：suipack4的下载地址：http://hbsy-http.skycn.net:8181/down/suitrial_312.zip

[qxj]

我有个同事的机器也有同样的问题,
你给DELPHI打一下UPDATE2(D6_upd2_ent.exe)就行了

[qxj]

如何判断IIS下是否存在某个虚拟目录,但有一个问题,如果是我手工在IIS中建立的虚拟目录会返回错误,不知何解

var
WebSite, WebServer, WebRoot, VDir: Variant;
count: Integer;
Flag: Boolean;
begin
Flag :=True;
count :=1;
while Flag do
begin
try
WebSite :=CreateOLEObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', inttostr(count));
WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
try
vdir :=webroot.GetObject('IIsWebVirtualDir', 'MyVirtualDir');
showmessage('已存在此虚拟目录');
except
//如果出错则代表不存在
showmessage('不存在此虚拟目录');
end;
inc(count);
except
flag :=False;
end;
end;
end;

[qxj]

楼上的,至少在我的机器上是通过了,win2K pro+ D6(update2)+iis5

[xh416]

能不能将你的代码发给我一份呢,我测试不能通过!在运行过程中出现如下问题：
Variant does not reference an automation object.
出错指示在下面这行：
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');

我的邮箱是[e-mail],谢谢了,我主要是想用创建虚拟目录和获取IP及端口!

[reallike]

好东西是不能叫他沉底的！

[trampgirl]

学习！！！！

[hiflower]

真是好东东啊。
我在 Win2000server 中没有发现问题

[jpyc]

真有你的！顶！

[qxj]

结贴

[aiirii]

等我接一把