Open the notepad, copy the code there and save the document with the .vbs extension. Next, if the network without domains copy this file into startup for each PC. If the network is a domain, then you create a group policy (in AD), where you insert this file into the startup parameters. Next, when you connect or restart the account, the script will run

To connect a network drive:

 Set WshNetwork = CreateObject ("WScript.Network") 'Create an object of type Network Set Drives = WshNetwork.EnumNetworkDrives c = 0' Time-tested for at least one network drive!  I = 0 While i <= Drives.Count-1 'Check for network wildcards c = 1' MsgBox "You have a network drive" & Drives.Item (i) & "-" & Drives.Item (i + 1) I = i + 2 Wend if c = 0 then 'MsgBox' There is not a single mounted drive "'MsgBox" Attempting to mount a network drive "' Set WshNetwork = CreateObject (" WScript.Network ") WshNetwork.MapNetworkDrive" Z: "," \ \ Servername \ folder name "End if

To connect the printer:

 Set WshNetwork = WScript.CreateObject ("WScript.Network")
 WshNetwork.AddWindowsPrinterConnection "\\ server name \ printer name"

Checking the changes in the parameters in AD and sending the notification to e-mail or to the Sharepoint list:



 / * ================================================ ======== 
 ' 
 'Script Information: Send a message to the administrator 
 'When you change the data in AD, you can send a message 
 'To e-mail or create a task in MOSS 2007 
 ' 
 'Author: Korotenko Vladimir SDC 2008 Voronezh 
 'Created by: 15.04.2008 - 11:01:47 
 'Original path: untitled.vbs 
 'Description: Create a domain schema dump and compare 
 'With the previous copy to receive the changes and the subsequent 
 'Notification 
 ' 
 '================================================= ======= 
 * / 




 // Section of script settings 
 Var SmtpHost, SmtpPort, MailSubject, MailTo, MailFrom, TextBody; 
 Var DumpCmdLine, WinDiff, DumpFile, DumpFileOld, WorkingFolder; 
 Var DiffFile, DiffMessage; 
 Var SpListGuid, SpHost, UseSp; 

 SmtpHost = "comp1";  // mail server for sending messages 
 SmtpPort = 25;  // the port of the mail server 
 MailSubject = "Make changes to the organizational chart";  // the title of the letter message 
 MailTo = "[email protected]";  // Address of the recipient 
 MailFrom = "[email protected]";  // Sender's address 
 DumpCmdLine = "c: \\ windows \\ system32 \\ ldifde.exe";  // command line for dumping their AD data 
 WinDiff = "c: \\ temp \\ windiff.exe";  // Program for comparison 2 
 DumpFile = "schema.ldf";  // Name of the file to save 
 DumpFileOld = "schemaOld.ldf";  // Name 2 files to compare 
 WorkingFolder = "c: \\ temp \\";  // working folder for temporary files 

 DiffFile = "diff.log";  // Service file for comparison results 
 DiffMessage = "1 files listed";  // the line we are looking for if there are no files 

 SpListGuid = "{3D9B5EFB-C0C5-434C-B1DA-61FEA6E9D63B}"; 
 SpHost = "http: // portal4"; 
 UseSp = true;  // send messages to the Share Point list 

 // End of the settings section 

 / ************************************************* ******************** 
 Code to change only in case of deep understanding for what do 
 And most importantly HOW you do !!!!!!!!! 
 ************************************************** ******************** / 

 Var file, wsh; 
 // create object for work 

 File = WScript.CreateObject ("Scripting.FileSystemObject"); 

 If (file.FileExists (WorkingFolder + DumpFileOld)) 
 File.DeleteFile (WorkingFolder + DumpFileOld); 

 If (file.FileExists (WorkingFolder + DumpFile)) 
 File.MoveFile (WorkingFolder + DumpFile, WorkingFolder + DumpFileOld) 

 Wsh = WScript.CreateObject ("WScript.Shell"); 

 Wsh.Run (DumpCmdLine + "-f" + WorkingFolder + DumpFile, 1,1); 
 TrimUnused (WorkingFolder + DumpFile); 

 If (file.FileExists (WorkingFolder + DumpFileOld)) 
 CheckChanges (WorkingFolder + DumpFile, WorkingFolder + DumpFileOld); 




 // Check for a difference of 2 files 
 Function CheckChanges (pathFrom, pathTo) 
 { 
 Var cmd; 
 // WinDiff.Exe output.ldf schemaOld.ldf -Sx logcmd 
 Cmd = WinDiff + "" + pathFrom + "" + pathTo + "-Sx" + WorkingFolder + DiffFile; 
 Wsh.Run (cmd, 1,1); 
 ObjFile = file.OpenTextFile (WorkingFolder + DiffFile, 1); 
 Var buff = new String (); 
 Buff = objFile.ReadAll (); 
 ObjFile.Close (); 
 Var arr = new Array (); 
 Arr = buff.split ("\ r \ n"); 

 For (var i = 0; i <arr.length; i ++) 
 { 
 // Check if the files are different, if so send a message 

 If (arr [i] .indexOf (DiffMessage)> -1) 
 { 
 Var d = new Date (); 
 TextBody = "Changes detected in the schema." Comparison time: "+ d.toString (); 
 SendMessage (); 
 } 
 } 
 } 



 // Remove rows with frequently changed attributes 
 Function TrimUnused (name) 
 { 
 Var ForReading = 1; 
 Var ForWriting = 2; 
 Var objFSo, objFile; 


 ObjFSo = new ActiveXObject ("Scripting.FileSystemObject"); 
 ObjFile = objFSo.OpenTextFile (name, ForReading); 
 Var strContents = new String (); 
 StrContents = objFile.ReadAll (); 
 ObjFile.Close (); 

 Var arr = new Array (); 
 Arr = strContents.split ("\ r \ n"); 

 ObjFile = objFSo.OpenTextFile (name, ForWriting); 

 For (var i = 0; i <arr.length; i ++) 
 { 
 If (arr [i] .indexOf ("lastLogon") == -1) 
 ObjFile.WriteLine (arr [i]); 
 } 
 } 
 ObjFile.Close (); 
 } 



 // Send a message to an address all parameters must be specified in the global variables section 

 Function SendMessage () { 

 If (UseSp) 
 { 
 NewMessage (SpListGuid, SpHost, TextBody); 
 Return; 
 } 
 Var objEmail = new ActiveXObject ("CDO.Message"); 
 ObjEmail.From = MailFrom; 
 ObjEmail.To = MailTo; 

 ObjEmail.Subject = MailSubject; 
 ObjEmail.Textbody = TextBody; 
 ObjEmail.MimeFormatted = true; 
 ObjEmail.BodyPart.Charset = "windows-1251"; 
 ObjEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2; 
 ObjEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SmtpHost; 
 ObjEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SmtpPort; 
 ObjEmail.Configuration.Fields.Update (); 
 ObjEmail.Send (); 

 } 

 // create a new message in the Sharepoint list 
 Function NewMessage (list, hostName, message) 
 { 
 Var web, req, batch; 
 Web = new ActiveXObject ("MSXML2.XMLHTTP.3.0"); 

 Batch = "<Batch ListVersion = '0'> <Method ID = '1' Cmd = 'New'> <Field Name = 'Title'>" + message + "</ Field> </ Method> </ Batch>" ; 

 Var req = "<? Xml version = '1.0' encoding = 'utf-8'?> <Soap: Envelope xmlns: xsi = 'http: //www.w3.org/2001/XMLSchema-instance' xmlns: xsd = 'Http://www.w3.org/2001/XMLSchema' xmlns: soap = 'http: //schemas.xmlsoap.org/soap/envelope/'> <soap: Body> <UpdateListItems xmlns = 'http: // Schemas.microsoft.com/sharepoint/soap / '> "; 
 Req + = "<listName>" + list + "</ listName>"; 
 Req + = "<updates>" + batch + "</ updates> </ UpdateListItems> </ soap: Body> </ soap: Envelope>"; 


 Var r = hostName + "/_vti_bin/Lists.asmx?op=UpdateListItems"; 
 Web.Open ("POST", r, False); 
 Web.setRequestHeader ("Content-Type", "text / xml; charset = utf-8"); 
 Web.setRequestHeader ("SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"); 
 Web.send (req); 

 //'WScript.Echo req 
 //'WScript.Echo Chr (13) & Chr (10) 
 //'WScript.Echo web.responseText 

 }

Script for removing terminal licenses on clients, every 30 days:


 'Deletes, if necessary, the registry key in which temporary licenses are stored, if 30 days have elapsed. 
 Option Explicit 
 Dim iCount, dDat, dReadDat, strPath, strRegKey 'declaration of variables 
 Dim fso, fLogFile, wshSysEnv, wshShell 'declaration of objects 

 DDat = date 'get the current date 
 Err.clear 'yf just in case we clean the error stack 

 On error resume next 'After this error message is not displayed 

 'Create the Shell object 
 Set wshShell = WScript.CreateObject ("WScript.Shell") 
 'Create an Environment object that contains the required system variable 
 Set wshSysEnv = WshShell.Environment ("PROCESS") 
 'We pull out the system variable (the path to the Windows folder) and put it in a string variable for later use 
 StrPath = wshSysEnv ("WINDIR") 

 'Create an access object to the file system and an object to access the required file for reading 
 Set fso = CreateObject ("Scripting.FileSystemObject") 
 Set fLogFile = fso.OpenTextFile (strPath & "\ LiDelDat.alx", 1, false) 

 'The main condition for removing or uninstalling the registry branch 
 If err.number <> 0 then 
 'Performing the procedure to delete the registry branch 
 Call DelLicense 

 'Enter the last date for deleting the license in the log file, erasing the entry in it 
 Call WriteToLog 
 Else 
 'Read from the file and compare the date the license was last deleted with the current date 
 DReadDat = CDate (fLogFile.ReadLine ()) 

 'Must be (dDat - dReadDat) 
 If (dDat - dReadDat)> 29 Then 
 'Performing the procedure to delete the registry branch 
 Call DelLicense 

 'Enter the last date for deleting the license in the log file, erasing the entry in it 
 Call WriteToLog 
 End If 
 End If 

 'We destroy all unnecessary more objects 
 Set WshShell = Nothing 
 Set wshSysEnv = Nothing 
 Set fso = Nothing 

 '************************************************* *********** 
 'Procedures 
 '************************************************* *********** 
 'License removal procedure 
 Sub DelLicense () 
 'Remove the license-plug-in one at a time 
 On error resume next 
 Err.clear 

 For iCount = 0 to 9 
 StrRegKey = "HKLM \ SOFTWARE \ Microsoft \ MSLicensing \ Store \ LICENSE00" & iCount & "\" 
 WshShell.RegDelete (strRegKey) 

 If err.number <> 0 then 
 Err.clear 
 End If 
 Next 

 'Delete the subkeys of the main partition 
 WshShell.RegDelete ("HKLM \ SOFTWARE \ Microsoft \ MSLicensing \ Store \") 
 If err.number <> 0 then err.clear 

 WshShell.RegDelete ("HKLM \ SOFTWARE \ Microsoft \ MSLicensing \ HardwareID \") 
 If err.number <> 0 then err.clear 

 'Delete the main partition 
 WshShell.RegDelete ("HKLM \ SOFTWARE \ Microsoft \ MSLicensing \") 
 If err.number <> 0 then err.clear 

 End Sub 

 'The procedure for recording the date the license was last deleted to a file 
 Sub WriteToLog () 
 Err.clear 

 'Create an object to access the desired file for writing with overwriting previous entries 
 Set fLogFile = fso.OpenTextFile (strPath & "\ LiDelDat.alx", 2, true) 

 'We write down the date of cleaning the registry 
 FLogFile.Write (Date) 

 Set fLogFile = nothing 'destroy the object 
 End Sub

The script to combat mail.ru-agent:


 Const DeleteReadOnly = TRUE 

 Set WshShell = WScript.CreateObject ("Wscript.Shell") 
 Set WshSysEnv = WshShell.Environment ("Process") 

 Set objFSO = CreateObject ("Scripting.FileSystemObject") 
 AgentFile = WshSysEnv ("userprofile") + "\ Application Data \ Mail.Ru \ Agent \ magent.exe" 


 If objFSO.FileExists (agentFile) Then 

 ObjFSO.DeleteFile (agentFile), DeleteReadOnly 


 If err.number = 0 then 
 Set objEmail = CreateObject ("CDO.Message") 

 ObjEmail.From = "[email protected]" 
 ObjEmail.To = "[email protected]" 
 ObjEmail.Subject = "Mail.ru-agent" 
 ObjEmail.Textbody = "Dear sirs system administrators, I am informing you that the enemy mail.ru agent is destroyed from" + WshSysEnv ("userprofile") 
 ObjEmail.Configuration.Fields.Item _ 
 ("Http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
 ObjEmail.Configuration.Fields.Item _ 
 ("Http://schemas.microsoft.com/cdo/configuration/smtpserver") = _ 
 "Ip mail server" 
 ObjEmail.Configuration.Fields.Item _ 
 ("Http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
 ObjEmail.Configuration.Fields.Update 
 ObjEmail.Send 

 End if 

 End if

The script does a backup of the system and pours it into the ftp:


 StrComputer = "." 
 Set WshShell = WScript.CreateObject ("WScript.Shell") 
 StrCommand = "C: \ WINDOWS \ system32 \ ntbackup.exe backup @C: \ cmd \ Back-UP-Drive-C.bks / a / v: no / r: no / rs: no / hc: off / m normal / J Back-UP-Drive-C / l: s / f D: \ Back-Up \ Backup-drive-c.bkf " 
 WshShell.Run strcommand, 1, true 

 Set objWMIService = GetObject ("winmgmts: \\" & strComputer & "\ root \ cimv2") 
 Set colItems = objWMIService.ExecQuery ("Select * from Win32_LocalTime") 

 For Each objItem in colItems 
 StrCommand = "C: \ Arch \ 7z.exe a D: \ Back-Up \ Backup-dc-srv-01-DayOf-Week -" & objItem.DayOfWeek & ". 7z D: \ Back-Up \ *. Bkf -t7z -m0 = BCJ2 -m1 = LZMA: d23 -m2 = LZMA: d19 -m3 = LZMA: d10M -mb0: 1 -mb0s1: 2 -mb0s2: 3 " 
 Next 
 WshShell.Run strcommand, 1, true 
 StrCommand = "ftp -s: C: \ CMD \ ctp-command.txt" 
 WshShell.Run strcommand, 1, true

The script blocks / unblocks users in AD, taking a list of their name from the specified file, and notifies the administrator by mail about the results:


 Dim Mlogins (9000), MAdspath (9000), MFullName (9000) 
 Dim objFileSystem, objInputFileFromKardy, strData 
 Set objFSO = CreateObject ("Scripting.FileSystemObject") 
 Const OPEN_FILE_FOR_READING = 1 

 'Specify domain 
 Const strDomainName = "<domain name eg domain.com>" 
 'We specify OU in AD, inside which we will look for 
 Const strStartOU = "Domain Users" 
 StrDomainDN = "DC =" & Replace (strDomainName, ".", ", DC =") 

 '--------------------- Getting Data --------------------- 
 Set objConnection = CreateObject ("ADODB.Connection") 
 ObjConnection.Open "Provider = ADsDSOObject;" 
 Set objCommand = CreateObject ("ADODB.Command") 
 ObjCommand.ActiveConnection = objConnection 
 ObjCommand.CommandText = "<LDAP: // OU =" & strStartOU & "," & strDomainDN & ">; (& (objectCategory = person) (objectClass = user)); ADsPath; subtree" 
 ObjCommand.Properties ("Page Size") = 4000 

 Set objRecordSet = objCommand.Execute 


 '------ Indexing -------- 
 Index = 0 
 While Not objRecordset.EOF 
 StrADsPath = objRecordset.Fields ("ADsPath") 
 Set objUser = GetObject (strADsPath) 
 MFullName (index) = objUser.DisplayName & "" 
 Mlogins (index) = objUser.sAMAccountName 
 MAdspath (index) = strADsPath 
 Index = index +1 
 ObjRecordset.MoveNext 

 Wend 
 ObjConnection.Close 

 Index = index-1 
 Maxindex = index 

 'The path to the file in which the list of people's names is stored. Account records of which you need to open / close 
 StrFileOfFiried = "d: \ file_of_firied.txt" 

 Set objFileSystem = CreateObject ("Scripting.fileSystemObject") 
 Set objInputFileFromKardy = objFileSystem.OpenTextFile (strFileOfFiried, OPEN_FILE_FOR_READING) 
 'We drive the contents of the file into an array 
 InputDataFromFiried = Split (objInputFileFromKardy.ReadAll, vbNewline) 
 'Reset the results lists 
 UserDisables = "" 
 UserUpdated = "" 
 UserNoFound = "" 
 UserDuplicated = "" 
 Ii = 0 


 For each strFULL In inputDataFromFiried 
 If Len (strFULL)> 5 then 
 'Reset the counter found matching 
 E = 0 
 '1st field: select from the line 
 StrFIO = Left (strFULL, InStr (strFULL, ";") - 1) 
 'We break apart by name 
 Familia = Left (strFIO, (Instr (strFIO, "") -1)) 
 N = Trim (mid (strFIO, Instr (strFIO, "")))) 
 Imya = Left (N, (Instr (N, "") -1)) 
 Otchestvo = Trim (mid (N, Instr (N, "")))) 
 'We collect by parts Name 
 StrFIO = Familia & "" & Imya & "" & Otchestvo


 Index = maxindex 
 While index> 1 

 'We split by parts the name in AD 

 AdFamilia = "" 
 AdImya = "" 
 AdOtchestvo = "" 
 AdFamilia = Left (MFullName (index), (Instr (MFullName (index), "") -1)) 
 If Len (Trim (mid (MFullName (index), Instr (MFullName (index), "")))))> 1 then 
 AdN = Trim (mid (MFullName (index), Instr (MFullName (index), "")))) 
 If Len (Left (AdN, (Instr (AdN, ""))))> 1 then 
 AdImya = Left (AdN, (Instr (AdN, "") -1)) 
 If Len (Trim (mid (AdN, Instr (AdN, ""))))> 1 then 
 AdOtchestvo = Trim (mid (AdN, Instr (AdN, "")))) 
 End if 
 End if 

 End if 


 'We collect by parts Name 
 AdstrFIO = AdFamilia & "" & AdImya & "" & AdOtchestvo

 AdstrFIO1 = AdImya & "" & AdOtchestvo & "" & AdFamilia 
 AdstrFIO2 = AdImya & "" & AdFamilia & "" & AdOtchestvo 
 'Wscript.Echo AdstrFIO 

 If (StrFIO = AdstrFIO) or (StrFIO = AdstrFIO1) or (StrFIO = AdstrFIO2) then 
 E = e + 1 
 Mindex = index 
 End if 
 Index = index-1 
 Wend 


 If e = 1 then 
 'We block login in AD 
 LockUser (Mlogins (Mindex)) 
 UserDisables = UserDisables & "User:" & strFIO & "is disabled" & vbCrLf 
 End if 
 Do not block / open, because.  We found several identical names 
 If e> 1 then 
 UserNoFound = UserNoFound & "User:" & strFIO & "is found more than 1 times" & vbCrLf 
 End if 
 Do not block / open, because.  User is not found 
 If e = 0 then 
 UserDuplicated = UserDuplicated & "User:" & strFIO & "is not found" & vbCrLf 
 End if 

 End if 


 Next 






 'If there is any result, then 
 If (len (UserDisables) + len (UserNoFound) + len (UserDuplicated)> 10) then 
 'Start sending mail 

 Set objNetwork = CreateObject ("Wscript.Network") 
 ObjComputerName = objNetwork.ComputerName 
 ObjUserName = objNetwork.UserName 
 Set objMessage = CreateObject ("CDO.Message") 
 ObjMessage.From = "<e-mail from whom the mail is sent>" 
 ObjMessage.To = "<e-mail to whom the mail is sent>" 
 ObjMessage.Subject = "Subject of the letter" 

 'We put the coding 
 ObjMessage.bodypart.charset = "koi8-r" 
 ObjMessage.TextBody = UserDisables & vbCrLf & UserNoFound & vbCrLf & UserDuplicated 
 ObjMessage.Configuration.Fields.Item _ 
 ("Http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
 'Name or IP of Remote SMTP Server 
 ObjMessage.Configuration.Fields.Item _ 
 ("Http://schemas.microsoft.com/cdo/configuration/smtpserver") = "<smtp server address>" 
 'Server port (typically 25) 
 ObjMessage.Configuration.Fields.Item _ 
 ("Http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
 ObjMessage.Configuration.Fields.Update 
 '== End remote SMTP server configuration section == 

 ObjMessage.Send 


 End if 



 ObjInputFileFromKardy.Close 
 Set objFileSystem = Nothing 
 Sub LockUser (strText) 
 'In this line, TRUE is the user's disable, FALSE - opens the user 
 StrDisableAccount = TRUE 

 StrUserLogin = strText 
 Set objUser = GetObject ("WinNT: // <domain> /" & strUserLogin & ", user") 


 If strDisableAccount = TRUE then 
 ObjUser.AccountDisabled = strDisableAccount 
 ObjUser.Description = "Account is Disabled because of firing" & "at" & "" & Date () 
 ObjUser.SetInfo 
 End if 

 If strDisableAccount = FALSE then 
 ObjUser.AccountDisabled = strDisableAccount 
 ObjUser.Description = "Account is Opened by script" & "at" & "" & Date () 
 ObjUser.SetInfo 
 End if 


 End Sub

This script is designed to copy a file to user-defined roaming profiles:


 // ************************************************ ***************************** 
 // JScript 2004 Shs 
 // This script is intended for copying a file to user roaming profiles 
 // (Add a shortcut in the user menu) 
 // ************************************************ ****************************** 
 // 
 // 
 // ************************************************ ***************************** 
 // The recursive function of the transition across all subdirectories starting from the given (PolFldr) 
 // and copy the specified file (ScriptName) to the specified folders (FldrName) 
 // ************************************************ ****************************** 
 Function LoopSubFolders (PolFldr, DeepCount) 
 { 
 Var SubFolders, // Collection of system policy podcasters 
 FsoPolFldr, // object to access the folder 
 CurFldr;  // the current folder 

 DeepCount ++; 
 //WScript.Echo(DeepCount); 
 If (DeepCount <DeepLimit) 
 { 
 FsoPolFldr = FSO.GetFolder (PolFldr); 
 // Get the collection of subdirectories of the system policy catalog 
 SubFolders = new Enumerator (fsoPolFldr.SubFolders); 
 // 
 For (;! SubFolders.atEnd (); SubFolders.moveNext ()) 
 { 
 CurFldr = SubFolders.item (); 
 If (CurFldr.Name == FldrName) 
 { 
 Try { 
 WScript.Echo (CurFldr.Path + "\\" + ScriptName); 
 //WScript.Echo(Path2Scripts + "\\" + ScriptName); 
 FSO.CopyFile (Path2Scripts + "\\" + ScriptName, CurFldr.Path + "\\" + ScriptName, true) 
 } 
 Catch (e) 
 {// handle possible errors 
 Var Msg; 
 If (e! = 0) Msg = "Error -" + e.description 
 Else Msg = "Ok"; 
 WScript.Echo (Msg); 
 } 
 } 
 // recursive call 
 LoopSubFolders (CurFldr, DeepCount); 
 } // end for 
 } // end if 
 } 
 // ************************************************ ******************************** 

 // 
 // 


 // ************************************************ ******************************** 

 // Stopper 
 // ************************************************ ******************************** 

 // here is the code, getting from the command line parameters 
 // 1) the name of the file being distributed 
 // 2) the name of the directory in each profile to which the distributed file will be copied 
 // ************************************************ ******************************** 

 Var ScriptName = "Updating the working menu.lnk", 
 FldrName = "Main Menu";  // The name of the desired subfolder in the profile (we will copy the shortcut file into it) 
 // ************************************************ ******************************** 
 ** 




 // ************************************************ ******************************** 
 * 
 // Declare Global Variables 
 // ************************************************ ******************************** 
 * 
 Var FSO, // FileSystemObject 
 Path2Scripts, // The path to the file to be distributed (it is assumed that the files are in the same folder as this file) 
 DeepCount, // Depth of recursion counter 
 DeepLimit, // Limiting the depth of recursion 
 PolF;  // Root, from which the search and distribution of files on the underlying folders begins 
 // ************************************************ ******************************** 
 * 
 PolF = "\\\\ DC \\ UserFolders \\ OZI";  //// 
 // Create the FileSystemObject; 
 FSO = WScript.CreateObject ("Scripting.FileSystemObject"); 
 DeepCount = 0; 
 Path2Scripts = FSO.GetParentFolderName (FSO.GetFile (WScript.ScriptFullName)); 
 // Limit the depth of recursive calls 
 DeepLimit = 4; 
 LoopSubFolders (PolF, DeepCount);

Inventory all machines in the domain:


 Dim strclass, objAD, obj 
 Dim invdate 
 Dim constmb, constgb, sizegb 
 Dim compname, temp, compad 
 Constmb = 1048576 
 Constgb = 1073741824 
 Strclass = array ("win32_ComputerSystem", "win32_bios", "win32_processor", _ 
 "Win32_diskdrive", "win32_videocontroller", "win32_NetworkAdapter", _ 
 "Win32_sounddevice", "win32_SCSIController", "win32_printer") 

 Set objAD = getobject ("LDAP: // CN = Computers, DC = aaa, DC = bbb, DC = ccc") 
 ObjAD.filter = array ("computer") 
 On error resume next 
 For each obj in objAD 
 CompAD = right (obj.name, len (obj.name) -3) 
 Invdate = date 
 Temp = "<html>" + chr (10) + "Collection date:" & invdate & "<table>" + chr (10) 
 Compname = "" 
 'On error resume next 
 Set objWMIService = GetObject ("winmgmts: //" & CompAD & "/ root \ cimv2") 
 I = 0 
 S = 0 
 D = 0 
 Q = 0 
 'Sizegb = "" 
 For a = 0 to 8 
 Set colitems = objwmiservice.instancesof (strclass (a)) 
 For each objitem in colitems 
 Select case a 
 Case 0 
 Temp = temp + "<tr> <td>" 
 Temp = temp + "Computer name" + "</ td> <td>" + objitem.name + "</ td>" + chr (10) 
 Temp = temp + "</ tr>" + chr (10) 
 Temp = temp + "<tr> <td>" 
 Temp = temp + "RAM +" </ td> <td> "+ cstr (round (objitem.totalphysicalmemory / constmb)) +" MB </ td> "+ chr (10) 
 Temp = temp + "</ tr>" + chr (10) 
 Temp = temp + "<tr> <td>" 
 Temp = temp + "Computer model" + "</ td> <td>" + objitem.model + "</ td>" + chr (10) 
 Temp = temp + "</ tr>" + chr (10) 
 Compname = objitem.name 
 Case 1 
 Temp = temp + "<tr> <td>" 
 Temp = temp + "Motherboard" + "</ td> <td>" + objitem.SMBIOSBIOSVersion + "</ td>" + chr (10) 
 Temp = temp + "</ tr>" + chr (10) 
 Temp = temp + "<tr> <td>" 
 Temp = temp + "BIOS" + "</ td> <td>" + objitem.caption + "</ td>" + chr (10) + "<td>" + chr (10) + "</ td>" 
 Temp = temp + "</ tr>" + chr (10) 
 Case 2 
 S = s + 1 
 Temp = temp + "<tr>" + chr (10) + "<td>" 
 Temp = temp + "CPU" + cstr (s) + "</ td>" + chr (10) + "<td>" + objitem.name + "Frequency" + cstr (objitem.CurrentClockSpeed) + chr (10) + " </ Td> " 
 Temp = temp + "</ tr>" + chr (10) 
 Case 3 
 I = i + 1 
 Temp = temp + "<tr>" + chr (10) + "<td>" 
 If objitem.size> 0 then '= nill then 
 Sizegb = cstr (round (objitem.size / constgb, 2)) 
 Else 
 Sizegb = cstr (0) 
 End if 
 Temp = temp + "hard disk" + cstr (i) + "</ td>" + chr (10) + "<td>" + objitem.model + "" sizegb + "GB </ td>" + chr 10) 
 Temp = temp + "</ tr>" + chr (10) 
 Case 4 
 Temp = temp + "<tr>" + chr (10) + "<td>" 
 Temp = temp + "video controller" + "</ td>" + chr (10) + "<td>" + objitem.caption + chr (10) + "</ td>" 
 Temp = temp + "</ tr>" + chr (10) 
 Case 5 
 If objitem.adaptertypeid = 0 and objitem.netconnectionstatus = 2 then 
 Temp = temp + "<tr>" + chr (10) + "<td>" 
 Temp = temp + "Network adapter" + "</ td>" + chr (10) 
 Temp = temp + "<td>" + objitem.name + chr (10) + "</ td>" 
 Temp = temp + "</ tr>" + chr (10) 
 End if 
 Case 6 
 Temp = temp + "<tr>" + chr (10) + "<td>" 
 Temp = temp + "Sound Card" + "</ td>" + chr (10) 
 Temp = temp + "<td>" + objitem.caption + chr (10) + "</ td> </ tr>" + chr (10) 
 Case 7 
 Temp = temp + "<tr>" + chr (10) + "<td>" 
 Temp = temp + "SCSI Adapter" + "</ td>" + chr (10) 
 Temp = temp + "<td>" + objitem.manufacturer + "" + objitem.caption + chr (10) + "</ td> </ tr>" + chr (10) 
 Case 8 
 D = d + 1 
 Temp = temp + "<tr>" + chr (10) + "<td>" 
 Temp = temp + "printer" + cstr (d) + "</ td>" + chr (10) + "<td>" + objitem.name + chr (10) + "</ td>" 
 Temp = temp + "</ tr>" + chr (10) 
 End select 
 Next 
 Next 
 'Final part 
 Temp = temp + "</ table> </ html>" 
 'Write a file 
 Dim fso, tf 
 Set fso = CreateObject ("Scripting.FileSystemObject") 
 Set tf = fso.CreateTextFile ("\\ servak \ comp \" & compname & ". Htm", True) 
 Tf.Write (temp) 
 Tf.Close 
 Next

Determining When an Account Expires (Returns the Expiration date for a user account):


 On Error Resume Next 
 Set objUser = GetObject _ 
 ("LDAP: // cn = myerken, ou = management, dc = fabrikam, dc = com") 

 DtmAccountExpiration = objUser.AccountExpirationDate 

 If err.number = -2147467259 Or _ 
 DtmAccountExpiration = "1/1/1970" Then 
 WScript.echo "No account expiration specified" 
 Else 
 WScript.echo "Account expiration:" & _ 
 ObjUser.AccountExpirationDate 
 End If

Determining When a User Account Expires (Reports the date that the MyerKen Active Directory user account expires.):

  On Error Resume Next 
 Set objUser = GetObject _ 
 ("LDAP: // cn = MyerKen, ou = Management, dc = NA, dc = fabrikam, dc = com") 
 DtmAccountExpiration = objUser.AccountExpirationDate 

 If Err.Number = -2147467259 Or dtmAccountExpiration = "1/1/1970" Then 
 WScript.Echo "No account expiration specified" 
 Else 
 WScript.Echo "Account expiration:" & objUser.AccountExpirationDate 
 End If

The script recursively establishes the attribute "User must change password on next logon" to all users of the domain: PS For correct operation, it is necessary to define the domain name in the variable strMyDomain from the LDAP point of view - i.e. Replace all points with "DC =". Thus, the domain argo.com turns into DC = argo, DC = com into the variable strMyOU, it is necessary to put the name Organization Unit, which users must be subjected to the procedure for changing the password.


 Dim strMyOU 
 Dim strMyDomain 

 Dim objOU, objUser 
 Dim strContainer, strLastUser 

 StrMyOU = "argo" 
 StrMyDomain = "DC = argo, DC = com" 

 Sub recurs (ou) 
 StrContainer = "OU =" + ou + "," + strMyDomain 
 Set objOU = GetObject ("LDAP: //" & strContainer) 
 For each objUser in objOU 
 StrLastUser = objUser.Get ("name") 
 If objUser.Class = "organizationalUnit" Then 
 Recurs (strLastUser + ", OU =" + ou) 
 Elseif objUser.Class = "user" Then 
 ObjUser.Put "pwdLastSet", 0 
 ObjUser.SetInfo 
 End if 
 Next 
 End Sub 

 Recurs strMyOU 

 WScript.Quit

Obtaining the SID (s) of a computer from AD:


 On Error Resume Next 
 Dim Tmp, x, b, Sid 
 Set objSysInfo = CreateObject ("ADSystemInfo") 
 StrComputerDN = objSysInfo.ComputerName 
 Set objCmp = GetObject ("LDAP: //" & strComputerDN) 
 Sid = objCmp.objectSID 
 GSID = "S-1-5 -" & Convert (16,19) & "-" & Convert (12,15) & "-" & Convert (8,11) & "-" & Convert (4,7) & "-" & Convert (0,3) 
 Set objGroup = Nothing 

 Function Convert (u, l) 
 Tmp = "" 
 For x = UBound (Sid) -u to UBound (Sid) -l Step -1 
 B = AscB (MidB (SID, x + 1)) 
 Tmp = Tmp & Hex (b \ 16) & Hex (b And 15) 
 Next 
 Convert = Clng ("& H" & Tmp) 
 End function 
 Wscript.echo (gSID)

Search for accounts in ActiveDirectory with expired passwords: If the NetBIOS domain name differs from DNS to the first point, then instead of the string dom = getObject ("LDAP: //" & DC) .get ("Name"), set the desired value


 On Error resume next 

 DC = getObject ("LDAP: // RootDSE") .get ("defaultNamingContext") 
 Dom = getObject ("LDAP: //" & DC) .get ("Name") 
 PwAge = getObject ("WinNT: //" & dom) .get ("MaxPasswordAge") / 86400 

 Set objConnection = createObject ("ADODB.Connection") 
 ObjConnection.open "Provider = ADsDSOObject;" 

 Set objCmd = createObject ("ADODB.Command") 
 ObjCmd.ActiveConnection = objConnection 

 '- Command for searching computer accounts 
 'Cmd = "<LDAP: //" & DC & ">; (objectClass = computer); distinguishedName, samAccountName; subtree" 

 '- Command for searching user accounts 
 Cmd = "<LDAP: //" & DC & ">; (objectCategory = person); distinguishedName, samAccountName; subtree" 

 ObjCmd.CommandText = cmd 

 Set col = objCmd.execute 

 If col.recordCount> 0 then 
 Col.moveFirst 
 While not col.EOF 
 Dn = col.fields (0) .value 
 Acc = col.fields (1) .value 

 Set obj = getObject ("LDAP: //" & dn) 
 AccCtrl = obj.get ("userAccountControl") 

 If (accCtrl and & h10000) = 0 then 
 pwChg=obj.PasswordLastChanged 
 if (Err.Number<>0) then 
 E=CStr(Err.Number) & " " & Err.Description 
 ' WScript.echo acc & space(16-len(acc)) & " - Error : " & E 
 Err.clear 
 Else 
 if (now-pwChg)>pwAge then 
 WScript.echo acc & space(16-len(acc)) & " - Expired : " & (pwChg+pwAge) 
 Else 
 ' WScript.echo acc & space(16-len(acc)) & " - Expire on : " & (pwChg+pwAge) 
 End if 
 End if 
 Else 
 ' WScript.echo acc & space(16-len(acc)) & " - Never Expire" 
 End if 
 col.moveNext 
 wend 
 end If 

 objConnection.close

Скрипт опрашивает компьютеры домена на предмет того, какой пользователь залогинен в данный момент на каждом компьютере :


 On Error Resume Next 

 Const ADS_SCOPE_SUBTREE = 2 

 Set objRoot = GetObject("LDAP://RootDSE") 
 strDomainName = objRoot.Get("DefaultNamingContext") 
 Set objRoot = Nothing 

 strComputer = "" 
 Dim fso 
 Dim file 

 Set fso = CreateObject("Scripting.FileSystemObject") 
 Set file = fso.OpenTextFile ("logged_user_list.txt", 2, True) 
 Set objShell = CreateObject("WScript.Shell") 

 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://" & strDomainName & "'" _ 
 & "Where objectClass ='computer'" 
 objCommand.Properties("Page Size") = 1000 
 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 Set objRecordSet = objCommand.Execute 

 & #39;**************************************************************************** 
 ****** 

 objRecordSet.MoveFirst 

 Wscript.Echo "Processing information. This might take several minutes." 

 Do Until objRecordSet.EOF 
 strComputer = objRecordSet.Fields("Name").Value 

 ' Проверяем доступность компьютера с помощью команды PING 
 ' и анализа выходного потока 

 Set objScriptExec = objShell.Exec("%comspec% /c ping.exe -n 1 " & strComputer) 
 strPingResults = LCase(objScriptExec.StdOut.ReadAll) 

 ' Если компьютер отвечает, подключаемся к его WMI 

 If InStr(strPingResults, "ttl=") Then 
 Set objWMIService = GetObject("winmgmts:" _ 
 & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 

 Set colComputer = objWMIService.ExecQuery _ 
 ("Select * from Win32_ComputerSystem") 

 ' Выводим список залогиненных пользователей в файл и на экран 

 For Each objComputer in colComputer 
 Wscript.Echo "Logged-on " &strComputer & " user: " & objComputer.UserName 
 file.WriteLine("Logged-on " &strComputer & " user: " & objComputer.UserName) 
 Next 
 objRecordSet.MoveNext 

 ' Если компьютер не отвечает - выводим сообщение и перемещаемся к следующему 

 Else 
 WScript.Echo(strComputer & ": Не отвечает...") 
 objRecordSet.MoveNext 
 End If 
 Loop

Этот скрипт просматривает системный журнал Безопасность и если обнаружит в нём запись об изменении настроек браузера, то уведомит об этом :


 On Error Resume Next 
 strComputer = "." 
 Set objWMIService = GetObject("winmgmts:" _ 
 & "{"{impersonationLevel=impersonate,(Security)}!\\" & strComputer & _ 
 "\root\cimv2") 
 Set colMonitoredEvents = objWMIService.ExecNotificationQuery _ 
 ("SELECT * FROM __InstanceCreationEvent WHERE TargetInstance ISA " _ 
 & "'Win32_NTLogEvent' AND TargetInstance.EventCode = '560' AND " _ 
 & "TargetInstance.Logfile = 'Security' GROUP WITHIN 2") 
 Do 
 Set objLatestEvent = colMonitoredEvents.NextEvent 
 strAlertToSend = "Internet Explorer security settings have been " & _ 
 "changed." 
 Wscript.Echo strAlertToSend 
 Loop

Скрипт ищет по всем контроллерам пользователей, которые не логинились уже более 90 дней и дизейблит их. После чего скидывает в файл их имена в форме Distinguished Name:


 Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery 
 Dim adoRecordset, objDC 
 Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs() 
 Dim strDN, dtmDate, objDate, lngDate, objList, strUser 
 Dim strBase, strFilter, strAttributes, lngHigh, lngLow 
 Dim intUAC, objCurrentUser 

 ' Использование объектов словаря чтоб потом узнать последние логоны пользователя. 
 Set objList = CreateObject("Scripting.Dictionary") 
 objList.CompareMode = vbTextCompare 

 ' Получение местного времени с реестра. 
 Set objShell = CreateObject("Wscript.Shell") 
 lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _ 
 & "TimeZoneInformation\ActiveTimeBias") 
 If (UCase(TypeName(lngBiasKey)) = "LONG") Then 
 lngBias = lngBiasKey 
 ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then 
 lngBias = 0 
 For k = 0 To UBound(lngBiasKey) 
 lngBias = lngBias + (lngBiasKey(k) * 256^k) 
 Next 
 End If 

 ' Получение конфигурациы и доменов из объектов RootDSE. 
 Set objRootDSE = GetObject("LDAP://RootDSE") 
 strConfig = objRootDSE.Get("configurationNamingContext") 
 strDNSDomain = objRootDSE.Get("defaultNamingContext") 

 ' Использование ADO чтобы искать в Active Directory ObjectClass nTDSDSA. 
 Set adoCommand = CreateObject("ADODB.Command") 
 Set adoConnection = CreateObject("ADODB.Connection") 
 adoConnection.Provider = "ADsDSOObject" 
 adoConnection.Open "Active Directory Provider" 
 adoCommand.ActiveConnection = adoConnection 

 strBase = "<LDAP://" & strConfig & ">" 
 strFilter = "(objectClass=nTDSDSA)" 
 strAttributes = "AdsPath" 
 strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 

 adoCommand.CommandText = strQuery 
 adoCommand.Properties("Page Size") = 100 
 adoCommand.Properties("Timeout") = 60 
 adoCommand.Properties("Cache Results") = False 

 Set adoRecordset = adoCommand.Execute 


 k = 0 
 Do Until adoRecordset.EOF 
 Set objDC = _ 
 GetObject(GetObject(adoRecordset.Fields("AdsPath")).Parent) 
 ReDim Preserve arrstrDCs(k) 
 arrstrDCs(k) = objDC.DNSHostName 
 k = k + 1 
 adoRecordset.MoveNext 
 Loop 
 adoRecordset.Close 

 ' Получение атрибута последнего логона для каждого пользователя в контроллерах домена. 
 For k = 0 To Ubound(arrstrDCs) 
 strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">" 
 strFilter = "(&(objectCategory=person)(objectClass=user))" 
 strAttributes = "distinguishedName,lastLogon" 
 strQuery = strBase & ";" & strFilter & ";" & strAttributes _ 
 & ";subtree" 
 adoCommand.CommandText = strQuery 
 On Error Resume Next 
 Set adoRecordset = adoCommand.Execute 
 If (Err.Number <> 0) Then 
 On Error GoTo 0 
 Wscript.Echo "Контроллер домена MGSM.RU не найден: " & arrstrDCs(k) 
 Else 
 On Error GoTo 0 
 Do Until adoRecordset.EOF 
 strDN = adoRecordset.Fields("distinguishedName") 
 lngDate = adoRecordset.Fields("lastLogon") 
 On Error Resume Next 
 Set objDate = lngDate 
 If (Err.Number <> 0) Then 
 On Error GoTo 0 
 dtmDate = #1/1/1601# 
 Else 
 On Error GoTo 0 
 lngHigh = objDate.HighPart 
 lngLow = objDate.LowPart 
 If (lngLow < 0) Then 
 lngHigh = lngHigh + 1 
 End If 
 If (lngHigh = 0) And (lngLow = 0 ) Then 
 dtmDate = #1/1/1601# 
 Else 
 dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _ 
 + lngLow)/600000000 - lngBias)/1440 
 End If 
 End If 
 If (objList.Exists(strDN) = True) Then 
 If (dtmDate > objList(strDN)) Then 
 objList.Item(strDN) = dtmDate 
 End If 
 Else 
 objList.Add strDN, dtmDate 
 End If 
 adoRecordset.MoveNext 
 Loop 
 adoRecordset.Close 
 End If 
 Next 

 ' Создание логов 
 Set objFSO = CreateObject("Scripting.FileSystemObject") 
 Set objScriptFile = objFSO.OpenTextFile("c:\scripts\Account_lockout.vbs", _ 
 ForReading) 
 Set objCommentFile = objFSO.OpenTextFile("c:\scripts\Lockedout_users.txt", _ 
 ForWriting, TRUE) 

 'Сравнение дат 

 dblCurrentdate = Cdbl(date) 
 Const ADS_UF_ACCOUNTDISABLE = 2 
 Const ForReading = 1 
 Const ForWriting = 2 

 For Each strUser In objList.Keys 

 dblUserdate = Cdbl(objList.Item(strUser)) 

 If (dblCurrentdate - dblUserdate > 90) Then 



 Set objCurrentUser = GetObject ("LDAP://" & strUser & "") 
 intUAC = objCurrentUser.Get("userAccountControl") 

 objCurrentUser.Put "userAccountControl", intUAC OR ADS_UF_ACCOUNTDISABLE 
 objCurrentUser.SetInfo 

 objCommentFile.Write strUser & VbCrLf 

 ' Wscript.Echo strUser & " заблокирован" 



 Else 

 ' Wscript.Echo strUser & " недавно логинился" 



 End if 


 Next 

 'Закрытие логов 
 objScriptFile.Close 
 objCommentFile.Close 


 ' Очистка. 
 adoConnection.Close 
 Set objRootDSE = Nothing 
 Set adoConnection = Nothing 
 Set adoCommand = Nothing 
 Set adoRecordset = Nothing 
 Set objDC = Nothing 
 Set objDate = Nothing 
 Set objList = Nothing 
 Set objShell = Nothing 
 Set objCurrentUser = Nothing

командный файл (closefl.bat ) закрывает все файлы, открытые пользователями в сети на вашем компьютере:

if exist d:\files.txt del d:\files.txt
net file > d:\files.txt
for /f "skip=5 tokens=1" %%i in (d:\files.txt) do net file %%i /close
del d:\files.txt

Скрипт для уведомления пользователя об окончании действия учетки в домене за 10 дней: строке - dtmDaysToExpire > 10 ). Бросать в логон. В 5-й и 7-й строке подставить свои значения для домена и подразделения.


 ' Script name: WarnUserAboutAccountExpiration.vbs 
 ' Created by Alex_GR - 26/05/2008 

 'Указываем домен 
 Const strDomainName="domen.com" 
 'Указываем OU в AD, внутри которой мы будем искать 
 Const strStartOU="Domain Users" 
 strDomainDN="DC="&Replace(strDomainName,".",",DC=") 

 On Error Resume Next 
 'Option Explicit 
 Dim strUserName, oNetwork, aConnection, aCommand, aResult, strDN, dtmAccountExpiration, dtmDaysToExpire, oShell 
 Set oNetwork = CreateObject("Wscript.network") 
 Set oShell = CreateObject("Wscript.shell") 
 strUserName = oNetwork.UserName 
 Set aConnection = CreateObject("ADODB.Connection") 
 Set aCommand = CreateObject("ADODB.Command") 
 aConnection.Provider = "ADsDSOObject" 
 aConnection.Open 
 aCommand.ActiveConnection = aConnection 
 aCommand.CommandText="<LDAP://OU="&strStartOU&","&strDomainDN&">;(&(objectCategory=User)(samAccountName=" & strUserName & "));distinguishedName;subTree" 
 Set aResult = aCommand.Execute() 
 strDN = aResult.Fields("distinguishedName") 
 Set objUser = GetObject("LDAP://" & strDN) 
 dtmAccountExpiration = objUser.AccountExpirationDate 
 dtmDaysToExpire = DateDiff("d", Now, dtmAccountExpiration) 
 If Err.Number = -2147467259 Or dtmAccountExpiration = "1/1/1970" Or dtmAccountExpiration = "01/01/1601 03:00:00" Or dtmAccountExpiration = "01.01.1601 03:00:00" Or dtmAccountExpiration = "1.1.1970" Or dtmDaysToExpire > 10 Then 
 ' Можно выводить другое сообщение, если найдено соответствие условию 
 ' MsgBox "Всe good " 
 Else 
 oShell.Popup "До окончания испытательного срока осталось " & dtmDaysToExpire & " дней!" & vbCrLf & _ 
 "Учётная запись действительна до " & dtmAccountExpiration & vbCrLf & _ 
 "Просьба об этом уведомить Вашего руководителя.", 60, "Уведомление от ИТ Департамента", 48+0 
 End If

Скрипт для поиска в активном каталоге пользователей с ограниченым сроком действия учётки и экспорта в файл: В 5-й и 7-й строке подставить свои значения для домена и подразделения.


 ' Script name: UserAccountExpirationDate.vbs 
 ' Created by Alex_GR - 12/05/2008 

 'Указываем домен 
 Const strDomainName="domen.com" 
 'Указываем OU в AD, внутри которой мы будем искать 
 Const strStartOU="Domain Users" 
 strDomainDN="DC="&Replace(strDomainName,".",",DC=") 

 ---------------------Получение данных-------------------- 
 Set objConnection = CreateObject("ADODB.Connection") 
 objConnection.Open "Provider=ADsDSOObject;" 
 Set objCommand = CreateObject("ADODB.Command") 
 objCommand.ActiveConnection = objConnection 
 objCommand.CommandText = "<LDAP://OU="&strStartOU&","&strDomainDN&">;(&(objectCategory=person)(objectClass=user));ADsPath;subtree" 
 objCommand.Properties("Page Size")=9000 

 Set objRecordSet = objCommand.Execute 

 Const ForAppending = 2 
 Set objFSO = CreateObject("Scripting.FileSystemObject") 
 Set objTextFile = objFSO.OpenTextFile ("c:\UserAccountExpirationDate.txt", ForAppending, True) 

 '------Индексирование -------- 
 While Not objRecordset.EOF 
 strADsPath = objRecordset.Fields("ADsPath") 
 Set objUser = GetObject(strADsPath) 

 dtmAccountExpiration = objUser.AccountExpirationDate 

 If err.number = -2147467259 Or dtmAccountExpiration = "01/01/1970" Or dtmAccountExpiration = "01/01/1601 03:00:00" Or dtmAccountExpiration = "01.01.1601 03:00:00" Or dtmAccountExpiration = "01.01.1970" Then 
 'Вывод сообщением 
 'WScript.echo "" 

 'запись в файл пустого значения 
 objTextFile.Write "" 
 objRecordset.MoveNext 

 Else 
 'Вывод сообщением 
 ' WScript.echo objUser.displayName & " - учётка действительна до: " & objUser.AccountExpirationDate 

 'Запись в файл 
 objTextFile.WriteLine objUser.displayName & " - учётка действительна до: " & objUser.AccountExpirationDate 
 objRecordset.MoveNext 
 End If 

 Wend 
 objConnection.Close 
 WScript.echo "Экспорт закончен, файл создан - C:\UserAccountExpirationDate.txt"

Скрипт який перевіряеє нових юзерів і відсилає ім лист з вказаним текстом: (переверяє з тією ж періодичністю з якою виконуеться скрипт тобто та яка вказана в Scheduled Tasks)


 'Created by Mike Ruman 8/13/05 
 'Sends an email to accounts created today. 

 Dim StrDate, CurrentUTC 

 'Create the current date and time stamp for query for day before last 
 CurrentUTC = DatePart("yyyy", Date) 
 'now add Month in mm if only M add leading 0 
 if DatePart("m" , Now) < 10 then 
 CurrentUTC = CurrentUTC & 0 & DatePart("m" , Now) 
 Else 
 CurrentUTC = CurrentUTC & DatePart("m" , Now) 
 End if 
 'now add Day in dd if only d add leading 0 
 if DatePart("d" , Now) < 10 then 
 'OPTIONAL - FOR MANY DAYS, replace line below with CurrentUTC = CurrentUTC & 0 & DatePart("d" , Now - X) where X = # of days 

 CurrentUTC = CurrentUTC & 0 & DatePart("d" , Now) 
 Else 
 'OPTIONAL - FOR MANY DAYS, replace line below with CurrentUTC = CurrentUTC & DatePart("d" , Now - X) where X = # of days 
 CurrentUTC = CurrentUTC & DatePart("d" , Now) 
 End if 
 ' Tag hour, minute, second on 
 strDate = CurrentUTC&"000001.0Z" 

 'Create AD Connection 
 Set oConnection1 = CreateObject("ADODB.Connection") 
 Set oCommand1 = CreateObject("ADODB.Command") 
 oConnection1.Provider = "ADsDSOObject" ' This is the ADSI OLE-DB provider name 
 oConnection1.Open "Active Directory Provider" 
 ' Create a command object for this connection. 
 Set oCommand1.ActiveConnection = oConnection1 
 'Set Query definition 
 ' тут задаем доменные параметры берем из AD 
 oCommand1.CommandText = "select mail from 'LDAP://DC=it, DC=local' WHERE objectCategory='Person' AND objectClass='user'AND msExchHideFromAddressLists<>'True' AND whenCreated>='" & strDate & "'" 

 oCommand1.Properties("Page Size") = 30000 
 ' Execute the query. 
 Set rs = oCommand1.Execute 


 rs.movefirst 
 'Create the loop of results 
 Do Until rs.EOF = True 


 'Create Email 
 ' настройки письма для пользователя 
 Set objEmail = CreateObject("CDO.Message") 
 objEmail.From = "[email protected]" 
 objEmail.To = rs.Fields("mail") 
 'Optional BCC field 
 'objEmail.BCC = "[email protected]" 
 objMessage.BodyPart.CharSet = "windows-1251" 
 objEmail.Subject = "A welcome message from Exchange" 
 objEmail.Textbody = "Добро пожаловать в ........." 
 'Optional Add an attachment 
 'objEmail.AddAttachment "C:\new_hire_audio_message.wav" 
 objEmail.Configuration.Fields.Item _ 
 ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
 objEmail.Configuration.Fields.Item _ 
 ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _ 
 "ExchangeServer" 'Replace ExchangeServer with server IP or name 
 objEmail.Configuration.Fields.Item _ 
 ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
 objEmail.Configuration.Fields.Update 
 'Optional - Read the message before it's sent 
 'MsgBox objEmail.GetStream.ReadText 
 objEmail.Send 
 rs.movenext 
 Loop 

 'Close AD Connection 
 oConnection1.close

Этот скрипт vbs, написанный мной спонтанно, позволяет устанавливать или сбрасывать флажок «разрешить удалённый доступ к этому компьютеру» на вкладке удалённые сеансы в свойствах системы! Теперь вы сможете подключаться к удалённому рабочему столу любой машины в вашей сети…: Переписать скрипт на любой язык программирования, включая мой любимый С++ не составит труда даже для самых юных кодеров! VBS выбран мной только из соображений лени, если так можно выразиться (под руками был генератор скриптов именно vbs) правда править его ручками пришлось всё равно!


 1. подставьте нужные значения 
 strComputer = "ИмяУдалённогоКомпьютера" 
 strDomain = "ИмяДомена" 
 2. подставьте имя машины на которой запускаете скрипт 
 ServerName='ИмяКомпьютера' 
 3. параметр = 1 установит флажок параметр = 0 сбросит его 
 objInParam.Properties_.Item("AllowTSConnections") = 1 

 Запустить скрипт легко по контекстному меню смотрите рисунки. 

 PS Проверено на 32 битных и 64 битных системах (WindowsServer2003, WindowsXP) 

 strComputer = "ИмяУдалённогоКомпьютера" 
 strDomain = "ИмяДомена" 
 Wscript.StdOut.Write "Please enter your user name:" 
 strUser = Wscript.StdIn.ReadLine 
 Set objPassword = CreateObject("ScriptPW.Password") 
 Wscript.StdOut.Write "Please enter your password:" 
 strPassword = objPassword.GetPassword() 
 Wscript.Echo 

 Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator") 
 Set objWMIService = objSWbemLocator.ConnectServer(strComputer, _ 
 "root\CIMV2", _ 
 strUser, _ 
 strPassword, _ 
 "MS_409", _ 
 "ntlmdomain:" + strDomain) 
 ' Obtain an instance of the the class 
 ' using a key property value. 
 Set objShare = objWMIService.Get("Win32_TerminalServiceSetting.ServerName='ИмяКомпьютера'") 

 ' Obtain an InParameters object specific 
 ' to the method. 
 Set objInParam = objShare.Methods_("SetAllowTSConnections").  _ 
 inParameters.SpawnInstance_() 


 ' Add the input parameters. 
 objInParam.Properties_.Item("AllowTSConnections") = 1 

 ' Execute the method and obtain the return status. 
 ' The OutParameters object in objOutParams 
 ' is created by the provider. 
 Set objOutParams = objWMIService.ExecMethod("Win32_TerminalServiceSetting.ServerName='ИмяКомпьютера'", "SetAllowTSConnections", objInParam) 

 ' List OutParams 
 Wscript.Echo "Out Parameters: " 
 Wscript.echo "ReturnValue: " & objOutParams.ReturnValue

выключить--включить адаптер:


 strNetConn = "Сетевые подключения" ' Network Connections для англ. версии ОС 
 strConn = "Подключение по локальной сети" ' имя или часть имени подключения 
 strEnable = "&Включить" ' En&able для англ. версии ОС 
 strDisable = "&Отключить" ' Disa&ble для англ. версии ОС 

 Set objShell = CreateObject("Shell.Application") 
 Set objCP = objShell.Namespace(3) ' Панель управления 
 For Each elem in objCP.Items 
 If elem.Name = strNetConn Then 
 ' получение папки "Сетевые подключения" 
 Set colNetwork = elem.GetFolder 
 Exit For 
 End If 
 Next 

 Set Conn = Nothing 
 For Each clsConn in colNetwork.Items 
 If Instr(LCase(clsConn.name), LCase(strConn)) Then 
 ' получение указанного подключения 
 Set Conn = clsConn 
 Exit For 
 End If 
 Next 
 If Conn Is Nothing Then 
 WScript.Echo "Network Connection not found" 
 WScript.Quit 
 End If 

 bEnabled = True 
 Set objEnable = Nothing 
 Set objDisable = Nothing 
 For Each clsVerb in Conn.verbs 
 ' если доступен глагол "Enable", подключение отключено 
 If clsVerb.Name = strEnable Then 
 Set objEnable = clsVerb 
 bEnabled = False 
 End If 
 ' если доступен глагол "Disable", подключение подключено 
 If clsVerb.name = strDisable Then 
 Set objDisable = clsVerb 
 End If 
 Next 

 If bEnabled Then 
 objDisable.DoIt 
 strStatus = "disabled." 
 Else 
 objEnable.DoIt 
 strStatus = "enabled." 
 End If 
 WScript.Sleep 1000 

 WScript.Echo Conn.Name & " " & strStatus

Скрипт для перезапуска ADSL мопеда D-link DSL-2640U: "telnet.exe 192.168.1.1" - или другой IP на котором сидит модем Будет работать и на других моделях но возможно придется посмотреть в телнете что писать в oShell.SendKeys "??" & chr(13) после того как залогинишся

 rem Заходим на мопед 
 Set oShell = WScript.CreateObject("WScript.Shell") 
 oShell.Run "telnet.exe 192.168.1.1" 
 WScript.Sleep 1000 
 oShell.SendKeys "Имя" & chr(13) 
 WScript.Sleep 1000 
 oShell.SendKeys "Пароль" & chr(13) 
 rem Перезапускаем 
 WScript.Sleep 1000 
 oShell.SendKeys "13" & chr(13) 
 WScript.Sleep 1000 
 oShell.SendKeys "1" & chr(13)

скрипт для создания учеток пользователей из списка. (txt, xls): где файл users.csv должен содержать информацию о юзерах в следующем формате.

Import-CSV users.csv | ForEach-Object { New-QADUser -ParentContainer scorpio.local/users -Name ($_.Familia + ', ' + $_.Imya) -samAccountName ($_.Imya[0] + $_.Familia) -Department $_.Department -Title $_.Title}

Перезапуск служб apache , mysql , cron , sendmail :

#!/bin/bash
echo "Services restart: ";

cd /etc/rc.d/init.d/
./httpd restart
./mysqld restart
./crond restart
./sendmail restart

Liked? Subscribe to RSS news!
You can also support shram.kiev.ua, press:

It will not be superfluous for your friends to learn this information, share their article with them!

Expand / Collapse

Comments

Commenting on, remember that the content and tone of your message can hurt the feelings of real people, show respect and tolerance to your interlocutors even if you do not share their opinion, your behavior in the conditions of freedom of expression and anonymity provided by the Internet, changes Not only virtual, but also the real world. All comments are hidden from the index, spam is controlled.