如何用代码控制IIS？(100分)

比如建立一个WEB站点，指定虚拟目录以及权限等在建立WEB站点时所需要配置的一切；
IIS提供了编程接口吗？

ADSI 即 active directory service interface ,
微软的东东， 用来控制NT, IIS, EXCHANGER SERVER.
http://www.15seconds.com/
首先确认，API是绝对解决不了这些问题的，必须使用COM，使用ADSI接口。
在WinNT/System32下的adsiis.tlb是MS封装的ADSI公开接口，非常的全，也非常之庞大。你可
以使用它，也可以去这儿下载一个公开源码的ADSI COM控件。但是，它是C写的。
ftp://ftp.15seconds.com/990107.zip
打开990107.zip，用regsvr32.exe myadsi.dll注册这个控件。然后，你就可以开始用Delphi
干活儿了。

一、生成接口文件
------------------------------------------------------------------------
由于myADSI.dll不是OCX/EXE方式的ActiveX服务，所以，必须手工生成TLB接口文件。
运行/Delphi/BIN目录的TLIBImp.exe文件。如下：
tlibimp -L+ MyADSI.dll
// L+参数是生成能够在Delphi的IDE环境中使用的可视组件。可选。
// 如果你使用adsiis.tlb，也需要用tlibimp来生成接口文件。
这个控件的编写者有病，会将COM控件命名为Contorl，生成的Delphi类名叫TControl，与
Delphi自己的一个控件会冲突，所以你需要打开生成的myADSILib_TLB.pas文件，将所有的
TControl替换成TIISControl。就成了。——你也可以不替换，但出了问题可被怪我。

二、安装组件
------------------------------------------------------------------------
安装myADSILib_TLB.pas到组件板，与普通操作无二。不讲了。

三、编程
------------------------------------------------------------------------
太简单了。 ^-^。下面假设控件名：IISConfig
var selectDir : integer; //示例中用来控制创建的虚拟目录类型。
procedure TMainForm.Button1Click(Sender: TObject);
const //Permissions Const, From MSDN.
IISReadAccess = 1;
IISWriteAccess = 2;
IISExecuteAccess = 4; //(including ScriptAccess)
IISScriptAccess = 512;
var
VDirName : string;
begin
VDirName := Edit1.Text;
if (VDirName='') or (VDirName[1]='/') then
begin
showMessage('虚拟目录不能为空, 且第一个字符不能为''/''.'#$0D'请重新填写.');
exit;
end;

IISConfig.Site := 1; //如果IIS中有多个Web Site，这里可选。
IISConfig.Connect;
try
if BOOL(IISConfig.ExistsVDir(VDirName))
then showMessage('对不起, 该虚拟目录已经存在.'#$0D'不能创建虚拟目录.')
else
case selectDir of
1 : //普通目录
begin
IISConfig.Permissions := IISReadAccess;
if not BOOL(IISConfig.CreateVDir(WideString(PBF.Folder), WideString(VDirName))) then
showMessage('对不起, 未知情况导致虚拟目录不能成功创建.');
end;
2 : //脚本目录
begin
IISConfig.Permissions := IISExecuteAccess;
if not BOOL(IISConfig.CreateVDir(WideString(PBF.Folder), WideString(VDirName))) then
showMessage('对不起, 未知情况导致虚拟目录不能成功创建.');
end;
end;
finally
IISConfig.Disconnect;
end;
end;

就这样啦。不难的。
TIISControl主要有三个功能：CreateVDir(), ExistsVDir(), DeleteVDir()。
OnStartPage()和OnEndPage()两个功能我也没有太搞明白，好象是设置ASP的起始和结束页的。
Permissions设置的全部定义是：
{ //Define In MSDN
MD_ACCESS_READ 0x00000001 Allow read access.
MD_ACCESS_WRITE 0x00000002 Allow write access.
MD_ACCESS_EXECUTE 0x00000004 Allow file execution (includes script permission).
MD_ACCESS_SOURCE 0x00000010 Allow source access.
MD_ACCESS_SCRIPT 0x00000200 Allow script execution.
MD_ACCESS_NO_REMOTE_WRITE 0x00000400 Local write access only.
MD_ACCESS_NO_REMOTE_READ 0x00001000 Local read access only.
MD_ACCESS_NO_REMOTE_EXECUTE 0x00002000 Local execution only.
MD_ACCESS_NO_REMOTE_SCRIPT 0x00004000 Local host access only. }
但注意MyASDI中的Permissions是smallInt类型的。小有区别啦。 ^-^

四、其它
------------------------------------------------------------------------
如果你要发布软件的话，当然不能要用户自已去运行regsvr32.exe来注册MyADSI.dll了。
如果你不是使用专门的安装工具来做这件事的话，你可以用一段小程序来完成这件事。
type
TRegisterMode = (regRegister, regUnregister);
function OLERegisterDLLFile (strFileName : STRING; mode : TRegisterMode) : BOOLEAN;
type
TOleRegister = function : HResult;
var
hLib : THandle;
fnAdr: TFarProc;
begin
Result := FALSE;
hLib := LoadLibrary(PCHAR(strFileName));
if (hLib > 0) then
begin
try
if (mode = regRegister) then
fnAdr := GetProcAddress(hLib, pchar('DllRegisterServer'))
else
fnAdr := GetProcAddress(hLib, pchar('DllUnregisterServer'));
if (fnAdr <> nil) then
Result := (TOleRegister(fnAdr) >= 0);
finally
FreeLibrary(hLib);
end;
end;
end; { RegisterDLLFile }

OLERegisterDLLFile()函数可以加到TForm.onCreate和TForm.onClose事件中。即可以完成
自动注册和卸载。
好了。用Delphi简单吧？^-^

五、关于ASP
------------------------------------------------------------------------
需要的话，去查MSDN，关键字：“Virtual directories, creating”。也可以去MS的MSDN网
站，查“Create a Virtual Directory Automatically with ADSI”，就成了。

[yellow]???????????????????????????????????????[/yellow]

{ *********************************************************************** }
{ }
{ }
{ 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.

Richard3000:
能否将你的DFM也贴出来？

object IISConfigFrm: TIISConfigFrm
Left = 254
Top = 175
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Web伺服器設定'
ClientHeight = 256
ClientWidth = 516
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 4
Top = 20
Width = 28
Height = 13
AutoSize = False
Caption = '別名'
end
object Label2: TLabel
Left = 8
Top = 180
Width = 28
Height = 13
AutoSize = False
Caption = '路徑'
end
object lblPath: TLabel
Left = 11
Top = 218
Width = 365
Height = 13
AutoSize = False
Caption = 'D:/Develope/IIS'
end
object edtAlias: TEdit
Left = 40
Top = 16
Width = 145
Height = 21
TabOrder = 0
end
object dlbIIS: TDirectoryListBox
Left = 40
Top = 48
Width = 145
Height = 89
DirLabel = lblPath
ItemHeight = 16
TabOrder = 1
OnChange = dlbIISChange
end
object dcbIIS: TDriveComboBox
Left = 40
Top = 144
Width = 145
Height = 19
DirList = dlbIIS
TabOrder = 2
end
object edtPath: TEdit
Left = 40
Top = 176
Width = 465
Height = 21
ReadOnly = True
TabOrder = 3
end
object GroupBox1: TGroupBox
Left = 208
Top = 8
Width = 297
Height = 153
Caption = '允許下列權限：'
TabOrder = 4
object cbRead: TCheckBox
Left = 16
Top = 24
Width = 225
Height = 17
Caption = '讀取'
Checked = True
State = cbChecked
TabOrder = 0
end
object cbScript: TCheckBox
Left = 16
Top = 48
Width = 225
Height = 17
Caption = '執行指令檔(例如 ASP)'
Checked = True
State = cbChecked
TabOrder = 1
end
object cbExecute: TCheckBox
Left = 16
Top = 72
Width = 225
Height = 13
Caption = '執行(例如 ISAPI 應用程式或CGI)'
TabOrder = 2
end
object cbWrite: TCheckBox
Left = 16
Top = 96
Width = 225
Height = 17
Caption = '寫入'
TabOrder = 3
end
object cbBrowse: TCheckBox
Left = 16
Top = 120
Width = 225
Height = 17
Caption = '瀏覽'
TabOrder = 4
end
end
object bbtOK: TBitBtn
Left = 392
Top = 212
Width = 75
Height = 25
TabOrder = 5
OnClick = bbtOKClick
Kind = bkOK
end
end

look

Activeds_TLB,谢谢

好，已经倒出来了

可是如果仅仅只是需要 创建一个web站点，虚拟目录，这点功能。不用这么费劲吧。
直接用程序修改注册表就行了， 以前我就是这么做的。 具体位置我已经不记得在什么地方改。
不过 我可以告诉你一个方法： 现在iis里面进一个虚拟目录或者站点。 然后再注册表里面
搜索这个名字就知道要添加 修改再什么地方了。很简单。不用那么麻烦的 ：）

zhai_xin,Richard3000 你们两个也太体贴了，为什么我的问题碰不到你们这样的人回答呢？

to:delp
我看看的問題

procedure TForm1.CfgIIS;
var
WebSite, WebServer, WebRoot, VDir: OleVariant;
begin
try
WebSite := CreateOleObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', edit6.text+'/w3svc');
Label18.Caption:='P';
try
WebSite.delete('IIsWebServer','911');
except
end;

WebServer:=WebSite.create('IIsWebServer','911');
WebServer.ServerComment:='中小学教育资源库';
WebServer.Serverbindings:=':'+edit12.Text+':';
WebServer.defaultDoc:='default.asp';
WebServer.AccessScript := True;
WebServer.AccessExecute :=true;
WebServer.AccessRead:= True;
WebServer.SetInfo;
Label19.Caption:='P';
WebServer := WebSite.GetObject('IIsWebServer', '911');
VDir := WebServer.Create('IIsWebVirtualDir', 'root');
VDir.AccessRead := True;
VDir.Path := reg.ReadString('webpath');
VDir.AccessScript := True;
VDir.AccessExecute :=true;
VDir.AccessRead:= True;
VDir.SetInfo;

VDir := WebServer.Create('IIsWebVirtualDir', 'root/resource');
VDir.AccessRead := True;
VDir.Path := edit8.Text;
VDir.AccessScript := True;
VDir.AccessExecute :=true;
VDir.AccessRead:= True;
VDir.SetInfo;

VDir := WebServer.Create('IIsWebVirtualDir', 'root/data');
VDir.AccessRead := True;
VDir.Path := edit9.Text;
VDir.AccessScript := True;
VDir.AccessExecute :=true;
VDir.AccessRead:= True;
VDir.SetInfo;

Label20.Caption:='P';
WebServer.Start;
Label21.Caption:='P';
reg.WriteString('httpip',edit6.Text);
reg.WriteString('httpport',edit12.Text);
Label17.Show;
except
Application.MessageBox('Web服务器配置失败！','错误',MB_OK);
end;
end;

真精彩！

太经典了。
不知道谁能提供代码和那个与众不同的DLL以及DEPHI编译出来的本程序的DLL
Email:bamfk1023@163.com
谢谢大家！！！

再有：如果用相同的方法在DNS域名服务管理器里面增加一个正向解释和反向解释。
在线等。

tooper:
上面的代码是可以的，不过有两个选项不太对。
1、少了把新的WEB站点绑定到一个IP地址的参数。
2、少了把新的WEB站点的主机头名的定义的参数.

还有一个启动的时候有一个
"不支持网络请求" 的错误。不知道是什么错误。