Давно хотел разобраться в своих вещах, но времени не было, навыки у меня низкие, да и боюсь тратить чужое время, поэтому пока ничего не писал . Но каждый раз, когда я вижу статьи других людей, меня раздражает, поэтому я нахожу сообщение, которое опубликовал на www.delphibbs.com, чтобы отдать его всем.
{************************************************ * ********************* }
{ }
{ }
{ Чжао Чжэньхуа }
{}
{ Авторские права Чжао Чжэньхуа, электронная почта: [email protected] }
{ }
{************************************************ * ********************* }
модуль MainUnt;
интерфейс
использует
Windows, сообщения, SysUtils, варианты, классы, графика, элементы управления, формы,
Диалоги, StdCtrls, FileCtrl, Кнопки, Activeds_TLB;
тип
TIISConfigFrm = класс (TForm)
edtAlias: TEdit;
Метка1: TLabel;
dlbIIS: TDirectoryListBox;
dcbIIS: TDriveComboBox;
Метка2: TLabel;
edtPath: TEdit;
ГрупповойБокс1: ТГрупповойБокс;
cbRead: Тчекбокс;
cbScript: TCheckBox;
cbExecute: TCheckBox;
cbWrite: Тчекбокс;
cbBrowse: Тчекбокс;
ббтокок: ТБитБтн;
lblPath: TLabel;
PROcedure dlbIISChange (Отправитель: TObject);
процедура bbtOKClick (Отправитель: TObject);
процедура FormCreate (Отправитель: TObject);
частный
{Частные заявления}
общественный
{Публичные заявления}
конец;
функция ADsGetObject (const PathName: WideString; const GUID: TGUID; out I: IUnknown): HRESULT;
вар
IISConfigFrm: TIISConfigFrm;
выполнение
{$R *.dfm}
функция ADsGetObject; внешнее имя «ActiveDS.dll» «ADsGetObject»;
процедура TIISConfigFrm.dlbIISChange(Отправитель: TObject);
начинать
edtPath.Text:=dlbIIS.Directory;
конец;
процедура TIISConfigFrm.bbtOKClick(Отправитель: TObject);
вар
Я: IADsContainer;
AD: IAD;
начинать
если Длина(Trim(edtAlias.Text))=0, то начнем
application.MessageBox('Псевдоним не может быть пустым!','Внимание');
Выход;
конец;
если Длина(Trim(edtPath.Text))=0, то начнем
Application.MessageBox('Пожалуйста, выберите расположение виртуального каталога!','Внимание');
Выход;
конец;
если ADsGetObject('IIS://localhost', IID_IADsContainer, IUnknown(I)) = S_Ok, то начните //IIS установлен
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok, то начать //Веб-сервер существует
AD := IADs(I.GetObject('IIsWebServer', '1')); //Получить сервисы
если ADs.QueryInterface(IID_IADsContainer, I) = S_OK, то начинаем //Поддержку службы
ADs := IADs(I.GetObject('IIsWebVirtualDir', 'Root')); //Создаем виртуальный каталог в корне веб-сервера.
если ADs.QueryInterface(IID_IADsContainer, I) = S_OK, то начинаем //Поддержку службы
пытаться
AD := IADs(I.Create('IIsWebVirtualDir', edtAlias.Text)); //Создаем виртуальный каталог с псевдонимом edtAlias.Text));
кроме
Application.MessageBox('Этот псевдоним уже существует, выберите другой псевдоним!', 'Внимание');
Выход;
конец; //попробуем, кроме
ADs.Put('accessRead', cbRead.Checked); //Устанавливаем каждый параметр
ADs.Put('AccessWrite', cbWrite.Checked);
ADs.put('AccessScript',cbScript.Checked);
ADs.Put('AccessExecute',cbExecute.Checked);
ADs.put('EnableDirBrowsing',cbBrowse.Checked);
ADs.Put('Путь', 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);//Разрешить открытие файлов по умолчанию
ADs.SetInfo; //Сохраняем параметры
Application.MessageBox('Ваши настройки сохранены.','Поздравляем');
конец;
конец;
конец;
закончить еще
Application.MessageBox('IIS не установлен на вашем компьютере или у вас нет разрешения на доступ к IIS.', 'Внимание');
конец;
процедура TIISConfigFrm.FormCreate(Отправитель: TObject);
начинать
edtPath.Text:=dlbIIS.Directory;
конец;
конец.