命令行下建立虚拟目录

program VDir;

{$APPTYPE CONSOLE}

uses
ActiveX,SysUtils,ComObj;
Var
VName,
VPath,
Vattrib : String;

createVpath : Boolean;
WebIndex : integer;

Procedure ShowHelp;
Begin
WriteLn('=========== VDir by CYFD! ============');
WriteLn('');
WriteLn('Useag:'+ParamStr(0)+' <-n:VName> <-p:VPath> <-i:WebIndex> <-c:CmdType> [-r:Vattrib]');
WriteLn('');
WriteLn('Sample:'+ParamStr(0)+' -n:yfd -p:c:\ -i:1 -c:1 -r:0,1,3');
WriteLn('');
WriteLn(' CmdType :');
WriteLn(' 1 : create');
WriteLn(' 0 : delete');
WriteLn(' Vattrib :');
WriteLn(' 0 : AccessScript');
WriteLn(' 1 : AccessRead');
WriteLn(' 2 : AccessWrite');
WriteLn(' 3 : AccessExecute');
WriteLn(' 4 : EnableDirBrowsing');
End;

Procedure ParseParam(Str : String);
var
tStr : String;
Begin
tStr := lowercase(Copy(Str,1,3));
if tStr='-n:' then
VName := Copy(Str,4,Length(Str));
if tStr='-p:' then
VPath := Copy(Str,4,Length(Str));
if tStr='-c:' then
createVpath := StrToIntDef(Copy(Str,4,Length(Str)),1) = 1;
if tStr='-r:' then
Vattrib := Copy(Str,4,Length(Str));
if tStr='-i:' then
WebIndex := StrToIntDef(Copy(Str,4,Length(Str)),1);

End;

Function GetStrForSpace(SourceStr :String ; JGZF:char ; Index:integer):String;
var
Pchar1 : pchar;
i , count : integer;
cStr : string;
begin
Count := 0;
Pchar1 := pchar(SourceStr);
cStr := '';
for i:=0 to length(Pchar1)-1 do begin
if pchar1 = JGZF then
begin
Count := Count + 1;
if Count = Index then begin
break;
end;
end
else if Count = Index -1 then cStr := cStr + pchar1;
end;
Result := cStr;
end;

procedure createVDir(Vdirpath:string);
var
WebSite, WebServer, WebRoot, VDir,Binds: Variant;
BindStr : String;
begin
Try
WebSite := createOleObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', IntTostr(WebIndex));

// 这里的WebIndex就是你要建立的序号.

WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');

if createVpath then Begin
VDir := WebRoot.create('IIsWebVirtualDir', VName);
Vdir.AccessScript := pos(',0,',Vattrib) >0;
VDir.AccessRead := pos(',1,',Vattrib) >0;
VDir.AccessWrite := pos(',2,',Vattrib) >0;
VDir.AccessExecute := pos(',3,',Vattrib) >0;
VDir.EnableDirBrowsing := pos(',4,',Vattrib) >0;

// 以上几行是为你建立的目录设访问权限。可写，可读，可执行，可流览...

VDir.Path :=VDirPath;
VDir.SetInfo;

Binds := WebServer.ServerBindings;
BindStr := Binds[0]+':';
WriteLn('');
WriteLn('Result :');
WriteLn('');
WriteLn('IP : '+ GetStrForSpace(BindStr,':',1));
WriteLn('Port : '+ GetStrForSpace(BindStr,':',2));
WriteLn('HostName : '+ GetStrForSpace(BindStr,':',3));
WriteLn('');
WriteLN('Path Is: ' + WebRoot.Path);
WriteLN('Index IS: ' + IntTostr(WebIndex));
WriteLn('Comment : ' + WebServer.ServerComment);

// 上面几行就是得到站点的一些信息，IP，端口，主机名，路径，等等..

WriteLn('');
WriteLn('create success.');
End
Else Begin
WebRoot.delete('IIsWebVirtualDir', VName);
Writeln('delete Success.');
End;
Except
WriteLn('Fail.');
End;

end;

Var
i : integer;
begin

coinitialize(nil);
if ParamCount <4 then Begin
ShowHelp;
Exit;
End;

For i:=1 to ParamCount do
ParseParam(Paramstr(i));

if (ParamCount = 5) and (Vattrib ='') then Begin
ShowHelp;
Exit;
End;
Vattrib := ','+Vattrib+',';
createVDir(VPath);

{ TODO -oUser -cConsole Main : insert code here }

end.