Créer un répertoire virtuel IIS à l'aide de Delphi

J'ai envie de régler mes propres affaires depuis longtemps, mais je n'ai pas eu le temps, mes compétences sont trop faibles et j'ai peur de faire perdre le temps aux autres, donc je n'ai encore rien écrit . Mais chaque fois que je vois les articles des autres, j'ai des démangeaisons, alors je trouve un article que j'ai publié sur www.delphibbs.com pour le redonner à tout le monde.

{************************************************* * ******************** }

{ }

{ }

{ Zhao Zhenhua }

{}

{ Copyright zhao zhenhua email: [email protected] }

{ }

{************************************************* * ******************** }

unité MainUnt ;

interface

utilise

Windows, messages, SysUtils, variantes, classes, graphiques, contrôles, formulaires,

Boîtes de dialogue, StdCtrls, FileCtrl, Boutons, Activeds_TLB ;

taper

TIISConfigFrm = classe (TForm)

edtAlias : TEdit ;

Étiquette1 : TLabel ;

dlbIIS : TDirectoryListBox ;

dcbIIS : TDriveComboBox ;

Étiquette2 : TLabel ;

edtPath : TEdit ;

GroupBox1 : TGroupBox ;

cbRead : TCheckBox ;

cbScript : TCheckBox ;

cbExecute : TCheckBox ;

cbWrite : TCheckBox ;

cbBrowse : TCheckBox ;

bbtOK : TBitBtn ;

lblPath:TLabel;

PRocédure dlbIISChange(Expéditeur : TObject);

procédure bbtOKClick(Expéditeur : TObject);

procédure FormCreate(Expéditeur : TObject);

privé

{Déclarations privées}

publique

{Déclarations publiques}

fin;

fonction ADsGetObject (const PathName : WideString ; const GUID : TGUID ; out I : IUnknown) : HRESULT ;

var

IISConfigFrm : TIISConfigFrm ;

mise en œuvre

{$R *.dfm}

fonction ADsGetObject ; nom externe 'ActiveDS.dll' 'ADsGetObject' ;

procédure TIISConfigFrm.dlbIISChange(Expéditeur : TObject);

commencer

edtPath.Text:=dlbIIS.Directory;

fin;

procédure TIISConfigFrm.bbtOKClick(Expéditeur : TObject);

var

I : IADsContainer ;

AD : IAD ;

commencer

si Longueur (Trim (edtAlias.Text)) = 0 alors commencez

application.MessageBox('L'alias ne peut pas être vide !','Avertissement');

Sortie;

fin;

si Longueur (Trim (edtPath.Text)) = 0 alors commencez

Application.MessageBox('Veuillez sélectionner l'emplacement du répertoire virtuel !','Avertissement');

Sortie;

fin;

si ADsGetObject('IIS://localhost', IID_IADsContainer, IUnknown(I)) = S_Ok alors commencez //IIS a été installé

si ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok alors commencez //Le serveur Web existe

ADs := IADs(I.GetObject('IIsWebServer', '1')); //Obtenir des services

si ADs.QueryInterface(IID_IADsContainer, I) = S_OK alors commencez //Support de service

ADs := IADs(I.GetObject('IIsWebVirtualDir', 'Root')); //Créer un répertoire virtuel sous la racine du serveur Web

si ADs.QueryInterface(IID_IADsContainer, I) = S_OK alors commencez //Support de service

essayer

ADs := IADs(I.Create('IIsWebVirtualDir', edtAlias.Text)); //Créer un répertoire virtuel avec un alias de edtAlias.Text

sauf

Application.MessageBox('Cet alias existe déjà, veuillez en choisir un autre !', 'Attention');

Sortie;

end; //essaye sauf

ADs.Put('accessRead', cbRead.Checked); //Définit chaque paramètre

ADs.Put('AccessWrite', cbWrite.Checked);

ADs.put('AccessScript',cbScript.Checked);

ADs.Put('AccessExecute',cbExecute.Checked);

ADs.put('EnableDirBrowsing',cbBrowse.Checked);

ADs.Put('Chemin', edtPath.text);

ADs.Put('DefaultDoc','Default.asp, Default.html, Default.htm, index.asp, Index.html, Index.htm, Home.asp, Home.Html, Home.htm');

ADs.Put('EnableDefaultDoc',True);//Autoriser l'ouverture des fichiers par défaut

ADs.SetInfo; //Enregistrer les paramètres

Application.MessageBox('Vos paramètres ont été enregistrés.','Félicitations');

fin;

fin;

fin;

fin sinon

Application.MessageBox('IIS n'est pas installé sur votre ordinateur ou vous n'êtes pas autorisé à accéder à IIS.', 'Avertissement');

fin;

procédure TIISConfigFrm.FormCreate(Expéditeur : TObject);

commencer

edtPath.Text:=dlbIIS.Directory;

fin;

fin.