使用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.