Buat direktori virtual IIS menggunakan Delphi

Sudah lama aku ingin membereskan barang-barangku sendiri, tapi aku belum punya waktu, kemampuanku terlalu rendah, dan aku takut membuang-buang waktu orang lain, jadi aku belum menulis apa pun. . Namun setiap kali saya melihat artikel orang lain, saya merasa gatal, jadi saya mencari postingan yang saya terbitkan di www.delphibbs.com untuk diberikan kembali kepada semua orang.

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

{ }

{ }

{zhao zhenhua }

{}

{ Hak cipta zhao zhenhua email:[email protected] }

{ }

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

satuan MainUnt;

antarmuka

kegunaan

Windows, Pesan, SysUtils, Varian, Kelas, Grafik, Kontrol, Formulir,

Dialog, StdCtrls, FileCtrl, Tombol,Actives_TLB;

jenis

TIISConfigFrm = kelas(TForm)

edtAlias: TEdit;

Label1: Label;

dlbIIS: TDirectoryListBox;

dcbIIS: TDriveComboBox;

Label2: TLabel;

edtPath: TEdit;

Kotak Grup1: Kotak Grup T;

cbBaca: TCheckBox;

cbScript: TCheckBox;

cbJalankan: TCheckBox;

cbTulis: TCheckBox;

cbJelajahi: TCheckBox;

bbtOK: TBitBtn;

lblPath:TLabel;

Prosedur dlbIISChange(Pengirim: TObject);

prosedur bbtOKClick(Pengirim: TObject);

prosedur FormCreate(Pengirim: TObject);

pribadi

{Deklarasi pribadi}

publik

{Pernyataan publik}

akhir;

fungsi ADsGetObject(const PathName: WideString; const GUID:TGUID; keluar I: IUnknown): HRESULT;

var

IISConfigFrm: TIISConfigFrm;

pelaksanaan

{$R *.dfm}

fungsi ADsGetObject; nama 'ActiveDS.dll' eksternal 'ADsGetObject';

prosedur TIISConfigFrm.dlbIISChange(Pengirim: TObject);

mulai

edtPath.Teks:=dlbIIS.Direktori;

akhir;

prosedur TIISConfigFrm.bbtOKClick(Pengirim: TObject);

var

I: IADsContainer;

IKLAN: IAD;

mulai

jika Panjang(Trim(edtAlias.Text))=0 maka mulailah

application.MessageBox('Alias ​​​​tidak boleh kosong!','Peringatan');

KELUAR;

akhir;

jika Panjang(Trim(edtPath.Text))=0 maka mulailah

Application.MessageBox('Silakan pilih lokasi direktori virtual!','Peringatan');

KELUAR;

akhir;

if ADsGetObject('IIS://localhost', IID_IADsContainer, IUnknown(I)) = S_Ok maka mulai //IIS telah diinstal

if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok lalu mulai //Server web ada

Iklan := IADs(I.GetObject('IIsWebServer', '1')); //Dapatkan layanan

jika ADs.QueryInterface(IID_IADsContainer, I) = S_OK maka mulai //Dukungan layanan

ADs := IADs(I.GetObject('IIsWebVirtualDir', 'Root')); //Buat direktori virtual di bawah Root server Web

jika ADs.QueryInterface(IID_IADsContainer, I) = S_OK maka mulai //Dukungan layanan

mencoba

Iklan := IADs(I.Create('IIsWebVirtualDir', edtAlias.Text)); //Buat direktori virtual dengan alias edtAlias.Text

kecuali

Application.MessageBox('Alias ​​ini sudah ada, silakan pilih alias lain!', 'Peringatan');

KELUAR;

akhir; //coba kecuali

ADs.Put('accessRead', cbRead.Checked); //Setel setiap parameter

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

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

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

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

IKLAN.Put('Jalur', edtPath.teks);

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);//Izinkan file default dibuka

ADs.SetInfo; //Simpan parameter

Application.MessageBox('Pengaturan Anda telah disimpan.','Selamat');

akhir;

akhir;

akhir;

akhiri yang lain

Application.MessageBox('IIS tidak diinstal pada komputer Anda atau Anda tidak memiliki izin untuk mengakses IIS.', 'Peringatan');

akhir;

procedure TIISConfigFrm.FormCreate(Pengirim: TObject);

mulai

edtPath.Teks:=dlbIIS.Direktori;

akhir;

akhir.