2012年9月26日 星期三

VBScript get user full groups in Windows Server and map drive


This is I setup Logon Script in Microsoft Windows 2000 Server, and need to setup something by different group. Frist time I use GetObject("LDAP://" & objADSystemInfo.UserName)  to enumerate, but Primary Group not appear, so I find other way in http://www.vbforums.com that use "open database". Now it work fine to me.

Option Explicit
Dim DrvID, strGroup, strGroups(10), GroupName, OSVer, SystemDir, PosStart, PosEnd, strUserName, strComputerName
Dim objADSystemInfo, objUser, SystemSet, System, fso, objShell, objExecObject
Dim f, Flag, MyDate, MyTime
Dim intPrimaryGroupID, objConnection, objCommand, objRecordSet
'On Error resume next
'Wscript.Echo "Login.vbs Start"
Set objADSystemInfo = CreateObject("ADSystemInfo")
strUserName = TrimCN(objADSystemInfo.UserName)
strComputerName = TrimCN(objADSystemInfo.ComputerName)

MyDate = Date  
MyTime = Time
Set fso = CreateObject("Scripting.FileSystemObject")
LogTxt MyDate & " " & MyTime & " " & strUserName & "@ " & strComputerName & ": "
Set objUser = GetObject("LDAP://" & objADSystemInfo.UserName)
intPrimaryGroupID = objUser.Get("primaryGroupID")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = ";(objectCategory=Group);" & "distinguishedName,primaryGroupToken;subtree" 
Set objRecordSet = objCommand.Execute
Do Until objRecordset.EOF
    If objRecordset.Fields("primaryGroupToken") = intPrimaryGroupID Then  
        strGroups(0) = TrimCN(objRecordset.Fields("distinguishedName"))
        'WScript.Echo "Primary group:" & objRecordset.Fields("distinguishedName")
    End If
    objRecordset.MoveNext
Loop
objConnection.Close
DrvID=1
For each strGroup in objUser.Groups '
  strGroups(DrvID) = Mid(strGroup.Name, 4)
  DrvID = DrvID + 1
Next
 
DrvID=77  'Map Drive from M Drive
Flag = False
For each strGroup in strGroups 'depends on which group to map drive
  If strGroup="" Then Exit For
  LogTxt strGroup & ", "
  If UCase(GroupName) = "HR" then DrvID = NetMap(DrvID, "\\Nas_SA\HR")
  If UCase(GroupName) = "MEPD" then
    DrvID = NetMap(DrvID, "\\NAS_SA\MEPD_S")
    DrvID = NetMap(DrvID, "\\NAS_SA\MEPD")
   
    Flag = True
  End If
  If UCase(GroupName) = "DESK" then
    DrvID = NetMap(DrvID, "\\Nas_SA\Desk")
    DrvID = NetMap(DrvID, "\\NAS_SA\SchoolPlanning")
  End If
  If UCase(GroupName) = "BB" then DrvID = NetMap(DrvID, "\\NAS_SA\BB")
  If UCase(GroupName) = "SB" then DrvID = NetMap(DrvID, "\\NAS_SA\SB")
  If UCase(GroupName) = "PRINTDEPT" then DrvID = NetMap(DrvID, "\\NAS_SA\PrintDept")
  If UCase(GroupName) = "MARKETING" then DrvID = NetMap(DrvID, "\\NAS_SA\Marketing")
  If UCase(GroupName) = "CEDIT" then DrvID = NetMap(DrvID, "\\NAS_SA\CEdit")
  If UCase(GroupName) = "Typeset" then DrvID = NetMap(DrvID, "\\NAS_SA\Typeset")
  If UCase(GroupName) = "Typeset" then DrvID = NetMap(DrvID, "\\MACFILESERV\8F_art")
  If UCase(GroupName) = "Typeset" then DrvID = NetMap(DrvID, "\\MACFILESERV\Mac2Pc")
Next

LogTxt vbCrLf

'Wscript.Echo "2"  'test
Set objShell = WScript.CreateObject("WScript.Shell")

If FindIP10() Then  'brand company
objShell.Run "ROUTE ADD 192.168.1.0 MASK 255.255.255.0 10.0.1.250", 0
objShell.Run "ROUTE ADD 210.59.236.224 MASK 255.255.255.248 10.0.1.250", 0
objShell.Run "ROUTE ADD 60.254.165.16 MASK 255.255.255.252 10.0.1.250", 0
objShell.Run "ROUTE ADD 0.0.0.0 MASK 0.0.0.0 10.0.1.254", 0
Else  'other
objShell.Run "ROUTE ADD 10.0.0.0 MASK 255.0.0.0 192.168.1.253", 0
objShell.Run "ROUTE ADD 210.59.236.224 MASK 255.255.255.248 192.168.1.253", 0
objShell.Run "ROUTE ADD 60.254.165.16 MASK 255.255.255.252 192.168.1.253", 0
objShell.Run "ROUTE ADD 61.63.52.192 MASK 255.255.255.224 192.168.1.253", 0
objShell.Run "ROUTE ADD 0.0.0.0 MASK 0.0.0.0 192.168.1.254", 0
End If
'Wscript.Echo "3"
If DrvID = 77 Then WScript.Quit()
Dim objWMIService, colProcesses, objProcess, objDir
Set objWMIService = GetObject("winmgmts:")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process where name='Client.exe'")
Do While  colProcesses.Count
    For Each objProcess In colProcesses
       objProcess.Terminate (0)
    Next
    Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process where name='Client.exe'")
Loop

'Clean client's program... hunting high and low....
On Error Resume Next
Set objDir = FSO.GetFolder("C:\")
getInfo(objDir)
Set objDir = FSO.GetFolder("D:\")
getInfo(objDir)
Set objDir = FSO.GetFolder("E:\")
getInfo(objDir)
If Flag = True Then objShell.Exec("autorun.exe") 'Some group need run other program
WScript.Quit()

Sub getInfo(pCurrentDir)
Dim aItem
    On Error Resume Next
For Each aItem In pCurrentDir.Files
'   If Err.Number>0 Then WScript.Echo "pCurrentDir:" & pCurrentDir.Path & vbCrLf & Err.Description
  If LCase(aItem.Name) = "client.exe" Then
    Err.Clear
  aItem.Delete
'   If Err.Number>0 Then WScript.Echo aItem.Path & vbCrLf & Err.Description
  End If
Next
For Each aItem In pCurrentDir.SubFolders
  getInfo(aItem)
Next
End Sub

Function NetMap(DrvID, strDistination ) 'Map Drive
  Dim objNetwork, fso, DrvName
  On Error resume next
  DrvName = Chr(DrvID) + ":"
  Set objNetwork = CreateObject("WScript.Network")
  Set fso = CreateObject("Scripting.FileSystemObject")
  If (fso.FolderExists(DrvName)) Then
    objNetwork.RemoveNetworkDrive DrvName
    objNetwork.MapNetworkDrive DrvName, strDistination
  Else
    objNetwork.MapNetworkDrive DrvName, strDistination
  End If
  NetMap = DrvID + 1  'If much drive need map
  On Error GoTo 0
End Function

Function FindIP10() 'different sub net
Dim objWMIService, IPConfigSet, IPConfig, i
FindIP10=False
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration ")
For Each IPConfig in IPConfigSet
   If Not IsNull(IPConfig.IPAddress) Then
       For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
           If Left(IPConfig.IPAddress(i),6) = "10.0.1" Then FindIP10=True
       Next
   End If
Next
End Function

Sub LogTxt(LT)
  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  Set f = fso.OpenTextFile("\\Server1\pub$\VBSLog.txt", ForAppending, True)
  f.Write LT
  f.Close
End Sub

Function TrimCN(strCN)
  PosStart = InStr(strCN, "=")+1
  PosEnd = InStr(PosStart, strCN, ",")
  TrimCN = Mid(strCN, PosStart, PosEnd - PosStart)
End Function