一、判断一个虚拟目录是否存在:
Function VirtualDirIsExist(strVirtualDir: String): Boolean
二、新建一个虚拟目录:
Function CreateVirtualDir(strVirtualDir, strRealPath: String): Boolean
三、删除一个虚拟目录:
Function DeleteVirtualDir(strVirtualDir: String): Boolean即把手工管理IIS的虚拟目录用程序来实现。
操作系统:WIN2K SERVER 或者 WIN2K ADNVANCED SERVER
谢谢。
Function VirtualDirIsExist(strVirtualDir: String): Boolean
二、新建一个虚拟目录:
Function CreateVirtualDir(strVirtualDir, strRealPath: String): Boolean
三、删除一个虚拟目录:
Function DeleteVirtualDir(strVirtualDir: String): Boolean即把手工管理IIS的虚拟目录用程序来实现。
操作系统:WIN2K SERVER 或者 WIN2K ADNVANCED SERVER
谢谢。
解决方案 »
- 关于在delphi中打开aspx网页的问题?
- 求教:用IdTCPClient和IdTCPServer编写聊天程序的的代码时,却提示:Undeclared ……
- 我只是想问一问可不可以实现!
- ListView的问题
- 高分请教问题:LoadFromFile(filename)时报错:EFOpenerror cann't open file 急!!
- 如果动态分配一个指向结构体的数组(aa: array of P***)?(较难、少见)
- 我的程序中有四個主菜單,人事,考勤,工資,系統管理,我希望
- 从“熊猫烧香”中学程序
- 如何在不使用数据库的情况下在ExpressQuantumGrid中插入一个节点数据,给50分
- 怎样使用ServerSocket和ClientSocket控件传输比较大的数据流?
- Memo问题
- '掉线之迷?'(百分相送)
作者:noctwolf先引入类型库(Project|Import Type Library)adsiis.dll、iisext.dll和activeds.tlb新建一个单元,声明unit ActiveDs;interface function ADsGetObject(const PathName: WideString; const GUID: TGUID; out I: IUnknown): HRESULT; stdcall;implementation function ADsGetObject; external 'activeds.dll' name 'ADsGetObject';end. 方法一(参照C++)、var I: IADsContainer;
ADs: IADs;
begin
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
ADs := IADs(I.GetObject('IIsWebServer', '1'));
ShowMessage(ADs.ADsPath);
if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
ADs := IADs(I.GetObject('IIsWebVirtualDir', 'Root'));
ShowMessage(ADs.ADsPath);
if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
ADs := IADs(I.Create('IIsWebVirtualDir', 'DelphiTest'));
ADs.Put('AccessRead', 'True');
ADs.Put('Path', 'c:\Temp');
ADs.SetInfo;
end;
end;end;end; 方法二(使用接口)、procedure TForm3.BitBtn4Click(Sender: TObject);
var
Disp: IDispatch;
begin
Disp := IISNamespace1.GetObject('IIsWebService', 'localhost/w3svc');
Disp := (Disp as IADsContainer).GetObject('IIsWebServer', '1');
Disp := (Disp as IADsContainer).GetObject('IIsWebVirtualDir', 'Root');
Disp := (Disp as IADsContainer).Create('IIsWebVirtualDir', 'DelphiADSITest');
(Disp as IADs).Put('AccessRead', 'True');
(Disp as IADs).Put('Path', 'c:\ADSITest');
(Disp as IADs).SetInfo;
end;方法三(使用Variant,就是类似VB和ASP的方法)、procedure TForm2.BitBtn1Click(Sender: TObject);
var
WebSite, WebServer, WebRoot, VDir: Variant;
begin
WebSite := CreateOleObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', '1');
WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
VDir := WebRoot.Create('IIsWebVirtualDir', 'VariantTest');
VDir.AccessRead := True;
VDir.Path := 'C:\Test';
VDir.SetInfo;
end;
{------------------------------------------------------------------------------}
{ IIS VIRTUAL PATH OPERATION }
{ Create by liguang }
{ 2001-6-8 }
{ }
{参考资料:大富翁论坛第468148号贴子 }
{参考资料:2000年7月份MSDN中IIsWebVirtualDir }
{------------------------------------------------------------------------------}
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComObj, IISOle_TLB, ActiveDs_TLB;type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
function CreateIISVirtualPath(MapPath:String;Path:String):Boolean;
function SetIISRootPathParam:Boolean;
function KillIISPath(MapPath:String):Boolean;
public
{ Public declarations }
end;var
Form1: TForm1;
function ADsGetObject(const PathName: WideString; const GUID: TGUID; out I: IUnknown): HRESULT; stdcallimplementationfunction ADsGetObject;external 'activeds.dll' name 'ADsGetObject'{$R *.DFM}function TForm1.CreateIISVirtualPath(MapPath:String;Path:String):Boolean;
var
I: IADsContainer;
ADs: IADs;
begin
Result:=false;
try
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
ADs := IADs(I.GetObject('IIsWebServer','1'));
i:=ADs as IADsContainer;
ADs := I.GetObject('IIsWebVirtualDir','Root') as IADs;
i:=ADs as IADsContainer;
ADs := I.Create('IIsWebVirtualDir',MapPath) as IADs;
ADs.Put('AccessRead','True');
ADs.Put('AccessScript','True');
ADs.Put('AccessExecute','True');
file://modify by liguang in 2001-7-8 comeback from shengzhen
file://if operating system is WINDOWS NT4.0+IIS4.0 then this call is error
ADs.Put('AccessSource','True');
ADs.Put('Path',Path);
ADs.SetInfo;
Result:=true;
end;
except
end;
end;function TForm1.SetIISRootPathParam:Boolean;
var
I: IADsContainer;
ADs: IADs;
begin
Result:=false;
try
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
ADs := IADs(I.GetObject('IIsWebServer','1'));
i:=ADs as IADsContainer;
ADs := I.GetObject('IIsWebVirtualDir','Root') as IADs;
ADs.Put('AccessRead','True');
ADs.Put('AccessScript','True');
ADs.Put('AccessExecute','True');
ADs.Put('AccessSource','True');
ADs.SetInfo;
Result:=true;
end;
except
end;
end;function TForm1.KillIISPath(MapPath:String):Boolean;
var
I: IADsContainer;
ADs: IADs;
begin
Result:=false;
if MapPath='Root' then
exit;
try
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
ADs := IADs(I.GetObject('IIsWebServer','1'));
i:=ADs as IADsContainer;
ADs := I.GetObject('IIsWebVirtualDir','Root') as IADs;
i:=ADs as IADsContainer;
ADs := I.GetObject('IIsWebVirtualDir',MapPath) as IADs;
i.Delete(ADs.Get_Schema,ADs.get_Name);
Result:=true;
end;
except
end;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
if CreateIISVirtualPath('WebUser','E:\VC')=true then
MessageBox(GetforegroundWindow,'建立成功!','提示信息',MB_OK)
else
MessageBox(GetforegroundWindow,'建立失败!','提示信息',MB_OK);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
if SetIISRootPathParam=true then
MessageBox(GetforegroundWindow,'修改成功!','提示信息',MB_OK)
else
MessageBox(GetforegroundWindow,'修改失败!','提示信息',MB_OK);
end;procedure TForm1.Button3Click(Sender: TObject);
begin
if SetIISRootPathParam=true then
MessageBox(GetforegroundWindow,'修改成功!','提示信息',MB_OK)
else
MessageBox(GetforegroundWindow,'修改失败!','提示信息',MB_OK);
if CreateIISVirtualPath('WebUser','E:\VC')=true then
MessageBox(GetforegroundWindow,'建立成功!','提示信息',MB_OK)
else
MessageBox(GetforegroundWindow,'建立失败!','提示信息',MB_OK);
end;procedure TForm1.Button4Click(Sender: TObject);
begin
if KillIISPath('WebUser')=true then
MessageBox(GetforegroundWindow,'删除成功!','提示信息',MB_OK)
else
MessageBox(GetforegroundWindow,'删除失败!','提示信息',MB_OK);
end;end.
http://expert.csdn.net/Expert/topic/2051/2051413.xml?temp=.5383722
有分送还有好东东拿。
Sub addVirtualDir(sDir As String, sPath As String)
On Error GoTo errh
Dim oWebSite, oRootNode, oVirtualDir
Set oWebSite = CreateObject("IIS://LocalHost/w3svc/1")
Set oRootNode = oWebSite.GetObject("IIsWebVirtualDir", "Root")
'Create Virtual Directory
Set oVirtualDir = oRootNode.Create("IIsWebVirtualDir", sDir)
'Set Properties
With oVirtualDir
.Path = sPath
.ASPAllowSessionState = False 'Turn off IIS Session
.AppCreate True
.AuthAnonymous = False 'Turn off Anonymous Access
.AuthNTLM = True 'Turn on NTLM Access
.SetInfo 'Save settings to Metabase
End With
Set oVirutalDir = Nothing
Set oRootNode = Nothing
Set oWebSite = Nothing
Exit Sub
errh:
Set oVirutalDir = Nothing
Set oRootNode = Nothing
Set oWebSite = Nothing
Err.Raise vbObjectError + 1, "addVirtualDir", "创建IIS服务路径失败!" + Error
End Sub
unit U_IIS;interfaceuses
ComObj, Variants;
//一、判断一个虚拟目录是否存在:
function IsVirtualDirExist(strVirtualDir: string): Boolean;
//二、新建一个虚拟目录:
function CreateVirtualDir(strVirtualDir, strRealPath: string): Boolean;
//三、删除一个虚拟目录:
function DeleteVirtualDir(strVirtualDir: string): Boolean;implementation//一、判断一个虚拟目录是否存在:
function IsVirtualDirExist(strVirtualDir: string): Boolean;
var
WebSite, WebServer, WebRoot, VDir: Variant;
begin
Result := True;
try
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);
except
Result := False;
end;
finally
WebSite := Unassigned;
WebServer := Unassigned;
WebRoot := Unassigned;
VDir := Unassigned;
end;
end;//二、新建一个虚拟目录:
function CreateVirtualDir(strVirtualDir, strRealPath: string): Boolean;
var
WebSite, WebServer, WebRoot, VDir: Variant;
begin
Result := True;
try
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.AccessWrite := True;
VDir.AccessScript := True; //允许访问脚本
VDir.Path := strRealPath;
VDir.SetInfo;
except
Result := False;
end;
finally
WebSite := Unassigned;
WebServer := Unassigned;
WebRoot := Unassigned;
VDir := Unassigned;
end;
end;//三、删除一个虚拟目录:
function DeleteVirtualDir(strVirtualDir: string): Boolean;
var
WebSite, WebServer, WebRoot: Variant;
begin
Result := True;
try
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;
finally
WebSite := Unassigned;
WebServer := Unassigned;
WebRoot := Unassigned;
end;
end;end.