1.Set proxy server in IE
On Error resume next
Dim WshShell, bKey
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\AutoConfigURL", " http://proxy.emark.com/accelerated_pac_base.pac", "REG_SZ"
Wscript.quit
2.set none proxy server in IE
On Error resume next
Dim WshShell, bKey
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Regdelete "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\AutoConfigURL"
Wscript.quit
3.Check client local groups and add AD group to client local group
‘***********************************************************************
‘ File Name : chkgrp.vbs
‘ Purpose   : Check local groups and add AD groups to local groups
‘ Usage     : It must be apply to compuate start in Group Policy Object
‘ Author     : Bill Tang
‘ Date        : Dec 06, 2006
‘***********************************************************************
On Error Resume Next
Dim strComputer,strDomain,strGroup,strAdGroup,lExist
strComputer = "."
strGroup    = "Administrators"
‘***Check <<Domain Admins>> groups***
strDomain   = "emark.com"
strAdGroup  = "Domain Admins"
Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup & ",group")
lExist = "Flase"
For Each objMember In objGroup.Members
    if objMember.Name = strAdGroup then
       lExist = "True"
    end if
Next
if lExist = "Flase" then
   Set objAdGroup = GetObject("WinNT://" & strDomain & "/" & strAdGroup & ",group")
   objGroup.Add(objAdGroup.ADsPath)
   ‘Wscript.Echo "Add AD groups " & objADGroup.ADsPath  & " to local administrators groups"
end if
‘***Check <<cnsha_mgt_clt>> groups***
strDomain   = "emark.com"
strAdGroup  = "cnsha_mgt_clt"
Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup & ",group")
lExist = "Flase"
For Each objMember In objGroup.Members
    if objMember.Name = strAdGroup then
       lExist = "True"
    end if
Next
if lExist = "Flase" then
   Set objAdGroup = GetObject("WinNT://" & strDomain & "/" & strAdGroup & ",group")
   objGroup.Add(objAdGroup.ADsPath)
   ‘Wscript.Echo "Add AD groups " & objADGroup.ADsPath  & " to local administrators groups"
end if
‘***Check <<Domain Users>> groups***
strComputer = "."
strGroup    = "Users"
 
strDomain   = "emark.com"
strAdGroup  = "Domain Users"
Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup & ",group")
lExist = "Flase"
For Each objMember In objGroup.Members
    if objMember.Name = strAdGroup then
       lExist = "True"
    end if
Next
if lExist = "Flase" then
   Set objAdGroup = GetObject("WinNT://" & strDomain & "/" & strAdGroup & ",group")
   objGroup.Add(objAdGroup.ADsPath)
   ‘Wscript.Echo "Add AD groups " & objADGroup.ADsPath  & " to local administrators groups"
end if
Wscript.quit
4.Create user private folder in the light of AD users
‘===============================================================================
‘ Created: 11/29/07 13:30:52 by tangbi01
‘ File Name : cupf.vbs
‘ Purpose   : create user private folder according to windows AD
‘ Author     : Bill Tang
‘ Date        : Nov 29, 2006
‘===============================================================================
On Error Resume Next
‘**********Declare variables**********
dim UserPath,pPath,UserName,ActTimes
Set WshNetwork    = WScript.CreateObject("WScript.Network")
Set WshShell      = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
‘**********List all user in OU**********
Const ADS_SCOPE_ONELEVEL = 1
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand    = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_ONELEVEL
objCommand.CommandText = _
    "SELECT Name FROM ‘LDAP://OU=users,ou=cnsha,ou=accounts,dc=emark,dc=com’ WHERE objectCategory=’user’"
Set objRecordSet = objCommand.Execute
ActTimes = 0
UserPath = "d:\users\"
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
    UserName = objRecordSet.Fields("Name").Value
    ‘Set objUser = GetObject("WinNT://emark/" & UserName)
    Set objUser = GetObject("WinNT://" & WshNetwork.userdomain & "/" & UserName)
    if not objUser. AccountDisabled then
       pPath = UserPath & UserName
       If not (fso.FolderExists(pPath)) Then
          ActTimes = ActTimes + 1
          fso.CreateFolder(pPath)
          Set BatFile = fso.CreateTextFile(UserPath & "setper.bat", True)
          cLine = "xcacls " & pPath & " /Y /P " & WshNetwork.UserDomain & "\" & UserName & ":F Administrators:F SYSTEM:F" 
          BatFile.WriteLine(cLine)
       End If
    end if
    objRecordSet.MoveNext
Loop
if ActTimes = 0 then
   msgbox "AD have no user need create private folder",0,"Information"
else
   BatFile.Close()
   WshShell.Run UserPath & "setper.bat"
   msgInfo = "Create " & ActTimes & " User Private Folder OK" & chr(13) & _
             "============================" & chr(13) & _
             "Set Permissions bat file is:" & UserPath & "setper.bat"
   msgbox msgInfo,0,"Success"
end if
Wscript.quit
5.View user last logon time in DC
‘===============================================================================
‘ File Name : lastlogn.vbs
‘ Purpose   : view users last logon time in AD
‘ Author     : Bill Tang
‘ Date        : Dec 19, 2006
‘===============================================================================
On Error Resume Next
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set fso        = CreateObject("Scripting.FileSystemObject")
‘**********List all user in OU**********
Const ADS_SCOPE_ONELEVEL = 1
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand    = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_ONELEVEL
objCommand.CommandText = _
    "SELECT Name FROM ‘LDAP://OU=users,ou=cnsha,ou=accounts,dc=emark,dc=com’ WHERE objectCategory=’user’"
Set objRecordSet = objCommand.Execute
If not (fso.FolderExists("c:\temp")) Then
   fso.CreateFolder("c:\temp")
end if
Set logFile = fso.CreateTextFile("c:\temp\lastlogon.txt", True)
cLine = "UserName" & vbtab & vbtab & "Display Name" & vbtab & vbtab & "LastLogon"
logFile.WriteLine(cLine)
count = 0
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
    UserName = objRecordSet.Fields("Name").Value
    Set objUser = GetObject("WinNT://" & WshNetwork.userdomain & "/" & UserName)
    if not objUser.AccountDisabled then
       count = count + 1
       set objUser = nothing   
       lpUser = " LDAP://cn=" & username & ",ou=users,ou=cnsha,ou=accounts,dc=emark,dc=com"
       set objUser = GetObject(lpUser)
   
       disName = objUser.displayName
       Set objLastLogon = objUser.Get("lastLogon")
       ‘Set objLastLogon = objUser.Get("lastLogonTimestamp")
       intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
       intLastLogonTime = intLastLogonTime / (60 * 10000000)
       intLastLogonTime = intLastLogonTime / 1440
   
       if intLastLogonTime = 0 then
          cLine = UserName & vbtab & vbtab & disName & vbtab & vbtab &"Never Logon"
       else
          cLine = UserName & vbtab & vbtab & disName & vbtab & vbtab & intLastLogonTime + #1/1/1601#
       end if
       logFile.WriteLine(cLine)
    end if
    objRecordSet.MoveNext
Loop
logFile.Close
wScript.echo "Total record " & count & " users last logon time in c:\temp\lastlogon.txt"
wscript.quit
6.Common logon script for AD,for instance map drivers,map printer etc.
‘===============================================================================
‘ Created: 11/29/07 13:30:52 by tangbi01
‘ File Name : logon.vbs
‘ Purpose   : scropt for all user logon windows 2003 AD
‘ Author     : Bill Tang
‘ Date        : Nov 29, 2006
‘===============================================================================
On Error Resume Next
‘**********Declaration**********
Dim HomeDrive,ShareDrive
Set ObjUser     = CreateObject("ADSystemInfo")
Set CurrentUser = GetObject("LDAP://" & ObjUser.UserName)
Set WshNetwork    = WScript.CreateObject("WScript.Network")
Set WshShell      = WScript.CreateObject("WScript.Shell")
Set fso           = CreateObject("Scripting.FileSystemObject")
Set ColUsrEnvVars = WshShell.Environment("VOLATILE")
HomeDrive  = " \\emark.com\users$\" & WshNetwork.username
ShareDrive = " \\emark.com\public"
‘**********Copy shortcut to user deksktop**********
strDesktop = WshShell.SpecialFolders("Desktop")
strLink    = strDesktop & "\pallas.lnk"
If not fso.FolderExists(strLink) Then
   fso.CopyFile " \\emark.com\netlogon\pallas.lnk",strLink,true
end if
‘**********Map network drivers**********
‘WShNetwork.RemoveNetworkDrive "S:"
WshNetwork.MapNetworkDrive "S:" , ShareDrive
‘WShNetwork.RemoveNetworkDrive "U:"
WshNetwork.MapNetworkDrive "U:" , HomeDrive
IF IsMember("CLI-ADMIN") THEN
   WshNetwork.MapNetworkDrive "T:" , " \\emark.com\setup$"
END IF
‘**********Printers mapping**********
PrinterPath = " \\emark.com\HP5100"
WshNetwork.AddWindowsPrinterConnection PrinterPath
‘WshNetwork.SetDefaultPrinter PrinterPath
PrinterPath = " \\jenny-pc\GenericT"
WshNetwork.AddWindowsPrinterConnection PrinterPath
‘WshNetwork.SetDefaultPrinter PrinterPath
popup(CurrentUser.DisplayName)
Wscript.quit
‘========================= Determine Group Membership ========================
Function IsMember(sGroup)
 Dim sAdsPath, oUser, oGroup
 If IsEmpty(oGroupDict) Then
  Set oGroupDict = CreateObject("Scripting.Dictionary")
  oGroupDict.CompareMode = vbTextCompare
  sAdsPath = WshNetwork.UserDomain & "/" & WshNetwork.UserName
  Set oUser = GetObject("WinNT://" & sAdsPath & ",user")
  For Each oGroup In oUser.Groups
     oGroupDict.Add oGroup.Name, "-"
  Next
  Set oUser = Nothing
 End If
 IsMember = CBool(oGroupDict.Exists(sGroup))
End Function
‘===============================================================================
Function popup(Username)
 Dim HourNow, Greeting,MsgInfo
 HourNow = Hour(Now)
 If HourNow >0 And  HourNow <12 Then
  Greeting = "Good Morning"
 Elseif HourNow =0  Then
  Greeting = "Good Morning"
 Elseif HourNow =12 Then
  Greeting = "Good Afternoon"
 Elseif HourNow >12 And HourNow <18 Then
  Greeting = "Good Afternoon "
 Else
  Greeting = "Good Evening"
 End If
 ’MsgBox Greeting & "! " & Username,0,"Logon"
 MsgInfo = Greeting & "! " & Username & chr(13) & _
           "============================================" & chr(13) & _
           "Home  Drive(U:):" & HomeDrive & chr(13) &_
           "Share Drive(S:):" & ShareDrive
 MsgBox MsgInfo,0,"Logon " & wshNetwork.computername
End Function
‘===============================================================================
Function WorkGrp()
Dim strADPath, oUser, oGroup, strGrp
strADPath = WshNetwork.UserDomain & "/" & WshNetwork.UserName
Set oUser = GetObject("WinNT://" & strADPath & ",user")
For Each oGroup In oUser.Groups
    if left(oGroup.Name, 12) = "G_CNYNZ_FSW-" then
      strGrp = right(oGroup.Name, 4)
    End if
Next
Set oUser = Nothing
WorkGrp = strGrp
‘WScript.Echo strGrp
End Function
7.Get windows product key infromation
Option Explicit
Dim objReg
Dim Digits (24),HexBuf (100), HexDigitalPID (15)
Dim StartOffset,EndOffset,i,dLen,sLen,KEYSTRING,HN,N,Value
Digits (0) = "B" : Digits (1) = "C": Digits (2) = "D": Digits (3) = "F":
Digits (4) = "G": Digits (5) = "H": Digits (6) = "J": Digits (7) = "K":
Digits (8) = "M": Digits (9) = "P": Digits (10) = "Q": Digits (11) = "R":
Digits (12) = "T": Digits (13) = "V": Digits (14) = "W": Digits (15) = "X":
Digits (16) = "Y": Digits (17) = "2": Digits (18) = "3": Digits (19) = "4":
Digits (20) = "6" : Digits (21) = "7" : Digits (22) = "8": Digits (23) = "9"
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
objReg.GetBinaryValue &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\", "DigitalProductId", HexBuf
StartOffset = 52 : EndOffset =67
For i = StartOffset to EndOffset
  HexDigitalPID (i-StartOffset) = HexBuf(i)
Next
dLen = 29 : sLen = 15
KEYSTRING =""
For i=dLen-1 TO 0 Step -1
    IF ((i + 1) MOD 6) = 0 Then
       KEYSTRING = KEYSTRING & "-"
    Else
       HN = 0
       For N = (sLen -1) TO 0 Step -1
           Value = ( (HN *2^8 ) Or HexDigitalPID (N))
           HexDigitalPID (N) = Value \ 24
           HN = (Value MOD 24)
       Next
       KEYSTRING = KEYSTRING & Digits(HN)
    End IF
Next
Wscript.Echo StrReverse(KEYSTRING)
Wscript.quit
8.get all computers windows production key in doma
On error resume next
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
    "Select Name, Location from ‘LDAP://ou=workstations,ou=cnsha,ou=client-server,DC=emark,DC=com’ " _
        & "Where objectClass=’computer’" 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
    get_key(objRecordSet.Fields("Name").Value)
    objRecordSet.MoveNext
Loop
 
Wscript.quit
‘***********************************************************************
Function get_key(strComputer)
 Dim objReg
 Dim Digits (24),HexBuf (100), HexDigitalPID (15)
 Dim StartOffset,EndOffset,i,dLen,sLen,KEYSTRING,HN,N,Value
 Digits (0) = "B" : Digits (1) = "C": Digits (2) = "D": Digits (3) = "F":
 Digits (4) = "G": Digits (5) = "H": Digits (6) = "J": Digits (7) = "K":
 Digits (8) = "M": Digits (9) = "P": Digits (10) = "Q": Digits (11) = "R":
 Digits (12) = "T": Digits (13) = "V": Digits (14) = "W": Digits (15) = "X":
 Digits (16) = "Y": Digits (17) = "2": Digits (18) = "3": Digits (19) = "4":
 Digits (20) = "6" : Digits (21) = "7" : Digits (22) = "8": Digits (23) = "9"
 Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\"&strComputer&"\root\default:StdRegProv")
 objReg.GetBinaryValue &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\", "DigitalProductId", HexBuf
 StartOffset = 52 : EndOffset =67
 For i = StartOffset to EndOffset
   HexDigitalPID (i-StartOffset) = HexBuf(i)
 Next
 dLen = 29 : sLen = 15
 KEYSTRING =""
 For i=dLen-1 TO 0 Step -1
    IF ((i + 1) MOD 6) = 0 Then
       KEYSTRING = KEYSTRING & "-"
    Else
       HN = 0
       For N = (sLen -1) TO 0 Step -1
           Value = ( (HN *2^8 ) Or HexDigitalPID (N))
           HexDigitalPID (N) = Value \ 24
           HN = (Value MOD 24)
       Next
       KEYSTRING = KEYSTRING & Digits(HN)
    End IF
 Next
 Wscript.Echo strComputer & vbtab &StrReverse(KEYSTRING)
End Function
9.Change windows production key
ON ERROR RESUME NEXT
Dim VOL_PROD_KEY
Set WshShell = WScript.CreateObject("WScript.Shell")
if Wscript.arguments.count<1 then
   VOL_PROD_KEY=InputBox("Powered By Bill Tang" &vbCr &vbCr&" 本程序将自动替换你当前 Windows 的序列号","Windows XP序列号自动更换器")
   if VOL_PROD_KEY="" then
      Wscript.quit
   end if
else  
   VOL_PROD_KEY = Wscript.arguments.Item(0)
end if
VOL_PROD_KEY = Replace(VOL_PROD_KEY,"-","") ‘remove hyphens if any
for each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")
   result = Obj.SetProductKey (VOL_PROD_KEY)
   if err <> 0 then
      msgbox "替换失败！输入的 CD-KEY 与当前的版本不匹配。",0,"序列号替换错误"  
   end if
   if err = 0 then
      msgbox "OK！去微软验证吧!" &vbcr &vbcr & " http://www.microsoft.com/genuine",0,"序列号替换成功"
      WshShell.run "cmd /c start http://www.microsoft.com/genuine"
   end if
   Err.Clear  
Next
Wscript.quit
10.Shutdown or reboot or logoff worksation
‘ 注销/重起/关闭本地Windows NT/2000 计算机。基本思路如下：
‘
‘ Win32ShutDown(flag)中flag的参数:
‘ 0 注销
‘ 0 + 4 强制注销
‘ 1 关机
‘ 1 + 4 强制关机
‘ 2 重起
‘ 2 + 4 强制重起
‘ 8 关闭电源
‘ 8 + 4 强制关闭电源
Dim Connection, WQL, SystemClass, System
StrComputer="."
Set Connection = GetObject("winmgmts:\\"&strComputer&"\root\cimv2")
WQL = "Select Name From Win32_OperatingSystem"
Set SystemClass = Connection.ExecQuery(WQL)
For Each System In SystemClass
    System.Win32ShutDown (0+4)
Next
wScript.quit
11.lock workstation
on error resume next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
error = objWMIService.Create("rundll32.exe user32.dll,LockWorkStation", null, null,intProcessID)
wScript.quit