Delphi中用Adsi创建IIS虚拟目录

先引入类型库(Project|Import Type Library)adsiisdlliisextdll和activedstlb新建一个单元声明

unit ActiveDs;

interface

function ADsGetObject(const PathName: WideString; const GUID: TGUID;

out I: IUnknown): HRESULT;

stdcall;

implementation

function ADsGetObject;

external activedsdll name ADsGetObject;

end;

方法一(参照C++)

var

I: IADsContainer;

ADs: IADs;

begin

if ADsGetObject(IIS://localhost/wsvc IID_IADsContainer IUnknown(I)) = S_Ok then

begin

ADs := IADs(IGetObject(IIsWebServer ));

ShowMessage(ADsADsPath);

if ADsQueryInterface(IID_IADsContainer I) = S_OK then

begin

ADs := IADs(IGetObject(IIsWebVirtualDir Root));

ShowMessage(ADsADsPath);

if ADsQueryInterface(IID_IADsContainer I) = S_OK then

begin

ADs := IADs(ICreate(IIsWebVirtualDir DelphiTest));

ADsPut(AccessRead True);

ADsPut(Path c:\Temp);

ADsSetInfo;

end;

end;

end;

end;

方法二(使用接口)

procedure TFormBitBtnClick(Sender: TObject);

var

Disp: IDispatch;

begin

Disp := IISNamespaceGetObject(IIsWebService localhost/wsvc);

Disp := (Disp as IADsContainer)GetObject(IIsWebServer );

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 TFormBitBtnClick(Sender: TObject);

var

WebSite WebServer WebRoot VDir: Variant;

begin

WebSite := CreateOleObject(IISNamespace);

WebSite := WebSiteGetObject(IIsWebService localhost/wsvc);

WebServer := WebSiteGetObject(IIsWebServer );

WebRoot := WebServerGetObject(IIsWebVirtualDir Root);

VDir := WebRootCreate(IIsWebVirtualDir VariantTest);

VDirAccessRead := True;

VDirPath := C:\Test;

VDirSetInfo;

end;