请问 Delphi中如何创建IIS的Web站点 (300分)

请问 Delphi中如何创建IIS的Web站点，有谁知道请帖出代码，我在网上找了几天了，只有建立虚拟目录的代码。谢谢

回答正确者，600分

去MSDN找过没？

找过了，但是因为本人E文特烂，看不懂

你可以试试以下的代码：
先引入类型库(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;

随风而逝:你提供的代码是创建虚拟目录的，网上到处都是。谢谢

只知道手工创建，如何编程实现？如FontPage就可以在后台直接实现。
该问题好，值得收藏！

华旗的产品－爱国者MP3很烂，才用20天，耳机就脱胶，还说是外伤，不给任何维修等，哪个龟儿子再买爱国者MP3，甚至华旗的东西

如果不属实，天洙地灭

我2002年11月买的64M爱国者优盘，使用3个月后，整个颜色就磨没有了，难看极了，而且盖子变得奇松，经常是放在口袋中都会自己脱盖。

如果不属实，天洙地灭

去创建　websnap 　APPLICATION　　　　来建立！　　详细说明，在书一有，

（你不会让我为了你这点分，　去把书打一遍给你吧）　[]太没人性了

yjwnnit:能稍微说详细点吗？在什么书里有啊？

在51Delphi网站有源程序可下载，
你去试试， 如还问题可与我联系，
e-mail:fhptfjy@mail.nbptt.zj.cn

ptfjy,能说详细点吗？我找了一圈，没找到

在csdn上文档搜索栏搜索有这方面的文章

pjp2000delphi, 我只发现有创建虚拟目录的文章，如果你找到了，能帖出来吗？或者把地址帖出来，谢谢。

估计应该写注册表

呵呵，猜的

coolingxyz,我可以告诉你，绝对不是写注册表。

unit p_iis;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, p_tabenter;

type
TFRM_IIS = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
EDCOMMENT: TEdit;
EDIPADDRESS: TEdit;
EDCOMMENTPATH: TEdit;
EDWEBNUM: TEdit;
Button1: TButton;
Button2: TButton;
cbstartiis: TCheckBox;
edport: TEdit;
Label5: TLabel;
kEnterAsTab1: TkEnterAsTab;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);
private
{ Private declarations }
function CheckInput: Boolean;
function ConfigWebServer: Boolean;
function ConfigWebVirtualCGIBIN: Boolean;
public
{ Public declarations }
end;
function ADsGetObject(const PathName: WideString; const GUID:
TGUID; out I: IUnknown): HRESULT; stdcall;

var
FRM_IIS: TFRM_IIS;

implementation

uses ActiveDs_TLB, IISExt_TLB, p_setupdata;

{$R *.dfm}

function ADsGetObject; external 'activeds.dll' name 'ADsGetObject';
//创建IIS站点
function Tfrm_iis.ConfigWebServer: Boolean;
var
I: IADsContainer;
ADs: IADs;
ServerObj: IADs;
begin
try
try
screen.Cursor := crHourGlass;
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
//create a new virtual server at the service，数字2是站点号，1是默认的WEB站点，你可以改成其他的，如8，9等
ServerObj := IADs(I.Create('IIsWebServer', edwebnum.text));
//configure new server
ServerObj.Put('ServerSize', 1); // Medium-sized server
ServerObj.Put('ServerComment', edComment.text);
ServerObj.put('ServerBindings', edIPAddress.text + ':' + edPort.text + ':');
// Write info back to Metabase，80是端口号
// ServerObj.put('ServerBindings', ':80:');
ServerObj.SetInfo;
if ServerObj.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
//create virtual root directory
ADs := IADs(I.Create('IIsWebVirtualDir', 'Root'));
//Configure new virtual root
ADs.put('Path', edCommentPath.Text); //站点路径
ADs.put('AccessRead', 'True'); //存取权限设置，这里是设置读权限，具体的资料你可以看MSDN
//ADs.put('AccessWrite','True');
ADs.put('AccessScript', 'True'); //设置脚本权限
ADs.put('EnableDefaultDoc', 'True'); //设置允许默认文档
//Configure Default Document as "index.asp"
ADs.put('DefaultDoc', 'default.htm'); //将默认文档设置为"index.asp",你可以设置成自己需要的
//ADs.put('EnableDirBrowsing','F');
//Write info back to Metabase
ADs.SetInfo;
(ADs as IISApp).AppCreate(true);
end;
end;
if cbStartIIS.Checked = True then //create and start the web
begin
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
ADs := IADs(I.GetObject('IIsWebServer', edwebnum.text));
(ADs as IADsServiceOperations).start;
end;
end;
//start the service

finally
screen.Cursor := crdefault;
end;
Result := true;
except
Result := false;
end; // try/except
end;

上面的代码因该没有问题的.如果有问题在问我吧.
别忘了600分哦

lzhuan,真是太感谢你了，另外
//create a new virtual server at the service，数字2是站点号，1是默认的WEB站点，你可以改成其他的，如8，9等
ServerObj := IADs(I.Create('IIsWebServer', edwebnum.text));

站点号可以随便写吗？需要什么规则吗？

另外300分在http://www.delphibbs.com/delphibbs/dispq.asp?lid=2138822

接受答案了.