在Delphi中用ADSI创建IIS的虚拟目录

来源:岁月联盟 编辑:exp 时间:2009-05-06

先引入类型库(Project|Import Type Library)adsiis.dll、iisext.dll和activeds.tlb
新建一个单元,声明
unit ActiveDs;
interface
  function ADsGetObject(const PathName: WideString; const GUID: TGUID; out I: IUnknown): HRESULT; stdcall;
implementation
  function ADsGetObject;              external activeds.dll name ADsGetObject;
end.

方法一(参照C++)、
var
  I: IADsContainer;
  ADs: IADs;
begin
  if ADsGetObject(IIS://localhost/w3svc, IID_IADsContainer, IUnknown(I)) = S_Ok then
  begin
    ADs := IADs(I.GetObject(IIsWebServer, 1));
    ShowMessage(ADs.ADsPath);
    if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
    begin
      ADs := IADs(I.GetObject(IIsWebVirtualDir, Root));
      ShowMessage(ADs.ADsPath);
      if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
      begin
        ADs := IADs(I.Create(IIsWebVirtualDir, DelphiTest));
        ADs.Put(AccessRead, True);
        ADs.Put(Path, c:Temp);
        ADs.SetInfo;
      end;
    end;
  end;
end;

方法二(使用接口)、
procedure TForm3.BitBtn4Click(Sender: TObject);
var
  Disp: IDispatch;
begin
  Disp := IISNamespace1.GetObject(IIsWebService, localhost/w3svc);
  Disp := (Disp as IADsContainer).GetObject(IIsWebServer, 1);
  Disp := (Disp as IADsContainer).GetObject(IIsWebVirtualDir, Root);
  Disp := (Disp as IADsContainer).Create(IIsWebVirtualDir, DelphiADSITest);
  (Disp as IADs).Put(AccessRead, True);
  (Disp as IADs).Put(Path, c:ADSITest);
  (Disp as IADs).SetInfo;
end;

方法三(使用Variant,就是类似VB和ASP的方法)、
procedure TForm2.BitBtn1Click(Sender: TObject);
var
  WebSite, WebServer, WebRoot, VDir: Variant;
begin
  WebSite := CreateOleObject(IISNamespace);
  WebSite := WebSite.GetObject(IIsWebService, localhost/w3svc);
  WebServer := WebSite.GetObject(IIsWebServer, 1);
  WebRoot := WebServer.GetObject(IIsWebVirtualDir, Root);
  VDir := WebRoot.Create(IIsWebVirtualDir, VariantTest);
  VDir.AccessRead := True;
  VDir.Path := C:Test;
  VDir.SetInfo;
end;

图片内容