Reading the IIS Meta Base

Problem/Question/Abstract:

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.

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.