Delphi实现对IIS的操作

 

1. unit RaIIS;
3. interface
5. uses
6.   SysUtils, Classes, COMOBJ, windows;
8. type
9.   TRaIIS = class(TComponent)
10.   private
11.     fOnDeleteVirtualDirApp: TNotifyEvent;
12.     fOnDeleteVirtualDir: TNotifyEvent;
13.     fOnCreateVirtualDir: TNotifyEvent;
14.   protected
15.   public
16.     constructor Create(AOwner: TComponent); override;
17.     {检查是否存在DotNet FrameWork}
18.     function CheckDotNetFramework: Boolean;
19.     {删除虚拟目录应用程序名}
20.     function DeleteVirtualDirApp(strVirtualDir: string): Boolean;
21.     {删除虚拟目录}
22.     function DeleteVirtualDir(strVirtualDir: string): Boolean;
23.     {检测是否有虚拟目录}
24.     function CheckVirtualDir(const strVirtualDir: string): Boolean;
25.     {建立虚拟目录}
26.     function CreateVirtualDir(const strVirtualDir, strDir, strAppName: string): Boolean;
27.   published
28.     property OnDeleteVirtualDirApp: TNotifyEvent read fOnDeleteVirtualDirApp write fOnDeleteVirtualDirApp;
29.     property OnDeleteVirtualDir: TNotifyEvent read fOnDeleteVirtualDir write fOnDeleteVirtualDir;
30.     property OnCreateVirtualDir: TNotifyEvent read fOnCreateVirtualDir write fOnCreateVirtualDir;
31.   end;
33. procedure Register;
35. implementation
37. procedure Register;
38. begin
39.   RegisterComponents('Rarnu Components', [TRaIIS]);
40. end;
42. { TRaIIS }
44. function TRaIIS.CheckDotNetFramework: Boolean;
45. var
46.   SysDir: pchar;
47. begin
48.   GetMem(SysDir, 250);
49.   GetSystemDirectory(SysDir, 250);
50.   if not FileExists(SysDir + '/MSCOREE.DLL') then
51.     Result := False
52.   else
53.     Result := True;
54.   FreeMem(SysDir);
55. end;
57. function TRaIIS.CheckVirtualDir(const strVirtualDir: string): Boolean;
58. var
59.   WebSite, WebServer, WebRoot: Variant;
60. begin
61.   Result := True;
62.   try
63.     WebSite := CreateOleObject('IISNamespace');
64.     WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
65.     WebServer := WebSite.GetObject('IIsWebServer', '1');
66.     WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
67.     WebRoot.GetObject('IIsWebVirtualDir', strVirtualDir);
68.   except
69.     Result := False;
70.   end;
71. end;
73. constructor TRaIIS.Create(AOwner: TComponent);
74. begin
75.   inherited Create(AOwner);
76. end;
78. function TRaIIS.CreateVirtualDir(const strVirtualDir, strDir,
79.   strAppName: string): Boolean;
80. var
81.   WebSite, WebServer, WebRoot, vdir: Variant;
82. begin
83.   Result := True;
84.   try
85.     WebSite := CreateOleObject('IISNamespace');
86.     WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
87.     WebServer := WebSite.GetObject('IIsWebServer', '1');
88.     WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
89.     vdir := WebRoot.Create('IIsWebVirtualDir', strVirtualDir);
90.     vdir.AccessRead := True;
92.     vdir.AccessScript := True; //执行许可为纯脚本
93.     vdir.DefaultDoc := 'index.aspx,index.asp'; //默认文档
94.     vdir.EnableDirBrowsing := False;
95.     vdir.AppFriendlyName := strAppName; //应用程序名
96.     vdir.Path := strDir;
97.     vdir.AppCreate(True); //如果没有这句的话,虚拟目录就要人为的手工创建应用程序名
98.     vdir.SetInfo;
99.   except
100.     Result := False;
101.   end;
102.   { ADs.Put('AccessRead', cbRead.Checked);      //設定各參數
103.           ADs.Put('AccessWrite', cbWrite.Checked);
104.           ADs.put('AccessScript',cbScript.Checked);
105.           ADs.Put('AccessExecute',cbExecute.Checked);
106.           ADs.put('EnableDirBrowsing',cbBrowse.Checked);
107.           ADs.Put('Path', edtPath.text);
108.           ADs.Put('DefaultDoc','Default.asp, Default.html, Default.htm, ndex.asp, Index.html, Index.htm, Home.asp, Home.Html, Home.htm');
109.           ADs.Put('EnableDefaultDoc',True);//允許打開默認文件   }
111.   {
112.   VDir.Path:='d:/report';
113.   VDir.AccessRead:=True;         //读取
114.   VDir.AccessWrite:=False;        //写入
115.   VDir.EnableDirBrowsing:=False;  //目录浏览
116.   VDir.AccessSource:=True;       //脚本资源访问
117.   VDir.AccessScript:=True;       //脚本
118.   VDir.AccessExecute:=True;      //可执行 }
119.   {
120.   VDir.AccessRead := True;   //读取
121.   VDir.AccessWrite :=True;  //写入
122.   VDir.AccessExecute :=True;  //脚本和可执行文件
123.   VDir.AccessScript:=True;   //纯脚本
124.   VDir.EnableDirBrowsing :=True; //目录浏览
125.   VDir.Path := 'F:/VariantTest'; //路径
126.   VDir.AppCreate(True);
127.   VDir.AppFriendlyName :='VariantTest'; //应用程序名
128.   }
129.   if Assigned(OnCreateVirtualDir) then
130.     OnCreateVirtualDir(Self);
131. end;
133. function TRaIIS.DeleteVirtualDir(strVirtualDir: string): Boolean;
134. var
135.   WebSite, WebServer, WebRoot: Variant;
136. begin
137.   Result := True;
138.   try
139.     WebSite := CreateOleObject('IISNamespace');
140.     WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
141.     WebServer := WebSite.GetObject('IIsWebServer', '1');
142.     WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
143.     WebRoot.Delete('IIsWebVirtualDir', strVirtualDir);
144.   except
145.     Result := False;
146.   end;
147.   if Assigned(OnDeleteVirtualDir) then
148.     OnDeleteVirtualDir(Self);
149. end;
151. function TRaIIS.DeleteVirtualDirApp(strVirtualDir: string): Boolean;
152. var
153.   WebSite, WebServer, WebRoot, vdir: Variant;
154. begin
155.   Result := True;
156.   try
157.     WebSite := CreateOleObject('IISNamespace');
158.     WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
159.     WebServer := WebSite.GetObject('IIsWebServer', '1');
160.     WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
161.     vdir := WebRoot.GetObject('IIsWebVirtualDir', strVirtualDir);
162.     vdir.AppDelete;
163.     vdir.SetInfo;
164.   except
165.     Result := False;
166.   end;
167.   if Assigned(OnDeleteVirtualDirApp) then
168.     OnDeleteVirtualDirApp(Self);
169. end;
171. end.