I have been taking out my things for a long time, but I have not time, my level is too bad, I am afraid to delay the time of others, so I didn't write anything. But every time I see someone else's article is itchy, so I find a post from my own www.delphibbs.com to give back to everyone.
{********************************************************** *********************} {} {} {zhao zhenhua} {} {copyright zhao zhenhua email: zhao-zhenhua@163.net} {} { *********************************************************** ********************} Unit mainunt; InterfaceUses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, STD Ctrls, FileCtrl, Buttons, Activeds_TLB; type TIISConfigFrm = class (TForm) edtAlias: TEdit; Label1: TLabel; dlbIIS: TDirectoryListBox; dcbIIS: TDriveComboBox; Label2: TLabel; edtPath: TEdit; GroupBox1: TGroupBox; cbRead: TCheckBox; cbScript: TCheckBox ; cbExecute: TCheckBox; cbWrite: TCheckBox; cbBrowse: TCheckBox; bbtOK: TBitBtn; lblPath: TLabel; procedure dlbIISChange (Sender: TObject); procedure bbtOKClick (Sender: TObject); procedure FormCreate (Sender: TObject); private {Private declarations} Public {public declarations}}}}}}} (const pathname): HRESULT; stdcall; var iisconfigfrm: tiisconfigfrm: tiisconfigfrm: tiisconfigfrm;
implementation {$ R * .dfm} function ADsGetObject; external 'ActiveDS.dll' name 'ADsGetObject'; procedure TIISConfigFrm.dlbIISChange (Sender: TObject); begin edtPath.Text: = dlbIIS.Directory; end; procedure TIISConfigFrm.bbtOKClick (Sender : TOBJECT); VAR i: Iadscontainer; Ads: Iads; begin if longth (Trim (edtalias.text)) = 0 The begin application.MessageBox ('alias can't be empty!', 'Warning'); End; End; IF Length (TRIM (EDTPATH.TEXT)) = 0 THEN BEGIN Application.MessageBox ('Please select the virtual directory location!', 'Warning'); exit; end; if adsgetObject ('Iis: // localhost', IID_IADSCONTAINER, IUNKNOWN I))) = S_OK THEN Begin // IIS Install IF AdsGetObject ('IIS: // LocalHost / W3SVC', IID_IADSCONTAINER, IUNKNOWN (I)) = S_OK THEN BEGIN / / Web Server exists ADS: = IADS (i.getObject) ('IisWebserver', '1')); // Get Service If Ads.Queryinterface (IID_IADSCONTAINER, I) = S_OK THEN BEGIN / / Service Support Ads: = IADS (I.GetObject ('IisWebVirtualdir', 'root')))) // Create a virtual directory if the virtual directory (IID_IADSCONTAINER, I) = S_OK THEN BEGINER, I) = S_OK THEN Ads: = IADS (I.CREATE ('IisWebVirtualDir', Edtalias.Text)); // Establish a virtual directory, alias for edtalias.text except application.MessageBox ('This alias already exists, please select another alias! ',' Warning '); exit; end; // Try Except ads.put (' accessread ', cbread.checked); // Set each parameter ads.put (' accesswrite ', cbwrite.checked; ads.put 'AccessScript', cbscript.checked; ads.put ('accessexecute', cbexecute.checked); ads.put ('enabledirbrowsing', cbbrowse.checked); ads.put ('Path'
