- unit RaIIS;
- interface
- uses
- SysUtils, Classes, COMOBJ, windows;
- type
- TRaIIS = class(TComponent)
- private
- fOnDeleteVirtualDirApp: TNotifyEvent;
- fOnDeleteVirtualDir: TNotifyEvent;
- fOnCreateVirtualDir: TNotifyEvent;
- protected
- public
- constructor Create(AOwner: TComponent); override;
- {检查是否存在DotNet FrameWork}
- function CheckDotNetFramework: Boolean;
- {删除虚拟目录应用程序名}
- function DeleteVirtualDirApp(strVirtualDir: string): Boolean;
- {删除虚拟目录}
- function DeleteVirtualDir(strVirtualDir: string): Boolean;
- {检测是否有虚拟目录}
- function CheckVirtualDir(const strVirtualDir: string): Boolean;
- {建立虚拟目录}
- function CreateVirtualDir(const strVirtualDir, strDir, strAppName: string): Boolean;
- published
- property OnDeleteVirtualDirApp: TNotifyEvent read fOnDeleteVirtualDirApp write fOnDeleteVirtualDirApp;
- property OnDeleteVirtualDir: TNotifyEvent read fOnDeleteVirtualDir write fOnDeleteVirtualDir;
- property OnCreateVirtualDir: TNotifyEvent read fOnCreateVirtualDir write fOnCreateVirtualDir;
- end;
- procedure Register;
- implementation
- procedure Register;
- begin
- RegisterComponents('Rarnu Components', [TRaIIS]);
- end;
- { TRaIIS }
- function TRaIIS.CheckDotNetFramework: Boolean;
- var
- SysDir: pchar;
- begin
- GetMem(SysDir, 250);
- GetSystemDirectory(SysDir, 250);
- if not FileExists(SysDir + '/MSCOREE.DLL') then
- Result := False
- else
- Result := True;
- FreeMem(SysDir);
- end;
- function TRaIIS.CheckVirtualDir(const strVirtualDir: string): Boolean;
- var
- WebSite, WebServer, WebRoot: Variant;
- begin
- Result := True;
- try
- WebSite := CreateOleObject('IISNamespace');
- WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
- WebServer := WebSite.GetObject('IIsWebServer', '1');
- WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
- WebRoot.GetObject('IIsWebVirtualDir', strVirtualDir);
- except
- Result := False;
- end;
- end;
- constructor TRaIIS.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- end;
- function TRaIIS.CreateVirtualDir(const strVirtualDir, strDir,
- strAppName: string): Boolean;
- var
- WebSite, WebServer, WebRoot, vdir: Variant;
- begin
- Result := True;
- try
- WebSite := CreateOleObject('IISNamespace');
- WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
- WebServer := WebSite.GetObject('IIsWebServer', '1');
- WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
- vdir := WebRoot.Create('IIsWebVirtualDir', strVirtualDir);
- vdir.AccessRead := True;
- vdir.AccessScript := True; //执行许可为纯脚本
- vdir.DefaultDoc := 'index.aspx,index.asp'; //默认文档
- vdir.EnableDirBrowsing := False;
- vdir.AppFriendlyName := strAppName; //应用程序名
- vdir.Path := strDir;
- vdir.AppCreate(True); //如果没有这句的话,虚拟目录就要人为的手工创建应用程序名
- vdir.SetInfo;
- except
- Result := False;
- end;
- { ADs.Put('AccessRead', cbRead.Checked); //設定各參數
- ADs.Put('AccessWrite', cbWrite.Checked);
- ADs.put('AccessScript',cbScript.Checked);
- ADs.Put('AccessExecute',cbExecute.Checked);
- ADs.put('EnableDirBrowsing',cbBrowse.Checked);
- ADs.Put('Path', edtPath.text);
- ADs.Put('DefaultDoc','Default.asp, Default.html, Default.htm, ndex.asp, Index.html, Index.htm, Home.asp, Home.Html, Home.htm');
- ADs.Put('EnableDefaultDoc',True);//允許打開默認文件 }
- {
- VDir.Path:='d:/report';
- VDir.AccessRead:=True; //读取
- VDir.AccessWrite:=False; //写入
- VDir.EnableDirBrowsing:=False; //目录浏览
- VDir.AccessSource:=True; //脚本资源访问
- VDir.AccessScript:=True; //脚本
- VDir.AccessExecute:=True; //可执行 }
- {
- VDir.AccessRead := True; //读取
- VDir.AccessWrite :=True; //写入
- VDir.AccessExecute :=True; //脚本和可执行文件
- VDir.AccessScript:=True; //纯脚本
- VDir.EnableDirBrowsing :=True; //目录浏览
- VDir.Path := 'F:/VariantTest'; //路径
- VDir.AppCreate(True);
- VDir.AppFriendlyName :='VariantTest'; //应用程序名
- }
- if Assigned(OnCreateVirtualDir) then
- OnCreateVirtualDir(Self);
- end;
- function TRaIIS.DeleteVirtualDir(strVirtualDir: string): Boolean;
- var
- WebSite, WebServer, WebRoot: Variant;
- begin
- Result := True;
- try
- WebSite := CreateOleObject('IISNamespace');
- WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
- WebServer := WebSite.GetObject('IIsWebServer', '1');
- WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
- WebRoot.Delete('IIsWebVirtualDir', strVirtualDir);
- except
- Result := False;
- end;
- if Assigned(OnDeleteVirtualDir) then
- OnDeleteVirtualDir(Self);
- end;
- function TRaIIS.DeleteVirtualDirApp(strVirtualDir: string): Boolean;
- var
- WebSite, WebServer, WebRoot, vdir: Variant;
- begin
- Result := True;
- try
- WebSite := CreateOleObject('IISNamespace');
- WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
- WebServer := WebSite.GetObject('IIsWebServer', '1');
- WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
- vdir := WebRoot.GetObject('IIsWebVirtualDir', strVirtualDir);
- vdir.AppDelete;
- vdir.SetInfo;
- except
- Result := False;
- end;
- if Assigned(OnDeleteVirtualDirApp) then
- OnDeleteVirtualDirApp(Self);
- end;
- end.
Delphi实现对IIS的操作
最新推荐文章于 2024-06-04 17:37:40 发布