如何判断系统是否已经安装IIS?给60分!(200分)

  • 主题发起人 主题发起人 skimwater
  • 开始时间 开始时间
S

skimwater

Unregistered / Unconfirmed
GUEST, unregistred user!
我要在程序里访问IIS,在访问之前,我怎样判断IIS是否已经安装?
 
对啊!
如果想在程序里面建立一个WebServer,用程序可以实现吗?
 
在程序里建立WEBSERVER我已经实现了!
 
怎么实现的,能否告诉我一下?
拜托啦!
我的email: EddyCao@263.net
 
server := getOleObject('iis://....');
if varIsNull(server) then begin
// server is down or not installed.
end;
 
具体应该怎么写呢?
 
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.

 
我以前是取注册表,不知道有没有不灵的时候?
 
不会是想做“红色代码”吧!呵呵!
 
说到红色代码,我想到也许可以这样:
本机扫描一下本机80端口有没有开,有的话,再通过返回信息判断是否IIS服务器......
嗬嗬,比较另类的思路^_^
 
我也想知道
 
接受答案了.
 

Similar threads

回复
0
查看
832
不得闲
D
回复
0
查看
891
DelphiTeacher的专栏
D
D
回复
0
查看
859
DelphiTeacher的专栏
D
D
回复
0
查看
808
DelphiTeacher的专栏
D
后退
顶部