使用Delphi創建IIS虛擬目錄

　　想把自己的東西整理出來已經很久了，可是一直沒有時間，自己的水平又太差，也怕耽誤別人的時間，所以至今沒寫出任何東西出來。可是每次看到別人的文章心裡也癢癢，於是找來自己在www.Delphibbs.com上發表過的一個帖子，以回饋大家。

　　{ *********************************************************************** }
　　{                                                                                                                              }
　　{                                                                                                                              }
　　{                    zhao zhenhua                                                                                       }
　　{                                                                                                                              }
　　{ Copyright zhao zhenhua           email:[email protected]                                       }
　　{                                                                                                                              }
　　{ *********************************************************************** }
　　
　　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.