Crie um diretório virtual IIS usando Delphi

Há muito tempo que quero resolver minhas próprias coisas, mas não tenho tempo, minhas habilidades são muito baixas e tenho medo de perder o tempo de outras pessoas, então não escrevi nada ainda . Mas toda vez que vejo artigos de outras pessoas, sinto coceira, então encontro um post que publiquei em www.delphibbs.com para retribuir a todos.

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

{ }

{ }

{Zhao Zhenhua}

{}

{Direitos autorais zhao zhenhua email:[email protected] }

{ }

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

unidade MainUnt;

interface

usa

Windows, Mensagens, SysUtils, Variantes, Classes, Gráficos, Controles, Formulários,

Diálogos, StdCtrls, FileCtrl, Botões,Activeds_TLB;

tipo

TIISConfigFrm = classe(TForm)

edtAlias: TEdit;

Rótulo1: TLabel;

dlbIIS: TDirectoryListBox;

dcbIIS: TDriveComboBox;

Etiqueta2: TLabel;

edtPath: TEdit;

GroupBox1: TGroupBox;

cbRead:TCheckBox;

cbScript: TCheckBox;

cbExecute: TCheckBox;

cbWrite:TCheckBox;

cbBrowse: TCheckBox;

bbtOK: TBitBtn;

lblPath:TLabel;

Procedimento dlbIISChange(Remetente: TObject);

procedimento bbtOKClick(Remetente: TObject);

procedimento FormCreate(Remetente: TObject);

privado

{Declarações privadas}

público

{Declarações públicas}

fim;

função ADsGetObject (const PathName: WideString; const GUID:TGUID; saída I: IUnknown): HRESULT;

var

IISConfigFrm: TIISConfigFrm;

implementação

{$R *.dfm}

função ADsGetObject; nome 'ActiveDS.dll' externo 'ADsGetObject';

procedimento TIISConfigFrm.dlbIISChange(Remetente: TObject);

começar

edtPath.Text:=dlbIIS.Directory;

fim;

procedimento TIISConfigFrm.bbtOKClick(Remetente: TObject);

var

I: IADsContainer;

AD: DAI;

começar

se Length(Trim(edtAlias.Text))=0 então comece

application.MessageBox('Alias ​​​​não pode ficar vazio!','Aviso');

Saída;

fim;

se Length(Trim(edtPath.Text))=0 então comece

Application.MessageBox('Por favor, selecione o local do diretório virtual!','Aviso');

Saída;

fim;

if ADsGetObject('IIS://localhost', IID_IADsContainer, IUnknown(I)) = S_Ok então comece //IIS foi instalado

if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then start //O servidor Web existe

ADs := IADs(I.GetObject('IIsWebServer', '1'));

if ADs.QueryInterface(IID_IADsContainer, I) = S_OK então comece //Suporte de serviço

ADs := IADs(I.GetObject('IIsWebVirtualDir', 'Root')); //Cria um diretório virtual na raiz do servidor Web

if ADs.QueryInterface(IID_IADsContainer, I) = S_OK então comece //Suporte de serviço

tentar

ADs := IADs(I.Create('IIsWebVirtualDir', edtAlias.Text)); //Cria um diretório virtual com um alias de edtAlias.Text

exceto

Application.MessageBox('Este alias já existe, escolha outro alias!', 'Aviso');

Saída;

fim; //tenta exceto

ADs.Put('accessRead', cbRead.Checked); //Definir cada parâmetro

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

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

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

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

ADs.Put('Caminho', 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);//Permitir que arquivos padrão sejam abertos

ADs.SetInfo; //Salvar parâmetros

Application.MessageBox('Suas configurações foram salvas.','Parabéns');

fim;

fim;

fim;

fim mais

Application.MessageBox('IIS não está instalado em seu computador ou você não tem permissão para acessar o IIS.', 'Aviso');

fim;

procedimento TIISConfigFrm.FormCreate(Remetente: TObject);

começar

edtPath.Text:=dlbIIS.Directory;

fim;

fim.