ieadmin.vbs

来自「Apress - Managing Enterprise Systems Wit」· VBS 代码 · 共 163 行

'ieadmin.vbs
Dim objIE, objFSO, objDoc, objTS, strLine, nPos, objElem

'create an instance of the IE browser
Set objIE = Wscript.CreateObject("InternetExplorer.Application","ie_")

'objIE.FullScreen = True
'turn off all on screen 'clutter'
objIE.AddressBar= False
objIE.MenuBar= False
objIE.ToolBar= 0
objIE.Navigate "e:\Code Download\chapter 11\adminform.htm"

 'wait to load page
 While objIE.Busy
  WScript.Sleep 100
 Wend

 Set objDoc = objIE.Document
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objTS = objFSO.OpenTextFile("settings.ini",1) 

 Do While Not objTS.AtEndOfStream 
   strLine = objTS.ReadLine
   nPos = Instr(strLine,"=")
   If nPos > 0 Then
     Set objItem = objDoc.all(Trim(Left(strLine,nPos-1)))
      If objItem.type = "checkbox" Then
        objItem.checked = Cbool(Mid(strLine,nPos+1))
      Else
      'objDoc.all(Trim(Left(strLine,nPos-1))).value = Mid(strLine,nPos+1)
       objItem.value = Mid(strLine,nPos+1)
     End If 
     
   End If
 Loop

 Set objDOC.All("cmdCreateUser").onclick = GetRef("cmdCreateUser_OnClick")
 Set objDOC.All("cmdQuit").onclick = GetRef("Quit_OnQuit")
 Set objDOC.All("cmdSaveSettings").onclick = _
                                      GetRef("cmdSaveSettings_OnChange")

 Set objDOC.All("txtUserName").OnChange = GetRef("txtUserName_OnChange")
 Set objDOC.All("txtFullName").OnChange = GetRef("txtFullName_OnChange")
 Set objDOC.All("txtDescription").OnChange = GetRef("txtDescription_OnChange")

 objIE.Visible = True

 bDone = False
  While Not bDone 
   wscript.sleep 100
  Wend

 Sub Quit_OnQuit
  objIE.Quit
  bDone = True
 End Sub

 'event fires when value in Full Name field is changed
 Sub txtUserName_OnChange
  objDoc.all("txtExchangeAlias").value = objDoc.all("txtUserName").value
  objDoc.all("txtUserDirectory").value = _
                                  objDoc.all("txtDirectoryPath").value _ 
                                & objDoc.all("txtUserName").value  
 objDoc.all("txtUserShare").value = objDoc.all("txtShareComputer").value _ 
                                & objDoc.all("txtUserName").value & "$"  

 End Sub

 'event fires when value in Full Name field is changed
 Sub txtFullName_OnChange
 Dim aName, nCount
 'split values into array
 aName = Split(objDoc.all("txtFullName").value)

 nCount = Ubound(aName) 
 'check if any values in array
 If nCount > 0 Then
  'set Exchange user first name to first element
  objDoc.all("txtFirstName").value = aName(0)
  'set last name element
  If nCount=1 Then
   objDoc.all("txtLastName").value = aName(1) 
  Else
   objDoc.all("txtLastName").value = aName(2) 
   objDoc.all("txtUserInitials").value = aName(1) 
  End If
 End If

 End Sub
'event fires when value of Description field changes
 Sub txtDescription_OnChange
  'set Exchange Title field to value of account description
  objDoc.all("txtTitle").value = objDoc.all("txtDescription").value
 End Sub

'event fires when Create User button is clicked
 Sub cmdSaveSettings_OnChange

  'open settings file
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objTS = objFSO.OpenTextFile("settings.ini",2,True)

  'loop through all elements in the HTML document
  For Each objItem In objDOC.All

  'check if the element is an input element (input box, check box etc.)
  'and contains a value
  If TypeName(objItem) = "HTMLInputElement" Then 
    If (objItem.type = "text") _ 
         And objItem.value<>"" Then
     'write the value to the settings file
     objTS.WriteLine objItem.name & "=" & objItem.value
    ElseIf  objItem.type = "checkbox" Then
     objTS.WriteLine objItem.name & "=" & objItem.checked
     End If  
  End If
 Next
  objTS.Close
End Sub

 Sub cmdCreateUser_OnClick()
  Dim strLine, objD, objTS
  
  Set objD = objDOC.All
  Set objTS = WScript.Stdout
  
  strLine = "usermnt.wsf " & objD("txtUserName").value & _ 
            " /p:Description """ & objD("txtDescription").value _ 
            & """" & " /p:FullName """ & objD("txtFullName").value _ 
            & """" & " /p:Password """ & objD("txtPassword").value _ 
            & """" & vbCrLf

  
  'check if a home directory should be created  
  If objDOC.All("chkHomeDirectory").checked Then


   strLine = strLine & "usermnt.wsf " & objD("txtUserName").value & _ 
            " /u /p:HomeDirDrive """ & objD("txtHomeDirectory").value _ 
            & """" & " /p:HomeDirectory """ & _
               objD("txtUserShare").value & """" & vbCrLf
 
   strLine = strLine & "md " & objD("txtUserDirectory").value & vbCrLf
  End If

  'check if an Exchange account should be created
  If objDOC.All("chkCreateExchangeAccount").checked Then

  strLine = strLine & "createxuser.wsf " _ 
           & objD("txtExchangeServer").value &  _
           " " & objD("txtExchangeSite").value & " " & _
           objD("txtExchangeAlias").value & " """ & _
           objD("txtDisplayName").value & """" & _
           objD("txtSMTPAddress").value & " " _ 
           & objD("txtDomain").value & " " & objD("txtUserName").value _ 
           & vbCrLf

'createxuser.ws server site alias displayname SMTPAddress domain accountName  
  End If
  objTS.WriteLine strLine
 End Sub