| |
manking
Posts: 1
Score: 0
Joined: 6/4/2001
From:
Status: offline
|
<html>
<head>
<title>Create the user</title>
<script LANGUAGE="VBScript" RUNAT="Server">
'==========
' General Declarations Area
'==========
'====Constants======
'declare constants here with explanation
'===Public Variables===
'declare variables here with explanation
'==Inititialization Routines====
'
'place code here that you want to run
'everytime the page is loaded
'============
' Main Code Area
'============
'============
' Author: CreateUser
' Assumptions: None
' Inputs: Full_Name, Username, email
' Returns: Fully created user account
' Modules: None this uses ADSI (Active Directory
' Services Interface to manipulate the
' user entries
' ============
sub CreateUser(Full_Name,username,email,expires)
Dim Container
Dim NewUser
Dim CurrentDate
Dim ExpireDate
Dim HomeDir
HomeDir = "C:\users\" & username
CurrentDate = DateSerial(Year(Now),Month(Now),Day(Now))
ExpireDate = DateAdd("d",45,CurrentDate)
Set Container = GetObject("WinNT://xena")
Set NewUser = Container.Create("user", username)
NewUser.FullName = Full_Name
NewUser.Description = email
NewUser.AccountExpirationDate = ExpireDate
NewUser.HomeDirectory = HomeDir
NewUser.SetInfo
NewUser.SetPassword(username)
Response.write "<h5>The users account will expire on " & ExpireDate & "</h5>"
expires = ExpireDate
end sub
'============
' Author: AddUserToGroups
' Assumptions: User was successfully created
' Inputs: UserName, and groupname
' Returns: User added to appropriate groups
' Modules: None this uses ADSI (Active Directory
' Services Interface to manipulate the
' group entries
' ============
sub AddUserToGroups(username,groupname)
Dim Group1
Dim Group2
Set Group1 = GetObject("WinNT://xena/" & groupname)
Set Group2 = GetObject("WinNT://xena/Web Users")
Group1.Add ("WinNT://xena/" & username)
Group2.Add ("WinNT://xena/" & username)
end sub
'============
' Author: CreateDirectories
' Assumptions: None
' Inputs: UserName,
' Returns: All directories the user will need
' Modules: ASPExec to run cacls.
' Windows Scrupting Host
' ============
sub CreateDirectories(username)
Dim wwwdir
Dim cgibin
Dim userdir
Dim userdb
Dim userwww
wwwdir = "C:\inetpub\wwwroot\clients" & username
cgibin = "C:\inetpub\wwwroot\clients" & username & "\cgi-bin"
userdir = "C:\users\" & username
userdb = userdir & "\db"
userwww = userdir & "\www"
set dirobj = CreateObject("Scripting.FileSystemObject")
dirobj.CreateFolder(wwwdir)
dirobj.CreateFolder(cgibin)
dirobj.CreateFolder(userdir)
dirobj.CreateFolder(userdb)
dirobj.CreateFolder(userwww)
'Use ASP Execute as the helper for ACL
Set Executor = Server.CreateObject("ASPExec.Execute")
Executor.Application = "c:\winnt\system32\cacls"
'Set the ACL for the home directory
Response.write "<h5>Changing permissions for the user directory</h5>"
Executor.Parameters = userdir & " /t /e /p " & username & ":f"
strResult = Executor.ExecuteDosApp
Response.write "<h5>Results are: " & strResult & "</h5>"
' Set the ACL for DB directory
Response.write "<h5>Changing permissions for the db directory</h5>"
Executor.Parameters = userdb & " /t /e /g IUSR_XENA:c "
strResult = Executor.ExecuteDosApp
Response.write "<h5>Results are: " & strResult & "</h5>"
' Set the ACL for the CGI directory
Executor.Parameters = cgibin & " /t /e /p IUSR_XENA:r"
Response.write "<h5>Changing permissions for the user cgi directory</h5>"
strResult = Executor.ExecuteDosApp
Response.write "<h5>Results are: " & strResult & "</h5>"
set Executor = nothing
end sub
'============
' Author: CreateWebVirtualDirectory
' Assumptions: None
' Inputs: Full_Name, Username, email
' Returns: Fully created user account
' Modules: None this uses ADSI (Active Directory
' Services Interface to manipulate the
' user entries
' ============
sub CreateWebVirtualDirectory(username)
' Create the virtual directories for IIS
' Fix an error with the create object saying it fails
' but not really
'On Error Resume Next
set webroot = GetObject("IIS://Localhost/W3SVC/1/ROOT")
set userweb = webroot.Create("IISWebDirectory", username)
' Set the IIS permissions
userweb.AccessRead = True
userweb.AccessExecute = False
userweb.ContentIndexed = True
userweb.AccessScript = True
userweb.SetInfo
userweb.GetInfo
' Set the cgi-bin properties
set usercgi = userweb.create("IIsWebDirectory", "cgi-bin")
usercgi.AccessRead = False
usercgi.AccessWrite = False
usercgi.AccessExecute = True
usercgi.ContentIndexed = False
usercgi.SetInfo
end sub
sub AddFPextensions(username)
'Use ASP Execute as the helper for fpsrvadm
Set Executor = Server.CreateObject("ASPExec.Execute")
Executor.Application = "c:\Program Files\Microsoft FrontPage\version3.0\bin\fpsrvadm"
' Add the extensions
' username is needed to insure web gets create with seperate permissions
Response.write "<h5>Adding Front Page Extensions </h5>"
Executor.Parameters = "-o install -m 1 -p 80 -w " & username & " -u root"
strResult = Executor.ExecuteDosApp
Response.write "<h5>Results are: " & strResult & "</h5>"
' Remove the root user acess
Response.write "<h5>Removing root user access</h5>"
Executor.Parameters = "-o security -m 1 -p 80 -w " & username & " -a remove -u root"
strResult = Executor.ExecuteDosApp
Response.write "<h5>Results are: " & strResult & "</h5>"
' Add the username to the authors list
Response.write "<h5>Adding user as author</h5>"
Executor.Parameters = "-o security -m 1 -p 80 -w " & username & " -a authors -u " & username
strResult = Executor.ExecuteDosApp
Response.write "<h5>Results are: " & strResult & "</h5>"
set Executor = nothing
end sub
sub CreateFTPDir(username)
' Set the root for the user to be the home directory
set root = GetObject("IIS://LocalHost/MSFTPSVC/1/Root")
set usrftproot = root.Create("IISFtpVirtualDir",username)
usrftproot.Path = "C:\users\" & username
usrftproot.AccessRead = True
usrftproot.AccessWrite = True
usrftproot.SetInfo
set usrftp = GetObject("IIS://LocalHost/MSFTPSVC/1/Root/" & username)
set webdir = usrftp.Create("IISFtpVirtualDir","www")
webdir.Path = "C:\inetpub\wwwroot\clients" & username
webdir.SetInfo
End Sub
'============
' Author: CreateEmailAccount
' Assumptions: None
' Effects:
' Inputs: Username, Full_Name
' Returns: A POP account
' Modules: None. Uses Windows Scripting Host
' ============
sub CreateEmailAccount(username, full_name)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim AppFilesystem
Dim UserList
Dim Semaphore
Dim Mailpath
Dim FilePath
Dim POPname
Dim POPpass
Dim Flags
MailPath = "d:\mdaemon\users\" & username & "\"
FilePath = MailPath & "files\"
POPname = username
POPpass = "\\<DEFAULT>"
Flags = "NNYYNNYNNN9999999999"
set dirobj = CreateObject("Scripting.FileSystemObject")
dirobj.CreateFolder(maildir)
dirobj.CreateFolder(mailfiles)
'Use ASP Execute as the helper for ACL
Set Executor = Server.CreateObject("ASPExec.Execute")
Executor.Application = "c:\winnt\system32\cacls"
'Set the ACL for the Mail directory
Response.write "<h5>Changing permissions for the Mail directory </h5>"
Executor.Parameters = maildir & " /t /e /p " & username & ":f"
Response.Write "<h5>Results are: " & strResult & "</h5>"
set AppFilesystem = CreateObject("Scripting.FileSystemObject")
set UserList = Appfilesystem.OpenTextFile("d:\mdaemon\app\userlist.dat",ForAppending)
UserList.Write(username)
spacecount = 30 - Len(username)
for index = 1 to spacecount
UserList.Write(" ")
next
UserList.Write(full_name)
spacecount = 30 - Len(full_name)
for index = 1 to spacecount
UserList.Write(" ")
next
UserList.Write(MailPath)
spacecount = 90 - Len(MailPath)
for index = 1 to spacecount
UserList.Write(" ")
next
UserList.Write(FilePath)
spacecount = 90 - Len(FilePath)
for index = 1 to spacecount
UserList.Write(" ")
next
UserList.Write(POPname)
spacecount = 20 - Len(POPname)
for index = 1 to spacecount
UserList.Write(" ")
next
UserList.Write(POPpass)
spacecount = 20 - Len(POPpass)
for index = 1 to spacecount
UserList.Write(" ")
next
UserList.WriteLine(Flags)
UserList.Close
set Semaphore = AppFilesystem.CreateTextFile("d:\mdaemon\app\userlist.sem",true)
Semaphore.Close
set AppFilesystem = nothing
set UserList = nothing
set Semaphore = nothing
set dirobj = nothing
set executor = nothing
end sub
'============
' Author: GenerateWelcomeEmail
' Assumptions: None
' Effects:
' Inputs: Full_Name,email,username,expires
' Returns: A welcome Email
' Modules: None. Uses Windows Scripting Host
' ============
sub GenerateWelcomeEmail(full_name,email,username,expires)
Dim RAWFilesystem
Dim WelcomeFile
set RAWFilesystem = CreateObject("Scripting.FileSystemObject")
set WelcomeFile = RAWfilesystem.CreateTextFile("d:\mdaemon\rawfiles\welcome.raw",true)
WelcomeFile.writeline("From <webmaster@puterweb.com>")
WelcomeFile.write("To <")
WelcomeFile.write(email)
WelcomeFile.writeline(">")
'WelcomeFile.writeline("CC <admin@puterweb.com>")
WelcomeFile.writeline("Subject <Welcome to Computer Web Services>")
WelcomeFile.writeline("X-FLAG=ATTACH <C:\inetpub\wwwroot\members\faq.htm, MIME>")
WelcomeFile.writeline(" ")
WelcomeFile.write("Welcome to Computer Web Services. ")
WelcomeFile.write("Thank you for your business. Your account is now ")
WelcomeFile.writeline("completely set up. Here is the information that I have.")
WelcomeFile.writeline("")
WelcomeFile.writeline("Username : " & username)
WelcomeFile.writeline("ExpirationDate : " & expires)
WelcomeFile.writeline("")
WelcomeFile.write("You will have 30 days to evaluate the service. ")
WelcomeFile.write("At the end of the 30 days you will receive an email ")
WelcomeFile.write("statement with a due date on it. You will then have 15 ")
WelcomeFile.writeline("days to pay the bill or your account will be disabled.")
WelcomeFile.writeline("")
WelcomeFile.writeline("Terms of Service")
WelcomeFile.writeline("")
WelcomeFile.writeline("1. No pornographic sites")
WelcomeFile.write("2. If payment is not received by due date the ")
WelcomeFile.write("account will be disabled unless other arrangements ")
WelcomeFile.writeline("have been previously made")
WelcomeFile.writeline("")
WelcomeFile.writeline("Additional Info")
WelcomeFile.writeline("")
WelcomeFile.write("You have been automatically added to the CWSNEWS ")
WelcomeFile.write("mailing list. For more assistance please check the ")
WelcomeFile.write("attached FAQ, the user help pages, or the newsgroups ")
WelcomeFile.writeline("available at http://www.dejanews.com/~puterweb")
WelcomeFile.write("Your initial password is the same as your userid. ")
WelcomeFile.write("Please go to http://www.puterweb.com/members/changepass.htm ")
WelcomeFile.write("and change it.")
WelcomeFile.writeline(" ")
WelcomeFile.writeline(" ")
WelcomeFile.writeline(" ")
WelcomeFile.writeline(" ")
WelcomeFile.writeline(" John Maddox")
WelcomeFile.writeline(" Web Master")
WelcomeFile.writeline(" Computer Web Services")
WelcomeFile.close
Set RAWFilesystem = nothing
Set WelcomeFile = nothing
End sub
sub AddToMailingList(email)
Dim RAWFilesystem
Dim ListFile
set RAWFilesystem = CreateObject("Scripting.FileSystemObject")
set ListFile = RAWfilesystem.CreateTextFile("d:\mdaemon\rawfiles\mlistadd.raw",true)
ListFile.writeline("From <webmaster@puterweb.com>")
ListFile.writeline("To <listserv@puterweb.com>")
ListFile.writeline("Subject < >")
ListFile.writeline(" ")
ListFile.write("subscribe cwsnews ")
ListFile.write(email)
ListFile.close
Set RAWFilesystem = nothing
Set ListFile = nothing
end sub
</script>
<meta name="Microsoft Theme" content="dpaodsy1 011, default"><meta name="Microsoft Border" content="t, default"></head>
<body background="_themes/dpaodsy1/comp5bkg.gif" bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#CC0000" alink="#00CC33"><!--msnavigation--><table border="0" cellpadding="0" cellspacing="0" width="100%"><tr><td><!--mstheme--><font face="arial, arial, helvetica">
<p align="center"><font size="6"><strong><img src="_derived/adduser.asp_cmp_dpaodsy1010_bnr.gif" width="600" height="60" border="0" alt="Create the user"></strong></font><br>
<nobr>[ <a href="./">Home</a> ]</nobr></p>
<p align="center"> </p>
<!--mstheme--></font></td></tr><!--msnavigation--></table><!--msnavigation-->
<table border="0" cellpadding="0" cellspacing="0" width="100%"><tr><!--msnavigation-->
<td valign="top"><!--mstheme--><font face="arial, arial, helvetica">
<%
'On Error Resume Next
'Retrieve the form data
strFull_Name = Request.Form("txtFull_Name")
strUsername = Request.Form("txtUsername")
strGroups = Request.Form("lstGroups")
strEmail = Request.Form("txtEmail")
strPOP = Request.Form("optPOP")
strExpires = ""
CreateUser strFull_Name, strUsername, strEmail, strExpires
If Err.Number = 0 then
Response.write "<h4>User Creation Successful</h4>"
AddUserToGroups strUsername, strGroups
If Err.Number = 0 then
Response.write "<h4>Group addition successful</h4>"
Else
Response.write "<h3>Group Addition failed.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
Err.Clear
CreateDirectories strUsername
If Err.Number = 0 then
Response.write "<h4>Directory Creation Successful</h4>"
Else
Response.write "<h3>Creating Directories failed.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
Err.Clear
CreateWebVirtualDirectory strUsername
If Err.Number = 0 then
Response.write "<h4>Virtual Web Creation Successfull</h4>"
Else
Response.write "<h3>Creating WWW Virtual Directories failed.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
Err.Clear
AddFPExtensions strUsername
If Err.Number = 0 then
Response.write "<h4> Front Page Extensions added </h4>"
Else
Response.write "<h3>Adding FP Extensions failed.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
Err.Clear
CreateFTPDir strUsername
If Err.Number = 0 then
Response.write "<h4> FTP Site Created </h4>"
Else
Response.write "<h3>Creating FTP Directories failed.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
Err.Clear
If strPOP = "Yes" then
CreateEmailAccount strUsername, strFull_Name
If Err.Number = 0 then
Response.write "<h4>Email Account Created</h4>"
Else
Response.write "<h3>Problem Creating Email.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
End If
Err.Clear
GenerateWelcomeEmail strFull_name, strEmail, strUsername, strExpires
If Err.Number = 0 then
Response.write "<h4> Welcome Email Sent </h4>"
Else
Response.write "<h3>Problem Generating Welcome Email.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
Err.Clear
AddToMailingList(email)
If Err.Number = 0 then
Response.write "<h4> Added to mailing List </h4>"
Else
Response.write "<h3>Problem Adding to Mailing List.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
Err.Clear
Else
Response.write "<h3>Creating User failed.</h3>"
Response.write "<h3>The error was " & Err.Description & "</h3>"
End If
%>
<!--mstheme--></font><!--msnavigation--></td></tr><!--msnavigation--></table></body>
</html>
|
|
Printable Version
How do I make this work?? - 
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread