ADSI, IIS, AdsGetObject and Delphi

hi,
this is some stuff i found,
you need to import the type library activeds.tlb then you can do something like:


uses activex,comobj,ActiveDs_TLB;
 
 
          function GetObject (const Name : string): IDispatch;
          var
            Moniker : IMoniker;
            Eaten : integer;
            BindContext : IBindCtx;
            Dispatch : IDispatch;
          begin
            OleCheck( CreateBindCtx( 0, BindContext ) );
            OleCheck( MkParseDisplayName( BindContext, PWideChar(  WideString( Name ) ), Eaten, Moniker ) );
            OleCheck( Moniker.BindToObject( BindContext, NIL, IDispatch,  Dispatch ) );
            Result := Dispatch;
          end;


procedure TForm1.Button1Click(Sender: TObject);
var
Usr: IADsUser;
l:longint;
Grp: IAdsGroup;
lst: IEnumVariant;
o:olevariant;
begin
Usr := GetObject( 'WinNT://' + ComboBox1.text + '/'  + Edit1.Text + ',user' )as IADsUser;
memo1.lines.add( 'User: ' +  Usr.FullName);
Lst := usr.Groups._newenum as IEnumVariant;
while  Lst.next(1,o,@l) 0 do begin
grp:=IUnknown(o) as IAdsGroup;
if l = 1 then begin
memo1.lines.add( 'Member of ' + o.name + ' groups');
// just for test in variant format
memo1.lines.add('Member of ' + grp.name + ' groups');
 end
else
memo1.lines.add( 'Err');
 end;
end;

Regards Barry

just in case you havent done it before
to import a type library go to delphi's menu and do project - "import type library",this will create a file called ActiveDs_TLB.pas ..

Usr := GetObject( 'WinNT://' + ComboBox1.text + '/'  + Edit1.Text + ',user' )as IADsUser;

I have replaced ComboBox1.text with 'localhost' and with my machine name. Either way the Getobject line just freezes the process.

Also with Lst.next(1,o,@l)

I have had to redefine l as a longword and change @l to l to get it to compile. The 3rd param is defined as out.

Getting close - it no longer fails.

But I still cannot do anything with the object e.g. the VB code

    Max = 0
    For Each webServer In w3svc
        If webServer.Class = "IIsWebServer" Then
            Max = webServer.Name
        End If
    Next

Relies on somehow using w3svc (which = webservice in your code) as a variant array of some form.

Summary - I have an object, but cannot use it to do anything.

Could <b>inthe</b> please answer this question again to get your points.

Spent several hours and managed to work around the rest my self.

Still cannot enumerate through the list but can do everything I need to do.

Thanks....

These are not perfect, but do a fair bit of useful stuff
----------
interface

function ADsGetObject(lpszPathName: PWideChar; const riid: TIID;   out obj): HResult; stdcall;
function hhGetObject(Id:PWideChar):variant;
function hhGetTopServerId(const w3svc:variant):integer;
function hhMakeWebServer(const w3svc:variant;
                         const IPAddress:string='';
                         const IPPort:integer=80;
                         const Description:string='New Web Site'):variant;
function hhMakeVirtualDirectory(const webserver:variant;
                                const Path:string; //**
                                const HomeDirectory:string; //**
                                const DefaultDocument:string='default.htm'; //**
                                const EnableDefaultDocument:boolean=TRUE;
                                const ReadPermission:boolean=FALSE;
                                const WritePermission:boolean=FALSE;
                                const DirectoryBRowsing:boolean=FALSE;
                                const ExecutePermission:boolean=FALSE):variant;

implementation

function ADsGetObject;  external 'activeds.dll';
function hhGetObject(Id:PWideChar):variant;
begin
  if ADsGetObject(Id, IDispatch, TVarData(result).VDispatch) = S_OK then
    TVarData(result).vType := varDispatch
  else
    Result:= Unassigned;
end;

function hhGetTopServerId(const w3svc:variant):integer;
var
  I:integer;
  ws:variant;
begin
  if not varisempty(w3svc) then
  begin
    Result:=-1;
    i:=0;
    repeat
      try
        inc(i);
        ws:=w3svc.GetObject('IIsWebServer', i);
      except on e:exception do
        Result:=i-1;
      end;
    until Result<>-1;
  end
  else
    Result:=-1;
end;

function hhMakeWebServer(const w3svc:variant;
                         const IPAddress:string='';
                         const IPPort:integer=80;
                         const Description:string='New Web Site'):variant;
var
  NewId:integer;
begin
  if not VarIsEmpty(w3svc) then
  begin
    NewId:=hhGetTopServerId(w3svc)+1;
    result:=w3svc.Create('IIsWebServer',NewId);
    result.ServerComment:=Description;
    result.ServerBindings:=VarArrayOf([IPADdress+':'+inttostr(IPPort)+':']);
    result.Keytype:='IIsWebServer';
    result.setinfo;
  end
  else
    result := Unassigned;
end;

function hhMakeVirtualDirectory(const webserver:variant;
                                const Path:string; //**
                                const HomeDirectory:string; //**
                                const DefaultDocument:string='default.htm'; //**
                                const EnableDefaultDocument:boolean=TRUE;
                                const ReadPermission:boolean=FALSE;
                                const WritePermission:boolean=FALSE;
                                const DirectoryBRowsing:boolean=FALSE;
                                const ExecutePermission:boolean=FALSE):variant;
begin
  if not VarIsEmpty(WebServer) then
  begin
    Result:=WebServer.Create('IIsWebVirtualDir',Path);
    Result.Path := HomeDirectory;
    Result.DefaultDoc := DefaultDocument;
    Result.EnableDefaultDoc := EnableDefaultDocument;
    Result.EnableDirBrowsing := DirectoryBrowsing;
    Result.AccessExecute := ExecutePermission;
    Result.AccessRead := ReadPermission;
    Result.AccessWrite := WritePermission;
    Result.AccessSource := FALSE;
    Result.SetInfo;
  end
  else
    Result:=UnAssigned;
end;

------------

-- EXAMPLE CALLS --
var
  w3svc,WebServer,RootDir,ScriptDir:variant;
begin
  w3svc:=hhGetObject('IIS://LocalHost/W3SVC');
  if not VarIsEmpty(w3svc) then
  begin
    WebServer:=hhMakeWebServer(w3svc,'192.168.10.1',80,'Web Web Site');
    RootDir:=hhMakeVirtualDirectory(WebServer,'ROOT','C:\INETPUB\WWW','index.html',TRUE,TRUE,FALSE,FALSE,FALSE);
    ScriptDir:=hhMakeVirtualDirectory(RootDir,'Scripts','C:\INETPUB\IMAGES','',FALSE,FALSE,FALSE,FALSE,TRUE);
    WebServer.Start;
  end
  else
    ShowMEssage('Failed');
end;

-- USEFUL URL --

MSDN Documentation on IIS ADSI ..
http://msdn.microsoft.com/isapi/msdnlib.idc?theURL=/library/psdk/iisref/adsi57hv.htm

WOW THANKS :-)

sorry I couldnt helped much more
thank you for the good advice

Regards Barry