Hi
someone asked for code to create a vroot in IIS4. Here a the subs I coded
/translated from VB for IIS administration (IIS4+IIS5). Under NT4, you will
have to download and install ADSI.
What I've not managed yet is to change/set the operator of a FTP server.
Maybe someone has code for this?
Here is the code (sorry, comments are in German):
sub ChangeAuthWebVirtualDir {
# geht mit IIsWebVirtualDir, evt. auch mit IIsWebDirectory?
my $server = $_[0];
my $index = $_[1];
my $vdir = $_[2];
my $anon = $_[3];
my $authbasic = $_[4];
my $authntlm = $_[5];
if (my $objWebDir =
Win32::OLE->GetObject("IIS://$server/w3svc/$index/ROOT/$vdir")) {
$objWebDir->{AuthAnonymous} = $anon;
$objWebDir->{AuthBasic} = $authbasic;
$objWebDir->{AuthNTLM} = $authntlm;
$objWebDir->SetInfo;
} else {
print "- ACHTUNG: Kann keine Verbindung zu
'IIS://$server/w3svc/$index/ROOT/$vdir' herstellen!\n";
}
}
#
----------------------------------------------------------------------------
-------------------------------
sub StartWebSite {
my $server = $_[0];
my $index = $_[1];
if (my $objWebSite =
Win32::OLE->GetObject("IIS://$server/w3svc/$index")) {
$objWebSite->Start;
} else {
print "- ACHTUNG: Kann keine Verbindung zu
'IIS://$server/w3svc/$index' herstellen!\n";
}
}
#
----------------------------------------------------------------------------
-------------------------------
sub StartFtpSite {
my $server = $_[0];
my $index = $_[1];
if (my $objFtpSite =
Win32::OLE->GetObject("IIS://$server/msftpsvc/$index")) {
$objFtpSite->Start;
} else {
print "- ACHTUNG: Kann keine Verbindung zu
'IIS://$server/msftpsvc/$index' herstellen!\n";
}
}
#
----------------------------------------------------------------------------
-------------------------------
sub CreateFTPSite {
my $server = $_[0];
my $ipaddr = $_[1];
my $ipport = $_[2];
my $comment = $_[3];
my $root = $_[4];
my $writable = $_[5];
my $index;
if (my $objMSFTPSVC =
Win32::OLE->GetObject("IIS://$server/msftpsvc")) {
# Suche unbenutzten Server-Index...
my $i = 2; # 1 scheint spezial zu sein?
{
local $^W=0; #Warnungen f�r diesen Block abschalten
while (my $objFTPSite =
Win32::OLE->GetObject("IIS://$server/msftpsvc/$i")) {
$i++
}
}
# Erster unbenutzer Server-Index sichern
$index = $i;
my $objNewSite;
if (!($objNewSite = $objMSFTPSVC->Create("IIsFtpServer",
$index))) {
print "- ACHTUNG: Fehler beim Erstellen!";
} else {
my $bindings = ["$ipaddr:$ipport:"];
$objNewSite->{ServerBindings} = $bindings;
$objNewSite->{ServerComment} = $comment;
$objNewSite->SetInfo;
my $objNewDir =
$objNewSite->Create("IIsFtpVirtualDir", "ROOT");
$objNewDir->{Path} = $root;
$objNewDir->{AccessRead} = $True;
$objNewDir->{AccessWrite} = $writable;
$objNewDir->SetInfo;
}
} else {
print "- ACHTUNG: Konnte keine Verbindung zum IIS auf
$server herstellen!";
}
return $index;
}
#
----------------------------------------------------------------------------
-------------------------------
sub CreateWebDirectory {
my $server = $_[0];
my $index = $_[1];
my $dir = $_[2];
my $appname = $_[3];
if (my $objWebRoot =
Win32::OLE->GetObject("IIS://$server/w3svc/$index/ROOT")) {
my $objNewDir = $objWebRoot->Create("IIsWebDirectory",
$dir);
$objNewDir->{AccessRead} = $True;
$objNewDir->{AccessScript} = $True;
$objNewDir->{AppFriendlyName} = $appname;
$objNewDir->{AppRoot} =
"/LM/W3SVC/$index/Root/$dir";
$objNewDir->SetInfo;
} else {
print "- ACHTUNG: Kann keine Verbindung zu
'IIS://$server/w3svc/$index/ROOT' aufnehmen!";
}
}
#
----------------------------------------------------------------------------
-------------------------------
sub CreateWebVirtualDir {
my $server = $_[0];
my $index = $_[1];
my $vdir = $_[2];
my $rdir = $_[3];
if (my $objWebRoot =
Win32::OLE->GetObject("IIS://$server/w3svc/$index/ROOT")) {
my $objNewDir = $objWebRoot->Create("IIsWebVirtualDir",
$vdir);
$objNewDir->{Path} = $rdir;
$objNewDir->{AccessRead} = $True;
$objNewDir->SetInfo;
} else {
print "- ACHTUNG: Kann keine Verbindung zu
'IIS://$server/w3svc/$index/ROOT' aufnehmen!";
}
}
#
----------------------------------------------------------------------------
-------------------------------
sub ChangeWebLogDir {
my $server = $_[0];
my $index = $_[1];
my $logdir = $_[2];
if (my $objWebSite =
Win32::OLE->GetObject("IIS://$server/w3svc/$index")) {
$objWebSite->{LogFileDirectory} = $logdir;
$objWebSite->SetInfo;
} else {
print "- ACHTUNG: Kann keine Verbindung zu
'IIS://$server/w3svc/$index' aufnehmen!";
}
}
#
----------------------------------------------------------------------------
-------------------------------
sub CreateWebSite {
my $server = $_[0];
my $ipaddr = $_[1];
my $ipport = $_[2];
my $header = $_[3];
my $comment = $_[4];
my $root = $_[5];
my $index;
if (my $objW3SVC = Win32::OLE->GetObject("IIS://$server/w3svc")) {
# Suche unbenutzten Server-Index...
my $i = 2; # 1 scheint spezial zu sein?
{
local $^W=0; #Warnungen f�r diesen Block abschalten
while (my $objWebSite =
Win32::OLE->GetObject("IIS://$server/w3svc/$i")) {
$i++
}
}
# Erster unbenutzer Server-Index sichern
$index = $i;
my $objNewSite;
if (!($objNewSite = $objW3SVC->Create("IIsWebServer",
$index))) {
print "- ACHTUNG: Fehler beim Erstellen!";
} else {
my $bindings = ["$ipaddr:$ipport:$header"];
$objNewSite->{ServerBindings} = $bindings;
$objNewSite->{ServerComment} = $comment;
$objNewSite->SetInfo;
my $objNewDir =
$objNewSite->Create("IIsWebVirtualDir", "ROOT");
$objNewDir->{Path} = $root;
$objNewDir->{AccessRead} = $True;
$objNewDir->SetInfo;
}
} else {
print "- ACHTUNG: Konnte keine Verbindung zum IIS auf
$server herstellen!";
}
return $index;
}
#
----------------------------------------------------------------------------
-------------------------------
sub CreateNTAccount
{
# usage:
CreateNTAccount($domain,$txtEmail,$FullNameField,$CommentField,$LoginScriptN
ame,$Password);
my $dmn=$_[0];
my $user=$_[1];
my $fullname=$_[2];
my $comment=$_[3];
my $script=$_[4];
my $passwd=$_[5];
my ($NTUser, $objNewUser, $Domain);
local $^W=0; # Warnungen f�r diesen Block abschalten
if ($Domain=Win32::OLE->GetObject("WinNT://$dmn"))
{
if (!($NTUser=Win32::OLE->GetObject("WinNT://$dmn/$user")))
{
if ($objNewUser = $Domain->Create("user",$user))
{
local $^W=1; # Warnungen f�r diesen Block wieder anschalten
print ("- Erstelle NT-User $dmn\\$user.\n");
$objNewUser->{FullName} = $fullname;
$objNewUser->{LoginScript} = $script;
$objNewUser->{Description} = $comment;
#FIXME $objNewUser->{PasswordExpired} = $LFalse;
# $objNewUser->{AccountDisabled} = $True;
$objNewUser->SetInfo;
$objNewUser->SetPassword("$passwd");
$objNewUser->SetInfo; # all of the code samples seem to indicate
you need to SetInfo twice
undef $objNewUser;
# check to see that account has been created
print ("- NT-User $dmn\\$user erstellt.\n");
}
else
{
print ("- ACHTUNG: Kann NT-User $dmn\\$user nicht erstellen -
Evt. kein Administrator?.\n");
}
}
else
{
print ("- ACHTUNG: NT-User $dmn\\$user existiert bereits!\n");
}
undef $Domain;
}
else
{
print ("- ACHTUNG: Kann keine Verbindung zu $dmn herstellen!\n");
}
}
Mit freundlichem Gru�
--
Mike Gerber fon: +49-7805-918-251 PGP auf Anfrage
Leitwerk GmbH fax: +49-7805-918-200
_______________________________________________
Perl-Win32-Admin mailing list
[EMAIL PROTECTED]
http://listserv.ActiveState.com/mailman/listinfo/perl-win32-admin
