使用Delphi创建IIS虚拟目录的方法

  想把自己的东西整理出来已经很久了,可是一直没有时间,自己的水平又太差,也怕耽误别人的时间,所以至今没写出任何东西出来。可是每次看到别人的文章心里也痒痒,于是找来自发表过的一个帖子,以回馈大家。
  { ****************** }
  { }
  { }
  { zhao zhenhua }
  { }
  { Copyright zhao zhenhua email:zhao-zhenhua@163.net }
  { }
  { ****************** }
  unit MainUnt;
  interface
  uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, Buttons,Activeds_TLB;
  type
  TIISConfigFrm = class(TForm)
  edtAlias: TEdit;
  Label1: TLabel;
  dlbIIS: TDirectoryListBox;
  dcbIIS: TDriveComboBox;
  Label2: TLabel;
  edtPath: TEdit;
  GroupBox1: TGroupBox;
  cbRead: TCheckBox;
  cbScript: TCheckBox;
  cbExecute: TCheckBox;
  cbWrite: TCheckBox;
  cbBrowse: TCheckBox;
  bbtOK: TBitBtn;
  lblPath: TLabel;
  procedure dlbIISChange(Sender: TObject);
  procedure bbtOKClick(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  private
  { Private declarations }
  public
  { Public declarations }
  end;
  function ADsGetObject(const PathName: WideString; const GUID:TGUID; out I: IUnknown): HRESULT; stdcall;
  var
  IISConfigFrm: TIISConfigFrm;
  implementation
  {$R *.dfm}
  function ADsGetObject;external 'ActiveDS.dll' name 'ADsGetObject';
  procedure TIISConfigFrm.dlbIISChange(Sender: TObject);
  begin
  edtPath.Text:=dlbIIS.Directory;
  end;
  procedure TIISConfigFrm.bbtOKClick(Sender: TObject);
  var
  I: IADsContainer;
  ADs: IADs;
  begin
  if Length(Trim(edtAlias.Text))=0 then begin
  Application.MessageBox('别名不可以为空!','警告');
  Exit;
  end;
  if Length(Trim(edtPath.Text))=0 then begin
  Application.MessageBox('请选定虚拟目录位置!','警告');
  Exit;
  end;
  if ADsGetObject('IIS://localhost', IID_IADsContainer, IUnknown(I)) = S_Ok then begin //IIS已经安装
  if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then begin //Web服务器存在
  ADs := IADs(I.GetObject('IIsWebServer', '1')); //取得服务
  if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then begin //服务支持
  ADs := IADs(I.GetObject('IIsWebVirtualDir', 'Root')); //在Web服务器的Root下建立虚拟目录
  if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then begin //服务支持
  try
  ADs := IADs(I.Create('IIsWebVirtualDir', edtAlias.Text)); //建立虚拟目录,别名为edtAlias.Text
  except
  Application.MessageBox('这个别名已经存在,请选择另外的别名!','警告');
  Exit;
  end; //try except
  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);//允许打开默认文件
  ADs.SetInfo; //保存参数
  Application.MessageBox('您的设定已经保存。','恭喜');
  end;
  end;
  end;
  end else
  Application.MessageBox('您的计算机上没有安装IIS或者您无权访问IIS。','警告');
  end;
  procedure TIISConfigFrm.FormCreate(Sender: TObject);
  begin
  edtPath.Text:=dlbIIS.Directory;
  end;
  end.