ADSI, IIS, AdsGetObject and Delphi

I need to programmatically add and/or edit IIS 4/5 virtual servers and directories. In VB this is straightforward with the GetObject routine.

I need to work out how to (in Delphi code - not by exec or stuff) do this.

So far I have found the relevant routine
function ADsGetObject(lpszPathName : PWideChar; riid : TGuid;    out ppObject) : HRESULT; stdcall;

I need to know how to get to use this to return an object which I can actually use as the VB Getobject routine does.

Double points for a complete working segment of code that creates a complete virtual site.
craznarAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

intheCommented:
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
0
intheCommented:
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 ..
0
intheCommented:
0
Angular Fundamentals

Learn the fundamentals of Angular 2, a JavaScript framework for developing dynamic single page applications.

craznarAuthor Commented:
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.

0
intheCommented:
ok some more(untested)that may help using the ADsGetObject function straight from the dll:

function ADsGetObject(lpszPathName: PWideChar; const riid: TIID;   out obj): HResult; stdcall; external 'activeds.dll';


And "out" parameter is similar to a "var" parameter. When you declare a parameter as "out", COM doesn't care about the value that was already in the varaible. You can find more information about this in the Delphi help.
TIID is declared in the ActiveX unit as a TGUID.
 
 
Here's how to get the IIS web service object into a variant:
 
var
  WebService: Variant;
begin
  if ADsGetObject('IIS://LocalHost/W3SVC', IDispatch,
    TVarData(WebService).VDispatch) = S_OK then
      TVarData(WebService).vType := varDispatch
  else
    WebService := Unassigned;
end;
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
craznarAuthor Commented:
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.
0
craznarAuthor Commented:
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....
0
craznarAuthor Commented:

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;

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

0
craznarAuthor Commented:
-- 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;
0
craznarAuthor Commented:
0
intheCommented:
WOW THANKS :-)

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

Regards Barry
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.