VPF::Полезные скрипты - Форум программистов

localhost

Дата 29.2.2008, 11:26 (ссылка)

(нет голосов)

Загрузка ...

Хирург-длятехкт

Профиль
Группа: Участник
Сообщений: 712
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43

Скрипт, детектирующий и пытающийся исправить распространенную проблему при запуске служб Automatic Updates и BITS

Код


' Скрипт, детектирующий и пытающийся исправить распространенную проблему при запуске служб Automatic Updates и BITS
' на клиентских компьютерах, связанную с ошибками использования идентификатора безопасности (EventID 7023, 7024).
' Данная проблема проявляется на клиентских компьютерах при изменении групповых политик
' При обнаружении указанной проблемы, скрипт сбрасывает идентификатор безопасности, в соответствии
' с KnowlegeBase Microsoft http://support.microsoft.com/kb/555336 и запускает данные службы.
' Может быть полезен тем, кто использует в своей сети Windows Server Update Services 3.0 (WSUS)
' Данный скрипт можно прописать в групповых политиках в качестве logon-скрипта.
' Добавления и замечания, просьба писать в ПМ

' BEGIN :)

' Инициализируем переменные и WMI-моникер
strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

' Выбираем из списка процессов интересующие нас Automatic Updates и BITS
Set colListOfServices = objWMIService.ExecQuery _
    ("Select * from Win32_Service Where Name = 'BITS' or Name = 'wuauserv'")

' Применительно к каждому из выбранных процессов:
For Each objService in colListOfServices
    isStarted = 0
    ' Провеяем его состояние. Если он остановлен, то
    If  objService.State = "Stopped" Then
     ' Пытаемся запустить. 
     WScript.Echo ("Service " & objService.Name & " Stopped")
     isStarted = objService.StartService()
  
     ' Если при запуске получаем ту самую проблему, пытаемся ее поправить (исправление оформлено в виде функции Repair)
     If objService.ExitCode <> 0 Then 
         WScript.Echo("WARNING!!! Error occured, when try to started...")
         WScript.Echo ("Try to repair..." & objService.Name)
            intCode = Repair(strComputer)
            If intCode = 0 Then 
                WScript.Echo("Done...")
                objService.StartService
            Else WScript.Echo("Failed To Repair")
            End If 
     Else If objService.ExitCode = 0 Then WScript.Echo ("Successfully stated...")
     End If
    End If
Next

Function Repair(strComputer)

    strCommandLine = "sc sdset " & objService.Name & " " & Chr(34) & "D:(A;;CCLCSWRPWPDTLOCRRC;;;SY)(A;;CCDCLCSWRPWPDTLOCRSDRCWDWO;;;BA)(A;;CCLCSWLOCRRC;;;AU)(A;;CCLCSWRPWPDTLOCRRC;;;PU)" & Chr(34)
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
    ' Obtain the definition of the class.
    Set objShare = objWMIService.Get("Win32_Process")

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


    ' Add the input parameters.
    objInParam.Properties_.Item("CommandLine") = strCommandLine

    ' Execute the method and obtain the return status.
    ' The OutParameters object in objOutParams
    ' is created by the provider.
    Set objOutParams = objWMIService.ExecMethod("Win32_Process", "Create", objInParam)

    ' List OutParams
    'WScript.Echo "Out Parameters: "
    'WScript.echo "ProcessId: " & objOutParams.ProcessId
    Repair = objOutParams.ReturnValue
End Function

Это сообщение отредактировал(а) Akella - 7.3.2008, 22:06

--------------------

ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: [email protected]

user posted image

mihanik

Дата 2.3.2008, 00:14 (ссылка)

(нет голосов)

Загрузка ...

-=Белый Медведь=-

Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 61
Всего: 109

"Маленький " скриптик для просмотра некоторых сетевых настроек...

Код


'********************************************************************
'* Declare main constants
'********************************************************************
CONST CurrentBuild             = "ShowNetSettings 0.1"           ' Имя текущего билда.

Dim MenuItem, Question, FullName, Name, Domen

On Error Resume Next

' Проверим установлен ли необходимый сервер сценариев.
    If Not IsEngineCScript Then
        ' Установим необходимый тип сервера сценариев
        Call NotEngineCScript
    End If
    
' Выведем имя автора скрипта
    Call PrintAutorName
    
    WScript.Echo
    WScript.Echo "Сетевые настройки компьютера:"
    WScript.Echo
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

    Set colItems = objWMIService.ExecQuery("Select * from Win32_Proxy")

    For Each objItem in colItems
        FullName = objItem.ServerName
        Wscript.Echo "Имя компьютера:            " & objItem.ServerName
        Wscript.Echo "Прокси-сервер:            " & objItem.ProxyServer
        WScript.Echo "Номер порта прокси-сервера:    " & objItem.ProxyPortNumber
        Wscript.Echo
    Next
    
    strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colAdapters = objWMIService.ExecQuery _
    ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")

WScript.Echo "У компьютера обнаружено сетевых адаптеров : " & colAdapters.Count

n = 1
WScript.Echo
 
For Each objAdapter in colAdapters
   WScript.Echo "Сетевой адаптер № " & n
   WScript.Echo "==================="
   WScript.Echo "Описание:        " & objAdapter.Description
 
   WScript.Echo "Физический (MAC) адрес: " & objAdapter.MACAddress
   WScript.Echo "Имя компьютера:        " & objAdapter.DNSHostName
 
   If Not IsNull(objAdapter.IPAddress) Then
      For i = 0 To UBound(objAdapter.IPAddress)
        If CStr(objAdapter.IPAddress(i))="0.0.0.0" Then 
          WScript.Echo "IP-адрес:        " & objAdapter.IPAddress(i) & " - Адрес не получен!"
         Else 
          If Mid(CStr(objAdapter.IPAddress(i)),1,7)="169.254" Then
              WScript.Echo "IP-адрес:        " & objAdapter.IPAddress(i) & " - Сетевое подключение ограничено или отсутствует!"
          Else
              WScript.Echo "IP-адрес:        " & objAdapter.IPAddress(i)
          End If
         End If 
      Next
   End If
 
   If Not IsNull(objAdapter.IPSubnet) Then
      For i = 0 To UBound(objAdapter.IPSubnet)
       If CStr(objAdapter.IPSubnet(i)) = "255.255.0.0" Or CStr(objAdapter.IPSubnet(i)) = "255.255.255.0" Then
         WScript.Echo "Маска сети:        " & objAdapter.IPSubnet(i) & " - Вероятно это локальный адрес..."
        Else    
         WScript.Echo "Маска сети:        " & objAdapter.IPSubnet(i)
        End If
      Next
   End If
 
   If Not IsNull(objAdapter.DefaultIPGateway) Then
      For i = 0 To UBound(objAdapter.DefaultIPGateway)
         WScript.Echo "Шлюз по умолчанию:    " & _
             objAdapter.DefaultIPGateway(i)
      Next
   End If
 
 WScript.Echo
   WScript.Echo "  Записи DNS"
   WScript.Echo "  ----------"
   WScript.Echo "  Список DNS-серверов:"
 
   If Not IsNull(objAdapter.DNSServerSearchOrder) Then
      For i = 0 To UBound(objAdapter.DNSServerSearchOrder)
         WScript.Echo "      " & objAdapter.DNSServerSearchOrder(i)
      Next
   End If
 
   WScript.Echo "  DNS-домены: " & objAdapter.DNSDomain
 
   If Not IsNull(objAdapter.DNSDomainSuffixSearchOrder) Then
      For i = 0 To UBound(objAdapter.DNSDomainSuffixSearchOrder)
         WScript.Echo "    DNS suffix search list: " & _
             objAdapter.DNSDomainSuffixSearchOrder(i)
             If Len(CStr(objAdapter.DNSDomainSuffixSearchOrder(i))) <> 0 Then Domen = objAdapter.DNSDomainSuffixSearchOrder(i)

      Next
   End If
 
    n = n + 1
     WScript.Echo
Next
        
    WScript.Echo "Для завершения работы нажмите <Enter>."
    Question = WScript.StdIn.ReadLine

WScript.Quit

'********************************************************************
'*
'* Функция   IsEngineCScript()
'* Описание: Определяет тип сервера сценариев.
'* Вход    : Нет
'* Выход   : True если используется CScript.
'*
'********************************************************************

Function IsEngineCScript()

Dim strFullName, strCommand, i, j

ON ERROR RESUME NEXT

    IsEngineCScript = False

' Получим полное имя файла исполнителя сервера сценариев
' В случае ошибки остановим выполнение скрипта

    strFullName = WScript.FullName
    If Err.Number Then
'
' Во время проверки типа сервера сценариев возникла ошибка.
' Error номер ошибки: расшифровка ошибки
' Выполнение программы остановлено."
'
       msgbox  "При определении типа сервера сценариев произошла ошибка." & vbcrlf & _ 
               "Error " & Err.Number & ": " & Err.Description & vbcrlf & _
               "Выполнение программы остановлено.", vbCritical, CurrentBuild
       WScript.Quit
    End if

    i = InStr(1, strFullName, ".exe", 1)
    If i = 0 Then
        Exit Function
    Else
        j = InStrRev(strFullName, "\", i, 1)
        If j = 0 Then
            Exit Function
        Else
            strCommand = Mid(strFullName, j+1, i-j-1)
            Select Case LCase(strCommand)
                Case "cscript"
                     IsEngineCScript = True
                Case "wscript"
                     'IsEngineCScript уже False мы ничего не делаем
                Case Else

' Обработаем невероятный случай :-)
' Для выполнения данного скрипта используется неизвестный тип сервера сценариев.
' Только CScript.Exe или WScript.Exe могут быть использованы для запуска этого скрипта.
' Выполнение программы остановлено.

                     msgbox "Для выполнения данного скрипта используется неизвестный тип сервера сценариев." & vbcrlf & _
                    "Только CScript.Exe или WScript.Exe могут быть использованы для запуска этого скрипта." & vbcrlf & _
                    "Выполнение программы остановлено.", vbCritical, CurrentBuild
                     WScript.Quit
            End Select
        End If
    End If

End Function

'********************************************************************
'*
'* Процедура NotEngineCScript()
'* Описание: Устанавливает тип сервера сценариев по умолчанию.
'* Вход    : Нет
'* Выход   : Нет
'*
'********************************************************************
Sub NotEngineCScript ()
Dim strA               ' Ответ человека
Dim WshShell, oExec    ' Для запуска внешних программ...

   ON ERROR RESUME NEXT

       ' Проверим, при помощи какого сервера сценариев выполняется скрипт
       strA = msgbox( "      Вы используете сервер сценариев отличный от CScript." & vbcrlf & _
                    "Выводимые на экран сообщения могут стать сюрпризом для Вас..."  & vbcrlf & _
                    "        Сделать CScript сервером сценариев по умолчанию?" & vbcrlf & _
                    "                (Потребуется перезапуск скрипта)", VbYesNo, CurrentBuild)
       If strA = VbYes Then
          Set WshShell = CreateObject("WScript.Shell")
          Set oExec = WshShell.Exec("cscript.exe /h:cscript")
              If Err.Number Then
'
' Во время назначения сервера сценариев, используемого по умолчанию, возникла ошибка.
' Error номер ошибки: расшифровка ошибки
' Выполнение программы остановлено."
'
                 msgbox "Во время назначения сервера сценариев, используемого по умолчанию, возникла ошибка." & _
                         vbcrlf & "Error " & Err.Number & ": " & Err.Description & vbcrlf & _ 
                         "Выполнение программы остановлено.", vbCritical, CurrentBuild
                 WScript.Quit
              Else
'
' Запустите скрипт ещё раз!
'
                 msgbox  "Запустите скрипт ещё раз!" , vbInformation , CurrentBuild
                 WScript.Quit
              End if
       Else
' К сожалению скрипт не может продолжить работу!
' Переназначьте используемый по умолчанию сервер сценариев.
           msgbox "      К сожалению скрипт не может продолжить работу!" & vbcrlf & _
                  "Переназначьте используемый по умолчанию сервер сценариев.", vbCritical, CurrentBuild
           WScript.Quit
       End If
End Sub

'********************************************************************
'*
'* Процедура PrintAutorName()
'* Описание: Выводим информацию об авторе скрипта.
'* Вход    : Нет
'* Выход   : Нет
'*
'********************************************************************
Sub PrintAutorName ()
Dim S

' Формируем сточку из звёздочек для обрамления имени автора.
    S = String( 34, "*")

' Выводим имя автора в рамочке из звёздочек.
    Wscript.Echo S
    Wscript.Echo "* " & "(с) Михаил Медведев. 2008 год." & " *"
    Wscript.Echo S
    Wscript.Echo

End sub

Это сообщение отредактировал(а) Akella - 7.3.2008, 22:08

--------------------

Программистами не рождаются, - это родовая травма...

Штык

Дата 27.3.2008, 16:08 (ссылка)

(голосов:1)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 206
Регистрация: 9.5.2005
Где: Москоу

Репутация: нет
Всего: 1

Скрипт пишущий в Описание компьютера какой пользователь сейчас залогинен на рабочей станции

в функции right число 8 означает длину вашего доменного имени(не стал писать функцию по подсчету символов)

Код



    On Error Resume Next
 
        strComputer = "."
          
        Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        Set colComputer = objWMIService.ExecQuery _
        ("Select * from Win32_ComputerSystem")
  
        For Each objComputer In colComputer
             strNewDescription = objComputer.UserName
        Next
     
        st=right(strNewDescription,len(strNewDescription)-8)
     
        Set colItems = objWMIService.ExecQuery( _
         "SELECT * FROM Win32_UserAccount WHERE Name='" & st & "'", , 48)
        For Each objItem In colItems
          strNewDescription = objItem.FullName
        Next 
         
       Set objWMIService = GetObject("winmgmts:\\" & strComputer).InstancesOf("Win32_OperatingSystem")
        For Each x In objWMIService      
            x.Description = strNewDescription
            x.Put_
        Next

Это сообщение отредактировал(а) Штык - 27.3.2008, 16:12

--------------------

Lachetes familieresQui nous rendent guerrieres

localhost

Дата 2.4.2008, 09:13 (ссылка)

(нет голосов)

Загрузка ...

Хирург-длятехкт

Профиль
Группа: Участник
Сообщений: 712
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43

Скрипт бэкапа файлопомойки (можно приспособить под любые сетевые файловые ресурсы) с помощью WinRAR и записью в лог-файл о возникших ошибках.

Параметры:
C:\backup_scripts\log\share_out_error.log - путь к файлу для записи подробного описания ошибок.
C:\backup_scripts\log\share_out.log - путь к файлу с общим результатом работы скрипта.
E:\backup\share\ - путь к каталогу, где будут храниться архивы
C:\backup_scripts\exclude.lst - путь к файлу со списком исключений (файлы и маски, перечисленные в нем, обрабатываться не будут)
\\fileserver\d$\shared\* - собственно, путь к файлопомойке. В данном примере, скрипт запускается на т.н. бэкап-сервере под пользователем, имеющем право доступа к файл-серверу.

Цитата

@echo off
SET ERRORLOG=
rar.exe a -ilogC:\backup_scripts\log\share_out_error.log E:\backup\share\share -x@C:\backup_scripts\exclude.lst -rr3p -agDD-MM-YYYY -m3 -r \\fileserver\d$\shared\*

IF ERRORLEVEL 1 (echo %DATE% %TIME% SHARE : WARNING!!! Error exist!!! Exit Code: %ERRORLEVEL% For more details see share_out_error.log >> C:\backup_scripts\log\share_out.log) ELSE (echo %DATE% %TIME% SHARE : Backup successfully created! Code %ERRORLEVEL% >> C:\backup_scripts\log\share_out.log)

Можно скрипт запускать в Планировщике. Имя архива формируется путем добавления даты создания к имени архива.

Это сообщение отредактировал(а) localhost - 2.4.2008, 09:18

--------------------

ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: [email protected]

user posted image

localhost

Дата 17.4.2008, 14:49 (ссылка)

(нет голосов)

Загрузка ...

Хирург-длятехкт

Профиль
Группа: Участник
Сообщений: 712
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43

Скрипт проверки доступности сервера/компьютера

При желании видоизменяется как угодно smile

Вопросы, дополнения - в ПМ
У себя применяю для отслеживания функционирования важных бизнес-процессов. В Sheduled Tasks данный скрипт запускается каждые 10 минут.

Код


' Скрипт проверки доступности сервера/компьютера
' При недоступности или превышении допустимого времени отклика,
' скрипт отсылает уведомление администратору средставми net send

' Параметры конфигурации
strAdmin = "admin"        ' Имя компьютера, на который будут идти уведомления
intResponseTime = 50    ' Максимально допустимое время отклика    
strMachines = "www.server1.ru;www.server2.ru;www.server3.ru"    ' Тестируемые компьютеры (через точку с запятой)

' Начало скрипта
aMachines = split(strMachines, ";")
strCommand = "%comspec% /c net send " & strAdmin & " "
Set WshShell = Wscript.CreateObject("Wscript.Shell")
 
For Each machine in aMachines
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
        ExecQuery("select * from Win32_PingStatus where address = '"_
            & machine & "'")
    For Each objStatus in objPing
        If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then 
            ' Код обработки ситуации, когда ресурс недоступен
            strMessage = "WARNING!!! " & machine & " is not reachable!!!"
            WshShell.Run strCommand & Chr(34) & strMessage & Chr(34) 
        Else 
         If objStatus.ResponseTime > intResponseTime Then 
             ' Код обработки ситуации, если велико время отклика
             strMessage = "WARNING!!! Response time from " & machine & " is too big! (" & objStatus.ResponseTime & ")"
             WshShell.Run strCommand & Chr(34) & strMessage & Chr(34)
         Else
             ' Код обработки, когда "все в порядке" :)
         End If
        End If
    Next
Next

Set WshShell = Nothing
Set objPing = Nothing

Это сообщение отредактировал(а) localhost - 17.4.2008, 14:55

--------------------

ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: [email protected]

user posted image

mihanik

Дата 3.5.2008, 20:07 (ссылка)

(нет голосов)

Загрузка ...

-=Белый Медведь=-

Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 61
Всего: 109

Выношу на суд админов подборку из процедур и функций, позволяющих управлять в Windows XP учётными записями ЛОКАЛЬНЫХ пользователей.

Код


'#####################################################################
'#
'# Функция   GetUserList()
'# Описание: Возвращает список имём всех учётных записей на локальном компьютре
'# Вход    : Нет
'# Выход   : Символьная строка, содержащая имена пользователей, разделённые ";"
'#####################################################################
Function GetUserList()
Dim S
Dim objWMIService, colItems, objItem
    
    S = ""    
    
    On Error Resume Next
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

        Set colItems = objWMIService.ExecQuery _
            ("Select * from Win32_UserAccount Where LocalAccount = True")
        
            For Each objItem in colItems
                    If S = "" Then S = objItem.Name Else S = S & ";" & objItem.Name
            Next
        
        Set colItems = Nothing
    Set objWMIService = Nothing
    
    On Error Goto 0 
    
    GetUserList = S
    
End Function

'#####################################################################
'#
'# Функция   GetGroupList()
'# Описание: Возвращает список имён всех групп на локальном компьютре
'# Вход    : Нет
'# Выход   : Символьная строка, содержащая имена групп, разделённые ";"
'#####################################################################
Function GetGroupList()
Dim S
Dim objWMIService, colItems, objItem
    
    S = ""

    On Error Resume Next
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    
    Set colItems = objWMIService.ExecQuery _
        ("Select * from Win32_Group  Where LocalAccount = True")

    For Each objItem in colItems
        If S = "" Then
            S = objItem.Name 
        Else
            S = S & ";" & objItem.Name 
        End If
    Next
    
    On Error Goto 0
    
    GetGroupList = S

End Function

'#####################################################################
'#
'# Функция   BuildinAdministratorName()
'# Описание: Определяет имя встроенной учётной записи локального администратора
'# Вход    : Нет
'# Выход   : Имя встроенного локального администратора (String)
'#####################################################################
Function BuildInAdministratorName()
Dim AdmSID        ' SID пользователя
Dim objWMIService, colItems, objItem
    
    On Error Resume Next

    BuildInAdministratorName = ""
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

    Set colItems = objWMIService.ExecQuery _
        ("Select * from Win32_UserAccount Where LocalAccount = True")
    
    For Each objItem in colItems
        AdmSID = Mid(objItem.SID,1,6) & "*" & _
              Mid(objItem.SID, InStrRev(objItem.SID,"-"), _
              Len(objItem.SID)-InStrRev(objItem.SID,"-")+1)
        
        If AdmSID = "S-1-5-*-500" Then
         BuildInAdministratorName = objItem.Name
            Exit For
        End If
    Next
    
    Set colItems = Nothing
    Set objWMIService = Nothing
    
    On Error Goto 0 
    
End Function

'#####################################################################
'#
'# Процедура CreateLocalUser
'# Описание: Создаёт учётную запись пользователя  
'# Вход    : strUserName - Имя пользователя
'#             strPassword - пароль пользователя
'# Выход   : Нет
'#####################################################################
Sub CreateLocalUser (byVal strUserName, byVal strPassword)
Dim objComputer
Dim strComputer
Dim colAccounts
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set colAccounts = GetObject("WinNT://" & strComputer & "")
        Set objUser = colAccounts.Create("user", strUserName)
            objUser.SetPassword strPassword
            objUser.SetInfo
        Set objUser = Nothing
    Set colAccounts = Nothing    

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserPassword
'# Описание: Устанавливает пароль для локальной учётной записи
'# Вход    : strUserName - Имя пользователя
'#             strPassword - Пароль пользователя
'# Выход   : Нет
'#####################################################################
Sub SetUserPassword (byval strUserName, byval strPassword)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.SetPassword strPassword
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserDescription
'# Описание: Устанавливает описание для локальной учётной записи
'# Вход    : strUserName - Имя пользователя
'#             strDescription - Описание пользователя
'# Выход   : Нет
'#####################################################################
Sub SetUserPassword (byval strUserName, byval strDescription)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.Description = strDescription
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserFullName
'# Описание: Устанавливает полное имя для локальной учётной записи
'# Вход    : strUserName - Имя пользователя
'#             strFullName - Полное имя пользователя
'# Выход   : Нет
'#####################################################################
Sub SetUserFullName (byval strUserName, byval strFullName)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.FullName = strFullName
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetCommonProperties
'# Описание: Управляет общими свойствами (галками) учётной записи.
'#             
'# Вход    : byVal strUserName                    - имя пользователя
'#             ByVal blnRequireChangePassword     - требовать/не требовать менять пароль при следующем входе
'#             ByVal blnUserCanNotChangePassword  - может/не может пользователь менять свой пароль
'#             ByVal blnNeverExpirePassword        - пароль пользователя никогда не "сгорает" (да/нет)
'#             ByVal blnAccountDisabled            - пользователь включен/выключен
'# Выход   : Нет
'#####################################################################
Sub SetCommonProperties (byVal strUserName, ByVal blnRequireChangePassword, _
                                            ByVal blnUserCanNotChangePassword, _
                                            ByVal blnNeverExpirePassword, _
                                            ByVal blnAccountDisabled )
Dim objComputer
Dim strComputer
Dim colAccounts
Dim objFlag
Dim objUserFlags
Dim objUser


Const ADS_UF_SCRIPT = &H1                             ' The logon script will be executed
Const ADS_UF_ACCOUNTDISABLE = &H2                     ' Disable user account
Const ADS_UF_HOMEDIR_REQUIRED = &H8                   ' Requires a root directory
Const ADS_UF_LOCKOUT = &H10                           ' Account is locked out
Const ADS_UF_PASSWD_NOTREQD = &H20                    ' No password is required
Const ADS_UF_PASSWD_CANT_CHANGE = &H40                ' The user cannot change the password
Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80   ' Encrypted password allowed
Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100           ' Local user account
Const ADS_UF_NORMAL_ACCOUNT = &H200                   ' Typical user account
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000

    On Error Resume Next

'# Определяем имя компьютера
    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

'# Устанавливаем/Снимает галку с пункта
'# "Потребвать сену пароля при следующем входе в систему"    
If Not IsNull(blnRequireChangePassword) Then    
        Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
            
            If blnRequireChangePassword Then 
                objUser.Put "PasswordExpired", 1
            Else
                objUser.Put "PasswordExpired", 0
            End If
        
        objUser.SetInfo
        
        Set objUser = Nothing
End if

'# Устанавливаем/Снимает галку с пункта
'# "Запретить смену пароля пользователем"
If Not IsNull(blnUserCanNotChangePassword) Then    

        Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
            
            objUserFlags = objUser.Get("UserFlags")
            
            If blnUserCanNotChangePassword Then
             objFlag = objUserFlags Or ADS_UF_PASSWD_CANT_CHANGE
         Else
             objFlag = objUserFlags And Not ADS_UF_PASSWD_CANT_CHANGE
         End If
            
            objUser.Put "userFlags", objFlag 
            objUser.SetInfo
     
        Set objUser = Nothing
End If

'# Устанавливаем/Снимает галку с пункта
'# "Срок действия пароля не ограничен"
If Not IsNull(blnNeverExpirePassword) Then    
    
        Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
            
            objUserFlags = objUser.Get("UserFlags")
            
            If blnNeverExpirePassword Then
                objFlag = objUserFlags OR ADS_UF_DONT_EXPIRE_PASSWD
            Else
                objFlag = objUserFlags And Not ADS_UF_DONT_EXPIRE_PASSWD
            End If
            
            objUser.Put "userFlags", objFlag 
            objUser.SetInfo
            
        Set objUser = Nothing
End if

'# Устанавливаем включена/выключена учётная запись
If Not IsNull(blnAccountDisabled) Then    

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        
        objUserFlags = objUser.Get("UserFlags")
        
        If blnAccountDisabled Then
            objFlag = objUserFlags OR ADS_UF_ACCOUNTDISABLE
        Else
            objFlag = objUserFlags And Not ADS_UF_ACCOUNTDISABLE
        End If
        
        objUser.Put "userFlags", objFlag 
        objUser.SetInfo
        
    Set objUser = Nothing
    
End if    

    On Error Goto 0
    
End Sub

'#####################################################################
'#
'# Процедура AddUserToLocalGroup ()
'# Описание: Добавляет пользователя в локальную группу.         
'# Вход    : byVal strUserName                    - имя пользователя
'#             ByVal strGroupName              - Имя группы
'# Выход   : Нет
'#####################################################################
Sub AddUserToLocalGroup(byVal strUserName, byVal strGroupName)
Dim objGroup, objUser, objComputer, strComputer

    On Error Resume Next    
    
    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroupName & ",group")
        Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ",user")
            objGroup.Add(objUser.ADsPath)
            objGroup.SetInfo
        Set objUser = Nothing
    Set objGroup = Nothing
    
    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserHomeDirectory
'# Описание: Устанавливает путь к домашней папке
'# Вход    : strUserName - Имя пользователя
'#             strHomeDirectory - локальный путь к домашней папке
'# Выход   : Нет
'#####################################################################
Sub SetUserHomeDirectory (byval strUserName, byval strHomeDirectory)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.HomeDirectory = strHomeDirectory
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserHomeDirDrive
'# Описание: Устанавливает сетевой путь к домашней папке
'#           Используется совместно с SetUserHomeDirectory
'# Вход    : strUserName - Имя пользователя
'#             strHomeDirDrive - имя подключаемого сетевого диска (Например "X:" или "Z:")
'# Выход   : Нет
'#####################################################################
Sub SetUserHomeDirDrive (byval strUserName, byval strHomeDirDrive)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.HomeDirDrive = strHomeDirDrive
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserProfile
'# Описание: Устанавливает путь к профайлу пользователя
'# Вход    : strUserName - Имя пользователя
'#             strUserProfile - путь к профайлу пользователя
'# Выход   : Нет
'#####################################################################
Sub SetUserProfile (byval strUserName, byval strUserProfile)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.Profile = strUserProfile
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура DeleteLocalUser
'# Описание: Удаляет учётную запись локального пользователя
'# Вход    : strUserName - Имя пользователя
'# Выход   : Нет
'#####################################################################
Sub DeleteLocalUser (byval strUserName)
Dim objComputer
Dim strComputer
Dim colAccounts
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set colAccounts = GetObject("WinNT://" & strComputer & "")
        colAccounts.Delete "user", strUserName
    Set colAccounts = Nothing    

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура RenameLocalUser
'# Описание: Переименовывает учётную запись локального пользователя
'# Вход    : strUserName - Имя учётной записи пользователя,
'#             strNewUserName - Новое имя учётной записи пользователя
'# Выход   : Нет
'#####################################################################
Sub RenameLocalUser (byval strUserName, byVal strNewUserName)
Dim objComputer
Dim strComputer
Dim colAccounts
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")

        Set objComputer = GetObject("WinNT://" & strComputer)
        
            objComputer.MoveHere objUser.AdsPath, strNewUserName
    
        Set objComputer = Nothing
    
    Set objUser = Nothing
    
    On Error Goto 0

End Sub

Пример использования

Код


    Call CreateLocalUser ("АрсеньевА", "1q2w!Q@W" )
    Call AddUserToLocalGroup ("АрсеньевА", "Опытные пользователи" )
    Call SetCommonPropertyes ("АрсеньевА", False, True, True, False)
    Call SetUserProfile ("АрсеньевА", "D:\D&S\%UserName%")

Это сообщение отредактировал(а) mihanik - 4.5.2008, 20:51

--------------------

Программистами не рождаются, - это родовая травма...

mihanik

Дата 10.5.2008, 21:04 (ссылка)

(нет голосов)

Загрузка ...

-=Белый Медведь=-

Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 61
Всего: 109

Итак...
Завершил работу над скриптом по управлению локальными учётными записями.
Всё параметры для своей работы скрипт берёт из текстового файла.
Достаточно просто "схватить" текстовый файл левой кнопкой мышки и перетащить на значёк моего скрипта.
(можно также запускать скрипт из командной строки, указав в качестве параметра необходимый файл.)

Формат текстового файла по управлению скриптом следующий:

Код


################################################################
#  Файл с командами по управлению локальными учётными записями
################################################################

################################################################
# 
#  Строение файла:
#  1. Пустые, "пробельные" строки, а также строки, начинающиеся со знака "#"
#      рассматриваются как коментарий.
#  2. Файл может содержать любое количество строк
#  3. В одной строке можно указывать только одну команду
#  4. Все команды (кроме команды DeleteUser) имеют два аргумента, разделённых запятой
# 
#  Список используемых команд:
# 
#  1. CreateUser - создаёт учётную запись пользователя с указанным паролем
#      Формат команды: 
#     CreateUser <имя>, <пароль>
# 
#      Здесь: <имя> - имя создаваемой учётной записи
#           <пароль> - пароль создаваемой учётной записи
# 
#      Пример:
#  CreateUser ПупкиВ, 1q2w!Q@W
#    
#  2. SetPassword - устанавливает пароль учётной записи пользователя с указанным именем
#      Формат команды: 
#     SetPassword <имя>, <пароль>
# 
#       Здесь: <имя> - имя создаваемой учётной записи
#       <пароль> - пароль создаваемой учётной записи
# 
#      Пример:
#  SetPassword ПупкиВ, 1q2w!Q@W
#    
#  3. SetDescription - устанавливает описание учётной записи пользователя с указанным именем
#      Формат команды: 
#     SetDescription <имя>, <описание>
# 
#       Здесь: <имя> - имя учётной записи
#       <описание> - описание для учётной записи
#  
#      Пример:
#  SetDescription ПупкиВ, Автоматически созданная учётная запись пользователя
#    
#  4. SetUserFullName - устанавливает полное имя учётной записи пользователя с указанным именем
#      Формат команды: 
#     SetUserFullName <имя>, <полное имя>
# 
#       Здесь: <имя> - имя  учётной записи
#       <полное имя> - полное имя учётной записи
#  
#      Пример:
#  SetUserFullName ПупкиВ, Пупкин Василий Петрович
#    
#  5. AddUserToLocalGroup - добавляет учётную запись пользователя в локальную группу с указанным именем
#      Формат команды: 
#     AddUserToLocalGroup <имя>, <имя группы>
# 
#       Здесь: <имя> - имя учётной записи
#       <имя группы> - имя локальной группы
#  
#      Пример:
#  AddUserToLocalGroup ПупкиВ, Опытные пользователи
#    
#  6. SetUserProfile - устанавливает путь к профилю учётной записи пользователя с указанным именем
#      Формат команды: 
#     AddUserToLocalGroup <имя>, <путь>
# 
#       Здесь: <имя> - имя учётной записи
#       <путь> - путь к профилю
#  
#      Пример:
#  SetUserProfile ПупкиВ, D:\D&S\ПупкиВ
#    
#  7. DeleteUser - удаляет учётную запись пользователя с указанным именем
#      Осторожно!!! Учётная запись удаляется без дополнительного предупреждения
# 
#      Формат команды: 
#     DeleteUser <имя>
# 
#       Здесь: <имя> - имя учётной записи
#  
#      Пример:
#  DeleteUser ПупкиВ
#    
#  8. RenameLocalUser - переименовывает учётную запись пользователя с указанным именем
#      Формат команды: 
#     RenameLocalUser <имя>, <новое имя>
# 
#       Здесь: <имя> - имя учётной записи
#       <новое имя> - новое имя учётной записи
#  
#      Пример:
#  RenameLocalUser ПупкиВ, ПупкинВасилий
#    
#  9. AccountDisabled - устанваливает отключена или включена учётная запись пользователя с указанным именем
#      Формат команды: 
#     AccountDisabled <имя>, <yes|no>
# 
#       Здесь: <имя> - имя учётной записи
#       <yes> - учётная запись отключена
#       <no>  - учётная запись включена
#   
#      Пример:
#  AccountDisabled ПупкиВ, yes
#    
#  10. NeverExpirePassword - устанваливает имеет ли ограничение срок действия пароля учётной записи пользователя с указанным именем
#       Формат команды: 
#     NeverExpirePassword <имя>, <yes|no>
# 
#        Здесь: <имя> - имя учётной записи
#       <yes> - срок действия пароля не ограничен
#       <no>  - срок действия пароля ограничен
#   
#       Пример:
#  NeverExpirePassword ПупкиВ, yes
#    
#  11. UserCanNotChangePassword - устанваливает может ли пользователь с указанным именем менять свой пароль
#       Формат команды: 
#     UserCanNotChangePassword <имя>, <yes|no>
# 
#        Здесь: <имя> - имя учётной записи
#       <yes> - пользователь не может менять свой пароль
#       <no>  - пользователь может менять свой пароль
#   
#       Пример:
#  UserCanNotChangePassword ПупкиВ, yes
#    
#  11. RequireChangePassword - устанваливает требовать ли от  пользователя с указанным именем сменить пароль при следующем входе в систему
#       Формат команды: 
#     RequireChangePassword <имя>, <yes|no>
# 
#        Здесь: <имя> - имя учётной записи
#       <yes> - требовать от пользователя  сменить свой пароль
#       <no>  - не требовать от пользователя  сменить свой пароль
#   
#       Пример:
#  RequireChangePassword ПупкиВ, yes
################################################################
 

#  Пример управления пользователем

CreateUser    ПупкиВ, 1й2ц!Й"Ц
SetPassword    ПупкиВ, , 1й2ц3у!Й"Ц№У
SetDescription    ПупкиВ,  Автоматически созданная учётная запись
SetUserFullName    ПупкиВ,  Пупкин Василий Петрович
AddUserToLocalGroup    ПупкиВ,   Опытные пользователи    
SetUserProfile    ПупкиВ,  D:\D&S\ПупкиВ
NeverExpirePassword    ПупкиВ,  yes
UserCanNotChangePassword    ПупкиВ,  yes
RenameLocalUser    ПупкиВ,  ПупкиВасилий
AccountDisabled    ПупкиВасилий, yes

#  DeleteUser    Василиус

А вот непосредственно и сам скрипт в приложении

Это сообщение отредактировал(а) mihanik - 10.5.2008, 21:14

Присоединённый файл ( Кол-во скачиваний: 72 )

ManageUserAccounts.rar 7,59 Kb

--------------------

Программистами не рождаются, - это родовая травма...

mihanik

Дата 18.5.2008, 22:25 (ссылка)

(нет голосов)

Загрузка ...

-=Белый Медведь=-

Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 61
Всего: 109

Код


'********************************************************************
'*
'* Класс    : EngineScript
'* Описание : Экземпляры объекта данного класса используются для определения
'*              типа сервера сценариев, установки нужного типа сервера сценария.
'* Вход     : Нет
'* Выход    : Нет
'*
'********************************************************************
class EngineScript
    
    ' Свойства класса
    Dim EngineScriptType    '        тип сервера сценариев по-умолчанию
                            '            0 - тип не определён
                            '            1 - wscript
                            '            2 - cscript
    Dim EngineScriptName    '        имя сервера сценариев по-умолчанию
                            '            wscript или cscript
    Dim ClassErr            '        номер ошибки времени исполнения
    Dim ClassErrDescription    '        расшифровка ошибки времени исполнения

    ' Используемые в классе переменные
    Private WshShell    ' для создания WScript.Shell
    
    ' Переменные, используемые для локализации скрипта
    Private Msg1
    Private Msg2
    
    '********************************************************************
    '*
    '* Процедура: class_Initialize
    '* Описание : Выполняет действия, необходимые для инициализации класса
    '* Вход     : Нет
    '* Выход    : Нет (Создаётся экземпляр объекта этого класса)
    '*
    '********************************************************************
    Private Sub class_Initialize()
    
        ' Локализация
        Msg1 = "Ошибка определения имени сервера сценариев."
        Msg2 = "Неизвестное имя сервера сценариев."
        
        On Error Resume Next
        Err.Clear
        
        ClassErr = 0
        ClassErrDescription = ""
        EngineScriptType = 0
        EngineScriptName = ""

        ' Получим полное имя файла исполнителя сервера сценариев
        EngineScriptName = WScript.FullName
            
        If Err.Number Then
            ClassErr = Err.Number
            ClassErrDescription = Err.Description
            Err.Clear
            Exit Sub
        End if
        
        If Len (EngineScriptName) < 14 Then
            ClassErr = -1 ' Ошибка определения имени
            ClassErrDescription = Msg1
        Else
            EngineScriptName = UCase(Mid(EngineScriptName,Len(EngineScriptName)-10,11))
        End If
        
        Select Case EngineScriptName
            Case "WSCRIPT.EXE"    
                     EngineScriptType = 1
                        EngineScriptName = "WSCRIPT"
            Case "CSCRIPT.EXE"    
                     EngineScriptType = 2
                        EngineScriptName = "CSCRIPT"
            Case Else        
                     EngineScriptType = 0
                        EngineScriptName = "UNKNOWN"
        End Select
    
    End sub

    '********************************************************************
    '*
    '* Процедура: SetEngineScript
    '* Описание : Устанавливает нужный сервер сценариев по умолчанию
    '* Вход     : strName - cscript или wscript
    '* Выход    : нет
    '*
    '********************************************************************
    Sub SetEngineScript ( ByVal strName)

        strName = UCase(strName)
        
        On Error Resume Next
        Err.Clear
    
        Set WshShell = CreateObject("WScript.Shell")

            If Err.Number Then
                ClassErr = Err.Number
                ClassErrDescription = Err.Description
                Err.Clear
                Exit Sub
            End if
    
            Select Case strName
                Case "WSCRIPT"    
                 WshShell.Run "wscript.exe //h:wscript", 1, True
                Case "CSCRIPT"    
                 WshShell.Run "wscript.exe //h:cscript", 1, True
                Case Else
                    ClassErr = -2 
                    ClassErrDescription = Msg2
            End Select
          
        Set WshShell = Nothing

    End Sub
End class

Пример использования

Код


    Dim a
    
    Set a = New EngineScript

    If a.EngineScriptType <> 2 Then a.SetEngineScript ("cscript")    
    
    Set a = Nothing

--------------------

Программистами не рождаются, - это родовая травма...

Akina

Дата 19.5.2008, 00:47 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20570
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 42
Всего: 453

mihanik
Во-первых, не понимаю, почему вместо (или в дополнение? так даже лучше - EngineScriptType и EngineScriptName) символьного имени скрипт отдает числовое?
Во-вторых, почему при ином типе сервера сценариев не вывести именно его имя, а не абстрактное UNKNOWN.
Ну и в третьих - зачем эта проверка на 14 символов? и почему надо откусывать последние 11, вместо того чтобы распарсить что там после последнего слеша...

--------------------

О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

mihanik

Дата 19.5.2008, 06:49 (ссылка)

(нет голосов)

Загрузка ...

-=Белый Медведь=-

Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 61
Всего: 109

Цитата(Akina @ 19.5.2008, 00:47

)

Ну и в третьих - зачем эта проверка на 14 символов?

len ("c:\cscript.exe") = 14 (трудно придумать более короткий путь...)

Цитата(Akina @ 19.5.2008, 00:47

)

почему надо откусывать последние 11, вместо того чтобы распарсить что там после последнего слеша...

Распарсить не проблема.
Но !
1. В основном используются cscript и wscript
а их название это последние 11 символов.

2. Другие серверы сценариев меня не интересуют.
Это является ответом и на вопрос

Цитата(Akina @ 19.5.2008, 00:47

)

почему при ином типе сервера сценариев не вывести именно его имя, а не абстрактное UNKNOWN.

А на вопрос

Цитата(Akina @ 19.5.2008, 00:47

)

имени скрипт отдает числовое?

отвечу, что это я подсмотрел у MS.

Так же подсмотрел там и там, что потом оформил в вот этом скрипте.

Код


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Процедура VBPrintf()
' Описание: Эмитирует работу функции printf
' Вход    : strEcho  - строка для вывода
'            arrParam - массив параметров
' Выход   : Нет
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub VBPrintf (byVal strEcho, byVal arrParam)
Dim intI
Dim intN
Dim strS

    If IsArray(arrParam) Then 

        intN = UBound(arrParam)
        
        While blnTestString(strEcho, "^.*%[0-9]+.*$")
        
            strS = strExtractString( strEcho, "%[0-9]+")
            intI = CInt(Mid (strS,2,Len(strS)-1))-1
            
            If intI <= intN Then 
                strEcho = Replace (strEcho, strS, arrParam(intI))
            Else
                strEcho = Replace (strEcho, strS, "!NoParameter")
            End If
            
        Wend
        
        strEcho = Replace (strEcho, "!NoParameter", "%Err")
        
    End If

    WScript.Echo strEcho
    
End Sub

'********************************************************************
'*
'* Функция  : blnTestString (приватная)
'* Описание : Определяет соответствует ли строка шаблону
'* Вход     : strString - строка
'*            strPath   - шаблон (регулярное выражение)
'* Выход    : true - соответствует шаблону; false - не соответствует шаблону
'*
'********************************************************************
Private Function blnTestString(ByVal strString, ByVal strPath)

    Dim RegEx
    
    Set RegEx = CreateObject("VBScript.RegExp")
    
        RegEx.IgnoreCase = True
        RegEx.Global = False
        RegEx.MultiLine = False
        RegEx.Pattern = strPath
        
        blnTestString = RegEx.Test(strString)
    
    Set RegEx = Nothing

End Function

'********************************************************************
'*
'* Функция  : strExtractString (приватная)
'* Описание : Выделяет из строки подстроку, удовлетворяющую шаблону
'* Вход     : strString - строка
'*            strPath   - шаблон
'* Выход    : строка соответствущая шаблону
'*
'********************************************************************
Private Function strExtractString(ByVal strString, ByVal strPath)
Dim RegEx
Dim colMatches
Dim aMatch

    Set RegEx = CreateObject("VBScript.RegExp")
    
        RegEx.IgnoreCase = True
        RegEx.Global = False
        RegEx.MultiLine = False
        RegEx.Pattern = strPath
        
        Set colMatches = RegEx.Execute(strString)
            For Each aMatch In colMatches
                strExtractString = aMatch.Value
                Exit For
            Next

        Set colMatches = Nothing
    Set RegEx = Nothing

End Function

Это сообщение отредактировал(а) mihanik - 19.5.2008, 06:49

--------------------

Программистами не рождаются, - это родовая травма...

neo980

Дата 3.7.2008, 10:19 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 3.7.2008

Репутация: нет
Всего: нет

Доброго времени суток.
Помогите немного доработать скрипт запуска программы если она не запущена, просто этот скрипт выполняется на сервере терминалов и нужно чтобы он узнавал запущенный указанный процесс под локальным пользователем, а не пользователем терминала, и если он не запущен, то запускал его, вот код, который не просматривает кем запущен процесс:

Код


Option Explicit
Dim wmiObj, proCollection, scrShell
Set wmiObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set proCollection = wmiObj.ExecQuery("Select * from Win32_Process Where Name = '1cv7.exe'")
If proCollection.Count = 0 Then
    Set scrShell = CreateObject("WScript.Shell")
    scrShell.Run "1CV7s.exe enterprise /Di:\base /nadmin /ppass", 1
'Else
End If

Заранее благодарю

Akella

Дата 6.7.2008, 10:30 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 73
Всего: 329

http://www.osp.ru/win2000/2006/06/3274500/

Скрипт

Цитата

Поиск файлов по имени владельца

Конструктор

Дата 7.11.2008, 18:35 (ссылка)

(голосов:2)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 641
Регистрация: 12.5.2004
Где: Москва

Репутация: 2
Всего: 10

Скрипт, добавляет задание в стандартный шедулер windows. Еще кому-то отдельно может пригодиться функция TimeToUTC, конвертирующая время в формат UTC-WMI.

Код


Option Explicit
'Description:
'    Schedules job to standart windows task scheduler.
'
'
'Author:
'    Evgeniy Vigovskiy aka Konstructor
'
'
'Syntax: 
'    putscheduledjob.vbs </Exec:"Executable"> [/host:"hostname"] [/offset:"minutes"]
'
'
'Arguments:
'/Exec: executable - Program to schedule for launch
'
'/Host:computer name - The job will be added on the specified host. Default "."
'
'/Offset:minutes - Time in minutes to wait before launch. Job will be started
'         at Now + minutes. Don't use 0 here, or your task will be scheduled to
'         the next day. Default "1".
'
'
'History:
'    2008-07-11 - 1.0 - Intital release
'
'
'Reference:
'    MS Scriptng Guy: How Can I Manage Scheduled Tasks Using Scripts?
'    http://www.microsoft.com/technet/scriptcenter/resources/qanda/sept04/hey0922.mspx
'
'    MSDN: Create Method of the Win32_ScheduledJob Class
'    http://msdn.microsoft.com/en-us/library/aa389389(VS.85).aspx
'
'    Technet: Converting a Standard Date to a WMI Date-Time Format
'    http://www.microsoft.com/technet/scriptcenter/guide/sas_wmi_onfu.mspx?mfr=true
'
'    Technet: Converting WMI Dates to a Standard Date-Time Format
'    http://www.microsoft.com/technet/scriptcenter/guide/sas_wmi_yakv.mspx?mfr=true


Dim strComputer
Dim StorePath
Dim OutString
Dim strExecutable
Dim strOffset
Dim dtmLaunchTime
Dim strUTCLaunchTime
Dim objWMIService
Dim objNewJob
Dim intJobID
dim errJobCreated

'Parse arguments
If (WScript.Arguments.Named("Exec") <> "") then
    strExecutable = WScript.Arguments.Named("Exec")
Else
    WScript.Echo "-ERR: Executable not defined. Return code: 254"
    WScript.Quit 254
End if

If (WScript.Arguments.Named("Host") <> "") then
    strComputer = WScript.Arguments.Named("Host")
Else
    strComputer = "."
End if

If (WScript.Arguments.Named("Offset") <> "") then
    strOffset = WScript.Arguments.Named("Offset")
Else
    strOffset = "1"
End if

'Prepare for Job creation
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objNewJob = objWMIService.Get("Win32_ScheduledJob")

'Calculate launch time
dtmLaunchTime = Now
dtmLaunchTime = DateAdd ("n" , cint(strOffset) , dtmLaunchTime)
strUTCLaunchTime = TimeToUTC(dtmLaunchTime , strComputer)

'Create Job
errJobCreated = objNewJob.Create _
    (strExecutable, strUTCLaunchTime , False , , , , intJobID)

'Handle creation errors        
Select case errJobCreated
    Case 0
        WScript.Echo "+OK: ID=" & intJobID & " EXEC=" & strExecutable & _
                     " UTC=" & strUTCLaunchTime
        WScript.Quit 0

    Case 1
        WScript.Echo "-ERR: The request is not supported. Return code: 1"
        WScript.Quit 1

    Case 2
        WScript.Echo "-ERR: The user does not have the necessary access. " & _
            "Return code: 2"
        WScript.Quit 2

    Case 8
        WScript.Echo "-ERR: Interactive process. Return code: 8"
        WScript.Quit 8

    Case 9
        WScript.Echo "-ERR: The directory path to the service executable file" & _ 
            "cannot be found. Return code: 9"
        WScript.Quit 9

    Case 21
        WScript.Echo "-ERR: Invalid parameters have been passed to the service." & _ 
            "Return code: 21"
        WScript.Quit 21

    Case 22
        WScript.Echo "-ERR: The account that this service runs under is invalid or" & _
            "lacks the permissions to run the service. Return code: 22"
        WScript.Quit 22

    Case Else
        WScript.Echo "-ERR: Unknown error. Return code: 253"
        WScript.Quit 253
End select

'Function converts standart time to WMI-UTC format.
'
'strComputer - computer to take timezone settings. "." is generally ok.
'dtmTime - standart date-time value to convert
'
'returns - string with time in UTC-WMI format, date value ommited
Function TimeToUTC(byval dtmTime , byval strComputer)
    Dim objWMIService
    Dim colTimeZone
    Dim objTimeZone
    Dim intOffset
    Dim strHours
    Dim strMinutes
    Dim strSeconds
    Dim strTimeZoneOffset

    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

    Set colTimeZone = objWMIService.ExecQuery ("SELECT * FROM Win32_TimeZone")
    For Each objTimeZone in colTimeZone
        intOffset = objTimeZone.Bias
    Next
    
    strHours = cstr(Hour(dtmTime))
    If Len(strHours) < 2 Then strHours = "0" + strHours
    
    strMinutes = cstr(Minute(dtmTime))
    If Len(strMinutes) < 2 Then strMinutes = "0" + strMinutes

    strSeconds = cstr(Second(dtmTime))
    If Len(strSeconds) < 2 Then strSeconds = "0" + strSeconds

    
    If intOffset >= 0 then 
        strTimeZoneOffset = "+" & cstr(intOffset)
    Else
        strTimeZoneOffset = cstr(intOffset)
    End if
    
    TimeToUTC = "********" & strHours & strMinutes & strSeconds & ".000000" & strTimeZoneOffset
End function

Это сообщение отредактировал(а) Конструктор - 7.11.2008, 18:40

Конструктор

Дата 8.11.2008, 23:14 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 641
Регистрация: 12.5.2004
Где: Москва

Репутация: 2
Всего: 10

Если в том смысле "как запустить", то:

putscheduledjob.vbs </Exec:"программа"> [/host:"компьютер"] [/offset:"минуты"]

программа - та программа, которая будет запущена при исполнении задания
компьютер - локальный или удаленный компьютер, на котором будет добавлено задание. Можно не указывать, тогда будет локальный компьютер.
минуты - задания будет запускаться через указанное количество минут. Если сейчас 12-00, а в скрипт мы передадим 10, то задание будет запущено в 12-10. Конкретное время запуска устанавливать нельзя. Можно не указывать, тогда будет задержка в 1 минуту.

Если в том смысле, "зачем вообще нужен такой скрипт", то суть его в том, чтобы отсрочить выполнение logon-скриптов. Допустим кто-то написал ядреный скрип, который собирает кучу разной статистики с рабочей станции пользователя. Чтобы избежать тормозни при загрузке операционной системы в logon-скрипты в AD можно просто прописать этот скрипт, который при загрузке быстро создаст задание. Когда система загрузится, поднимет все службы и прекратит тормозить, запустится задание с более тяжелой нагрузкой.

Конструктор

Дата 29.1.2009, 00:04 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 641
Регистрация: 12.5.2004
Где: Москва

Репутация: 2
Всего: 10

Скрипт ищет неиспользуемые терминальные профили, перемещаемые профили, домашние папки и терминальные домашние папки. Правда помочь он может только в том случае, если разные типы профилей хранятся достаточно компактно, например все терминальные профили в папке \\server\termprofiles, перемещаемые \\server\profiles и т.д. Особенно полезен если при увольнении людей админу было лень вычищать и архивировать пользователские профили, а со временем их накопилось так много, что пытаться что-то расчищать смерти подобно. Скрипт просматривает указанную при запуске папку в которой хранятся например терминальные профили на предмет подпапок. Затем он рекурсивно перебирает всех пользователей в указанном OU и смотрит используются ли пользователями подпапки в качестве терминальных профилей. Если какая-либо подпапка не числится терминальным профилем ни у одного пользователя в OU, то она считается неиспользуемым профилем. То же самое для всех остальных типов профилей и домашних папок. Код довольно развесист и полон комментариев, поэтому я его приложу в виде файла.

Запуск:
FindUnusedRemoteProfiles.vbs /Domain:"домен" /OU:"OU" [/TSProfiles:"путь"] [/TSHomes:"путь"] [/Profiles:"путь"] [/Homes:"путь"]

/Domain:"домен" - Имя домена. Например: mydomain.local будет "dc=mydomain,dc=local"

/OU:"OU" - OU для сканирования. Например: Users\Accounting будет "OU=Accounting,OU=Users"

Если не указывать нижеследующие параметры, соответствующие проверки проводиться не будут
/TSProfiles:"путь" - Путь к папке с терминальными профилями

/TSHomes:"путь" - Путь к папке с домашними каталогами терминальных пользователей

/Profiles:"путь" - Путь к папке с перемещаемыми профилями

/Homes:"путь" - Путь к папке с домашними каталогами пользователей

Это сообщение отредактировал(а) Конструктор - 29.1.2009, 16:39

Присоединённый файл ( Кол-во скачиваний: 10 )

FindUnusedRemoteProfiles_1.0.zip 2,44 Kb

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| MS Windows \| Следующая тема »