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 = "
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
