Mega Code Archive
Reading the IIS Meta Base
<![CDATA[
Title: Reading the IIS Meta Base
Question: In this article I am going to show you how to how to access to IIS Meta Base (in read-only
mode). You can simply take this further to use the techniques shown here for administrative
purposes. The IIS Meta Base is used to install web, ftp and gopher sites on your MS Windows
server. This feature may be interesting for your installer applications.
You need MS Windows 2000 with IIS or MS Windows NT 4 SP 6a with IIS installed.
Answer:
IN THE BEGINNING
================
Many of you develop, just as I do, Internet server applications. After weeks of planning and testing your applications you are ready to deploy it. Now you have to write a detailed explaination of how to install and administrate your application. At this point this article will give you a little head start. Windows has the Registry, which is a great tool for administrating many aspects of the computer, however, not all aspects are administratable through the Registry.
The IIS has to be administrated through the IIS Metabase. In your {system32}\inetsrv\iisadmin folder there are many ASP examples on how to access the IIS Metabase, however, these are not easily taken to Delphi. Starting with the GetObject function, that does not exist in Delphi, going to enumarations and so on.
VB SCRIPTS GetObject
====================
Scanning through the ASP files in the IISAdmin folder you will hit the GetObject function quite a few times. The GetObject will return the interface to an object already loaded into the computers memory. The object is named by a string similar to 'IIS://localhost'. GetObject will allow you to get access to objects running on other computers, too. In one of the D3K articles I have found a method that will compromise for this VB Script function. I have named the function VBGetObject, because as a function with this name already exists in Delphi.
function VBGetObject(const Name: string): IDispatch;
var
BindContext: IBindCtx;
Moniker: IMoniker;
Eaten: Integer;
begin
OleCheck(CreateBindCtx(0, BindContext));
OleCheck(MkParseDisplayName(
BindContext, PWideChar(WideString(Name)), Eaten, Moniker
));
OleCheck(Moniker.BindToObject(BindContext, nil, IDispatch, Result));
end;
ENUMERATIONS (COLLECTIONS) IN DELPHI
====================================
VBScript has the nice construct for each ... in ..., a simple and fast way to access all objects (items) in an list ("array") of those. There is no similar construct in Delphi to use, well you want need it anyway, we'll work around it. :)
Usually all enumerations have a count property and an items property as well, however Micrsoft decided to NOT implement these in these ADSI classes properly. Therefore, we cannot us them in an for I := 0 to Pred(Count) do type of construction. We rather have to access the enumeration object and simulate the for...each loop ourselves.
procedure DoEnum(Cont: IADsContainer [...] );
var
I: Cardinal;
Enum: IEnumVariant;
rgvar: OleVariant;
[...]
begin
try
// get a hold on the variant collection
Enum := Cont._NewEnum as IEnumVariant;
Enum.Reset;
Enum.Next(1, rgvar, I);
// enumerate the variant collection
while I 0 do
begin
[...]
Enum.Next(1, rgvar, I);
end;
except
end;
end;
The function above is taken from the source below with a few parts omitted to show the basic idea of enumerations. First we get the Enumeration object and cast it as IEnumVariant, the default VB Script enumeration type. Next, we reset the enumeration, just in case and then we get the first item for the enumeration. We loop through the enumeration until no item is returned anymore. That's all.
CREATING THE APPLICATION
========================
Start Delphi and create a new application (in case another is still open). The following code will assume a few component names, please add them accordingly:
your main form: NAME=frmMain
TTreeView: NAME=trvMBStructure ALIGN=alLeft
TListView: NAME=lstMBItems ALIGN=alClient VIEWSTYLE=vsReport, add three Columns to the list CAPTIONS=(Property,Type,Value)
TStatusBar: NAME=sttInfo SIMPLEPANEL=True
Save the Unit1 as uMainForm.pas.
Next go to the menu "Project|Import Type Library...". (NOTE: This step may not work on Delphi 6 properly - sorry, you will have to wait for the first service pack. :( ) Click the "Add.." button and select the "activeds.tlb" from your "Winnt\System32" directory. Select a unit directory and click the "Create Unit" button. The file "ActiveDs_TLB.pas" will be created.
Next paste the code from below and run your application. I hope the comments will give you all information you need.
Good Luck,
Daniel
THE CODE
========
unit uMainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, ActiveDs_TLB, Contnrs;
type
TADsContainer = class
private
FIntf: IADsContainer;
FPath: String;
FProperties: TStringList;
function GetADsClass: IADsClass;
procedure LoadProperties;
protected
public
constructor Create(aIntf: IADsContainer);
destructor Destroy; override;
property Path: String read FPath;
property Intf: IADsContainer read FIntf;
property ADsClass: IADsClass read GetADsClass;
property Properties: TStringList read FProperties;
end;
TfrmMain = class(TForm)
trvMBStructure: TTreeView;
splDummy: TSplitter;
lstMBItems: TListView;
sttInfo: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure trvMBStructureChange(Sender: TObject; Node: TTreeNode);
private
FADsContainer: TObjectList;
procedure EnumIISMetaBase;
procedure ShowItemInfo(ADsContainer: TADsContainer);
public
end;
var
frmMain: TfrmMain;
implementation
uses
ActiveX, ComObj;
{$R *.DFM}
// simulates VB Scripts GetObject - a method to get an instance to an already
// loaded object in memory
function VBGetObject(const Name: string): IDispatch;
var
BindContext: IBindCtx;
Moniker: IMoniker;
Eaten: Integer;
begin
OleCheck(CreateBindCtx(0, BindContext));
OleCheck(MkParseDisplayName(
BindContext, PWideChar(WideString(Name)), Eaten, Moniker
));
OleCheck(Moniker.BindToObject(BindContext, nil, IDispatch, Result));
end;
{ TADsContainer }
constructor TADsContainer.Create(aIntf: IADsContainer);
begin
inherited Create;
FIntf := aIntf;
FProperties := TStringList.Create;
FPath := IADsSyntaxDisp(FIntf).ADsPath;
LoadProperties;
end;
destructor TADsContainer.Destroy;
begin
FreeAndNil(FProperties);
FIntf := nil;
inherited Destroy;
end;
function TADsContainer.GetADsClass: IADsClass;
begin
Result := VBGetObject(IADsODisp(FIntf).Schema) as IADsClass;
end;
procedure TADsContainer.LoadProperties;
var
I: Integer;
Props: OleVariant;
begin
// iis objects can have mandatory and optional properties
// the must be loaded seperately
// the IADS objects will return a safe-array if there are more than one
// properties, a OleString will be returned if there is just one property
FProperties.Clear;
// load mandatory properties
Props := ADsClass.MandatoryProperties;
if VarType(Props) and varArray = varArray then
for I := VarArrayLowBound(Props, 1) to VarArrayHighBound(Props, 1)
do
FProperties.Add(Props[I])
else
FProperties.Add(Props);
// load optional properties
Props := ADsClass.OptionalProperties;
if VarType(Props) and varArray = varArray then
for I := VarArrayLowBound(Props, 1) to VarArrayHighBound(Props, 1)
do
FProperties.Add(Props[I])
else
FProperties.Add(Props);
end;
{ TfrmMain }
procedure TfrmMain.EnumIISMetaBase;
procedure DoEnum(Cont: IADsContainer; Parent: TTreeNode; Path: String);
var
I: Cardinal;
Enum: IEnumVariant;
rgvar: OleVariant;
Node: TTreeNode;
ADsContainer: TADsContainer;
begin
try
// get a hold on the variant collection
Enum := Cont._NewEnum as IEnumVariant;
Enum.Reset;
Enum.Next(1, rgvar, I);
// enumerate the variant collection
while I 0 do
begin
// create a tree node for every item in the collection
Node := trvMBStructure.Items.AddChild(Parent, rgvar.Name);
ADsContainer := TADsContainer.Create(IDispatch(rgvar) as IADsContainer);
FADsContainer.Add(ADsContainer);
Node.Data := ADsContainer;
// enumerate sub-items
DoEnum(ADsContainer.Intf, Node, ADsContainer.Path);
Enum.Next(1, rgvar, I);
end;
except
end;
end;
var
Root: String;
begin
trvMBStructure.Items.BeginUpdate;
try
// clear previous
trvMBStructure.Items.Clear;
FADsContainer.Clear;
// you could enumerate other objects, like LDAP, too
Root := 'IIS://LocalHost';
DoEnum(VBGetObject(Root) as IADsContainer, nil, Root);
finally
trvMBStructure.Items.EndUpdate;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FADsContainer := TObjectList.Create;
// load the iis meta base
EnumIISMetaBase;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FreeAndNil(FADsContainer);
end;
procedure TfrmMain.ShowItemInfo(ADsContainer: TADsContainer);
var
I: Integer;
PropName: String;
LI: TListItem;
begin
lstMBItems.Items.BeginUpdate;
try
lstMBItems.Items.Clear;
if ADsContainer nil then
begin
// show current iis path
sttInfo.SimpleText := ADsContainer.Path;
// iterate all properties, skip the first ('')
for I := 1 to Pred(ADsContainer.Properties.Count) do
begin
LI := lstMBItems.Items.Add;
// get the property name
PropName := ADsContainer.Properties.Strings[I];
// load property name
LI.Caption := PropName;
// get property type
LI.SubItems.Add('0x' + IntToHex(VarType(
IADsDisp(ADsContainer.Intf).Get(PropName)
), 8));
// get property value
case VarType(IADsDisp(ADsContainer.Intf).Get(PropName)) of
varEmpty:
LI.SubItems.Add('(value is empty)');
varNull:
LI.SubItems.Add('(value is null)');
varSmallint, varInteger, varSingle, varDouble, varCurrency,
varDate, varOleStr, varBoolean:
LI.SubItems.Add(IADsDisp(ADsContainer.Intf).Get(PropName));
else
LI.SubItems.Add('(data type not handled)');
end;
end;
end else begin
sttInfo.SimpleText := '';
end;
finally
lstMBItems.Items.EndUpdate;
end;
end;
procedure TfrmMain.trvMBStructureChange(Sender: TObject; Node: TTreeNode);
begin
if Node = nil then
ShowItemInfo(nil)
else
ShowItemInfo(TADsContainer(Node.Data));
end;
end.
]]>