有关IIS的虚拟目录的控制总结
最近自己做的项目中要有部分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的页面
问题点数：110、回复次数：21Top
1 楼qxj（己所不欲,勿施于人;送人玫瑰,手有余香!）回复于 2004-09-03 17:52:37 得分 0
1楼Top
2 楼reallike（爱翔)(学得太多，得休息一下）回复于 2004-09-03 17:52:48 得分 10
沙发。blog看到了。Top
3 楼reallike（爱翔)(学得太多，得休息一下）回复于 2004-09-03 17:53:13 得分 0
靠，Qxj JR，自己占自己的沙发。Top
4 楼aiirii（ari-http://spaces.msn.com/members/aiirii/）回复于 2004-09-03 17:58:01 得分 10
不錯,捧場Top
5 楼nyf1220（我是党员----不过听说最近风声紧，打算换名字）回复于 2004-09-03 17:58:49 得分 10
顶一下Top
6 楼halfdream（哈欠）回复于 2004-09-03 18:04:01 得分 10
收藏Top
7 楼Shiyl（云淡风清 卷舒自在）回复于 2004-09-03 18:15:18 得分 10
mark
----------------------------------------------------------------
花自飘零水自流，一种相思，两处闲愁。
此情无计可消除，才下眉头，又上心头。
----------------------------------------------------------------Top
8 楼jinjazz（近身剪）回复于 2004-09-03 18:36:36 得分 10
学习Top
9 楼cnhgj（戏子) (没时间练太极）回复于 2004-09-05 11:25:40 得分 10
MarkTop
10 楼xh416（xh416）回复于 2004-09-05 12:22:33 得分 10
到处找，终于在这里找到，不知道能不能调试通过！
我也是一直建立虚拟目录无法建立应用程序名，希望你的是对的！
ADSI的我一直没调试成功！Top
11 楼xh416（xh416）回复于 2004-09-05 12:24:09 得分 0
提供我写注册表实现的建立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中调试通过。如大家对此有兴趣的话可以与我联系。xh416@163.net QQ:49055028
附：suipack4的下载地址：http://hbsy-http.skycn.net:8181/down/suitrial_312.zip
Top
12 楼qxj（己所不欲,勿施于人;送人玫瑰,手有余香!）回复于 2004-09-06 09:00:07 得分 0
楼上的,至少在我的机器上是通过了,win2K pro+ D6(update2)+iis5Top
13 楼xh416（xh416）回复于 2004-09-06 09:49:15 得分 0
能不能将你的代码发给我一份呢,我测试不能通过!在运行过程中出现如下问题：
Variant does not reference an automation object.
出错指示在下面这行：
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
我的邮箱是xh416@163.net,谢谢了,我主要是想用创建虚拟目录和获取IP及端口!Top
14 楼qxj（己所不欲,勿施于人;送人玫瑰,手有余香!）回复于 2004-09-06 13:02:17 得分 0
我有个同事的机器也有同样的问题,
你给DELPHI打一下UPDATE2(D6_upd2_ent.exe)就行了Top
15 楼qxj（己所不欲,勿施于人;送人玫瑰,手有余香!）回复于 2004-09-06 14:43:08 得分 0
如何判断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;
Top
16 楼reallike（爱翔)(学得太多，得休息一下）回复于 2004-09-07 14:41:04 得分 0
好东西是不能叫他沉底的！Top
17 楼trampgirl（想过一种流浪的生活......）回复于 2004-09-07 14:57:57 得分 10
学习！！！！Top
18 楼hiflower（花）回复于 2004-09-07 15:24:24 得分 10
真是好东东啊。
我在 Win2000server 中没有发现问题Top
19 楼jpyc（九品-沉默）回复于 2004-09-07 15:39:41 得分 10
真有你的！顶！Top
20 楼qxj（己所不欲,勿施于人;送人玫瑰,手有余香!）回复于 2004-09-09 18:07:18 得分 0
结贴Top
21 楼aiirii（ari-http://spaces.msn.com/members/aiirii/）回复于 2004-09-09 18:09:06 得分 0
等我接一把Top
