用程序对IIS的虚拟目录进行管理

Question

一、判断一个虚拟目录是否存在：
    Function VirtualDirIsExist(strVirtualDir: String): Boolean
二、新建一个虚拟目录：
    Function CreateVirtualDir(strVirtualDir, strRealPath: String): Boolean
三、删除一个虚拟目录：
    Function DeleteVirtualDir(strVirtualDir: String): Boolean即把手工管理IIS的虚拟目录用程序来实现。
操作系统：WIN2K SERVER  或者 WIN2K ADNVANCED SERVER
谢谢。

Answer 1

我转贴段代码，你自己分析 自己写函数吧用ADSI创建IIS的虚拟目录
  作者: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. 

Answer 2

请关注：
http://expert.csdn.net/Expert/topic/2051/2051413.xml?temp=.5383722
有分送还有好东东拿。

Answer 3

'其实我有VB的代码，但就是改不好：
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

Answer 4

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.