hmailserver批量添加用户

Option Explicit
 On Error Resume Next
  wscript.echo  "start ..."
 Dim obBaseApp
 Dim objFSO
 Dim objTextFile
 Dim strNewAlias,i
 Dim scrreport
 Dim failed
 Dim added
 failed=0
 added=0
 i=0
 Const ForReading=1
 Set obBaseApp=CreateObject("hMailServer.Application")
 Call obBaseApp.Authenticate("Administrator","password") 
 Set objFSO=CreateObject("Scripting.FileSystemObject")
 Set objTextFile=objFSO.OpenTextFile("users.txt",ForReading)   
 Do While objTextFile.AtEndOfStream<>True
   strNewAlias=split(objTextFile.Readline,",")
   Select Case strNewAlias(0)
     Case "User"
	AddUser strNewAlias(1),strNewAlias(2),strNewAlias(3)
     Case "Alias"
	AddAlias strNewAlias(1),strNewAlias(2),strNewAlias(3)
     Case "Delete"
	DelUser strNewAlias(1),strNewAlias(2)
   End Select
  If err.Number<>0 Then  
    scrreport=scrreport&"Failed add(probably duplicate):"&strNewAlias(0)&","&strNewAlias(1)&","&strNewAlias(2)&","&strNewAlias(3)&VBNewLine
    failed=failed+1
    err.Clear
  Else
   added=added+1
  End If
  i=i+1
 Loop

scrreport=scrreport&""&VBNewLine
scrreport=scrreport&"Added="&added&VBNewLine
scrreport=scrreport&"Failed or Duplicates="&failed&VBNewLine
wscript.echo scrreport
wscript.echo  "end !"

Sub AddAlias(strAlias,strEmailAddress,strDomain)
  Dim obDomain
  Dim obAliases
  Dim obNewAlias
  Set obDomain=obBaseApp.Domains.ItemByName(strDomain)
  Set obAliases=obDomain.Aliases
  Set obNewAlias=obAliases.Add()
  obNewAlias.Name=strAlias&"@"&strDomain     
  obNewAlias.Value=strEmailAddress           
  obNewAlias.Active=1
  obNewAlias.Save()
  Set obNewAlias=Nothing
  Set obAliases=Nothing
  Set obDomain=Nothing
End Sub

Sub AddUser(strUsername,strPassword,strDomain)
 Dim obDomain
 Dim obAccounts
 Dim obNewAccount
 Set obDomain=obBaseApp.Domains.ItemByName(strDomain)
 Set obAccounts=obDomain.Accounts
 Set obNewAccount=obAccounts.Add()
 obNewAccount.Address=strUsername&"@"&strDomain      'username
 obNewAccount.Password=strPassword                   'password
 obNewAccount.Active=1                               'activatesuser
 obNewAccount.Maxsize=500                             'set smailbox size,0=unlimited
 obNewAccount.Save()    
wscript.echo  "addok--"&obNewAccount.Address                              
 Set obNewAccount=Nothing
 Set obDomain=Nothing
 Set obAccounts=Nothing
End Sub 


Sub DelUser(strUsername,strDomain)
 Dim obDomain
 Dim obAccounts
 Dim obDelAccount
 Set obDomain=obBaseApp.Domains.ItemByName(strDomain)
 Set obAccounts=obDomain.Accounts
 Set obDelAccount = obAccounts.ItemByAddress(strUsername & "@" & strDomain)
 obDelAccount.Delete()
 wscript.echo  "delok--"& strUsername & "@" & strDomain                              
 Set obDelAccount=Nothing
 Set obDomain=Nothing
 Set obAccounts=Nothing
End Sub