first import iis type library
then refer to my code below:
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Mask, ToolEdit, ComCtrls, Psock;
type
TfrmMain = class(TForm)
btnOk: TBitBtn;
btnCancel: TBitBtn;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
edComment: TEdit;
cbxIP: TComboBox;
edTCP: TEdit;
edPath: TDirectoryEdit;
ckStart: TCheckBox;
pgbStatus: TProgressBar;
Powersock1: TPowersock;
procedure btnokClick(Sender: TObject);
procedure btnCancelClick(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
frmMain: TfrmMain;
implementation
uses ActiveDs_TLB,IISExt_TLB;
{$R *.DFM}
function ADsGetObject;external 'activeds.dll' name 'ADsGetObject';
procedure TfrmMain.btnokClick(Sender: TObject);
var
I:IADsContainer;
ADs: IADs;
ServerObj:IADs;
begin
if edComment.Text ='' then
ShowMessage('Input Comment!')
else if cbxIP.Text ='' then
ShowMessage('Input IP Address!')
else if edTCP.Text ='' then
ShowMessage('Input TCP Port!')
else
begin
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
ServerObj :=IADs(I.Create('IIsWebServer', '10'));
//configure new server
ServerObj.Put ('ServerSize',1); // Medium-sized server
ServerObj.Put ('ServerComment',edComment.text);
ServerObj.put('ServerBindings',cbxIP.text+':'+edTCP.text+':');
// Write info back to Metabase
ServerObj.SetInfo;
pgbStatus.Position :=30;
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',edPath.Text);
ADs.put('AccessRead','True');
//ADs.put('AccessWrite','True');
ADs.put('AccessScript','True');
ADs.put('EnableDefaultDoc','True');
//ADs.put('EnableDirBrowsing','F');
//Write info back to Metabase
ADs.SetInfo;
(ADs as IISApp).AppCreate(true);
If ckStart.Checked = True Then
pgbStatus.Position :=60
else
pgbStatus.Position :=100;
end;
end;
//start the service
If ckStart.Checked = True Then
begin
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I))=S_Ok then
begin
ADs :=IADs(I.GetObject('IIsWebServer', '10'));
(ADs as IADsServiceOperations).start;
pgbStatus.Position :=100;
end;
end;
finally
screen.Cursor :=crdefault;
end;
end;
end;
procedure TfrmMain.btnCancelClick(Sender: TObject);
begin
close;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
cbxIP.Items.Add (Powersock1.LocalIP);
cbxIp.ItemIndex :=0;
end;
end.