1 Тема от Rom5 (изменено: Rom5, 2011-08-23 14:02:57)

  • Rom5
  • Участник
  • Неактивен

Тема: Vbscript: определение залоченности пользователем системы

Коллеги, подскажите возможный способ определения заблокированности консоли удаленной машины (Win+L, например).
Работу скринсейвера-то можно отследить наличием процесса с ".scr", но далеко не всегда на залоченной станции работает хранитель экрана.

WBR. Roman

2 Ответ от Rom5

  • Rom5
  • Участник
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

Ребята, может кому пригодится - признаком залоченности является наличие 2-х (!) процессов "winlogon".
Т.е. для ожидания "подхода" юзера и разблокировки своей машины буду мониторить количество этих процессов и все)

WBR. Roman

3 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

Rom5, у меня всё одно один. Откуда такая информация?

4 Ответ от Dmitrii

  • Dmitrii
  • Разработчик
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

Rom5 пишет:

... признаком залоченности является наличие 2-х (!) процессов "winlogon"...

У меня хоть под XP, хоть под 7 - по одному в любом случае.

5 Ответ от Rom5 (изменено: Rom5, 2011-08-27 01:31:55)

  • Rom5
  • Участник
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

alexii пишет:

Rom5, у меня всё одно один. Откуда такая информация?

Все оказалось не так просто... Нужно подумать.

Изначально я сообщил о двух winlogon, т.к. пару раз в процессах (pslist от Sysinternals) на доменных машинах (XP SP3 eng) наблюдал за этим задвоением, причем во втором случае уже специально наблюдал через Rem.Assistance за экраном залоченной машиной - как только юзер ее разлочил, процесс остался один.
Увы, на сегодняшний момент рабочая рутина так и не дала времени помоделировать в домене такую ситуацию специально и понаблюдать вдумчиво, хотя дома даже махонький скрипт подготовил для этого дела.

На домашней же отдельной машине (XP sp3 rus) я понял, что есть отличия от работы в домене.

Тест проводил так: скринсейвер изначально настроил на 1 мин, простейший скрипт, выбирающий данные по этим двум процессам, запускаю из батника в бесконечном цикле с паузой приблизительно 30сек, далее блокирую консоль Win+L и гуляю, срабатывает скринсейвер, гуляю немного с ним, потом я его снимаю, еще гуляю с полминуты, разблокируюсь, прерываю батник, смотрю лог.

Так вот,  блокирование консоли на процессы не влияло, а срабатывание скринсейвера вызывало запуск logon.scr и причем родителем процесса выступал winlogon.
Тест показал, что logon.scr появляется только при срабатывании хранителя (аналогично доменной ситуации),  а winlogon всегда один.

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

батник запуска:

:::: ---- prc_wlog.cmd ----
:Beg
cscript /nologo prc_wlog.vbs >> prc_wlog.txt

ping -n 30 127.0.0.1 >nul

Goto :Beg

скрипт:

'''''' ----- prc_wlog.vbs -------
On Error Resume Next
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

strComputer = "127.0.0.1"

WScript.Echo "=========================================="
WScript.Echo "Computer: " & strComputer
WScript.Echo Now()
WScript.Echo "=========================================="

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
 
iWinLog = 0 : iScrLog = 0

For Each objItem In colItems
    sName = objItem.Name
    If sName = "winlogon.exe" OR sName = "logon.scr" Then
        If sName = "winlogon.exe" Then iWinLog = iWinLog + 1
        If sName = "logon.scr" Then iScrLog = iScrLog + 1
        WScript.Echo "Name: " & sName
        WScript.Echo "CreationDate: " & WMIDateStringToDate(objItem.CreationDate)
        WScript.Echo "ParentProcessId: " & objItem.ParentProcessId
        WScript.Echo "Priority: " & objItem.Priority
        WScript.Echo "ProcessId: " & objItem.ProcessId
        WScript.Echo
    End If 'objItem.Caption = "winlogon.exe" Then
Next
WScript.Echo "=========================================="
WScript.Echo "iWinLog = " & CStr(iWinLog) & "  iScrLog =" & CStr(iScrLog)
WScript.Echo
WScript.Echo

Function WMIDateStringToDate(dtmDate)
WScript.Echo dtm: 
    WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
    Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
    & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function

лог

==========================================
Computer: 127.0.0.1
26.08.2011 23:06:37
==========================================
Name: winlogon.exe

CreationDate: 26.08.2011 23:03:13
ParentProcessId: 604
Priority: 13
ProcessId: 680

==========================================
iWinLog = 1  iScrLog =0


==========================================
Computer: 127.0.0.1
26.08.2011 23:07:06
==========================================
Name: winlogon.exe

CreationDate: 26.08.2011 23:03:13
ParentProcessId: 604
Priority: 13
ProcessId: 680

==========================================
iWinLog = 1  iScrLog =0


==========================================
Computer: 127.0.0.1
26.08.2011 23:07:36
==========================================
Name: winlogon.exe

CreationDate: 26.08.2011 23:03:13
ParentProcessId: 604
Priority: 13
ProcessId: 680

==========================================
iWinLog = 1  iScrLog =0


==========================================
Computer: 127.0.0.1
26.08.2011 23:08:06
==========================================
Name: winlogon.exe

CreationDate: 26.08.2011 23:03:13
ParentProcessId: 604
Priority: 13
ProcessId: 680

Name: logon.scr

CreationDate: 26.08.2011 23:07:59
ParentProcessId: 680
Priority: 4
ProcessId: 1808

==========================================
iWinLog = 1  iScrLog =1


==========================================
Computer: 127.0.0.1
26.08.2011 23:08:35
==========================================
Name: winlogon.exe

CreationDate: 26.08.2011 23:03:13
ParentProcessId: 604
Priority: 13
ProcessId: 680

Name: logon.scr

CreationDate: 26.08.2011 23:07:59
ParentProcessId: 680
Priority: 4
ProcessId: 1808

==========================================
iWinLog = 1  iScrLog =1


==========================================
Computer: 127.0.0.1
26.08.2011 23:09:05
==========================================
Name: winlogon.exe

CreationDate: 26.08.2011 23:03:13
ParentProcessId: 604
Priority: 13
ProcessId: 680

==========================================
iWinLog = 1  iScrLog =0


==========================================
Computer: 127.0.0.1
26.08.2011 23:09:34
==========================================
Name: winlogon.exe

CreationDate: 26.08.2011 23:03:13
ParentProcessId: 604
Priority: 13
ProcessId: 680

==========================================
iWinLog = 1  iScrLog =0

Сорри, за много текста среди ночи)

ps. Причина правки: сбило с толку то, что открыте окна "Свойства: Экрана" на вкладке "Заставка" уже вызывает процесс logon.scr )

WBR. Roman

6 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

Rom5 пишет:

…потестирую процессы скорее всего аж во вторник, т.к. в понедельник будет не до изысканий. Тогда общественности и донесу результат.

Спасибо, будем ждать.

Rom5 пишет:

сбило с толку то, что открыте окна "Свойства: Экрана" на вкладке "Заставка" уже вызывает процесс logon.scr )

Можно ориентироваться на параметр в .CommandLine при вызове *.scr.

7 Ответ от Rom5

  • Rom5
  • Участник
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

Rom5 пишет:
alexii пишет:

Rom5, у меня всё одно один. Откуда такая информация?

Все оказалось не так просто... Нужно подумать.

Изначально я сообщил о двух winlogon, т.к. пару раз в процессах (pslist от Sysinternals) на доменных машинах (XP SP3 eng) наблюдал за этим задвоением, причем во втором случае уже специально наблюдал через Rem.Assistance за экраном залоченной машиной - как только юзер ее разлочил, процесс остался один.

Каюсь. Это (2-й winlogon) были последствия запуска на удаленную машину Remote Assistance.
Т.е. доменность входа и блокировка здесь не причем - нечистота эксперимента.

А вопрос о признаке блокировки остается открытым..

WBR. Roman

8 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

Rom5, я так чую, что без написания какой-либо библиотеки-посредника на ЯВУ тут не обойтись. Сам код под С++, С# мне попадался, когда я искал решение под WSH.

9 Ответ от Rom5

  • Rom5
  • Участник
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

alexii пишет:

Rom5, я так чую, что без написания какой-либо библиотеки-посредника на ЯВУ тут не обойтись. Сам код под С++, С# мне попадался, когда я искал решение под WSH.

Видимо, так и есть...
Мониторинг проиходящего при блокировании/разблокировании положительного результата не дал.
На самом майкрософте - http://msdn.microsoft.com/en-us/library … s.85).aspx
нашел Visual Basic 8 declaration Function WTSRegisterSessionNotification Lib "Wtsapi32", что, увы, не для простого использования в скромном скрипте.
"Ну, и ладно! Не сильно и хотелось..." (с)

WBR. Roman

10 Ответ от dab00

  • dab00
  • Разработчик
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

Если еще есть интерес здесь скрипт + библиотека.
Исходник либы:

Option Explicit
'API-функции
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" _
        (ByVal lpszDesktop As String, ByVal dwFlags As Integer, _
        ByVal fInherit As Boolean, ByVal dwDesiredAccess As Integer) As Integer
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Integer) As Integer
Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Integer) As Integer
Private Declare Function LockWorkStation Lib "user32" () As Integer

'наличие ошибок, True - ошибок нет
Public Property Get ILErr() As Boolean
    Dim bRet() As Boolean
    bRet = IsLocked
    ILErr = bRet(0)
End Property

'заблокирован ли компьютер, True - заблокирован
Public Property Get ILLocked() As Boolean
    Dim bRet() As Boolean
    bRet = IsLocked
    ILLocked = bRet(1)
End Property

'функция проверки компьютера на залоченность
'возвращает массив из двух логических значений:
'0: True - ошибок нет, False - ошибка
'1: True - заблокирован, False - нет
Private Function IsLocked() As Boolean()
    Dim lngHwnd As Long 'дескриптор рабочего стола
    Dim lngRet As Long 'успех активации и завершения работы с рабочим столом
    Dim bRetArr(1) As Boolean
    
    'получаем дескриптор рабочего стола
    lngHwnd = OpenDesktop("Default", 0, False, &H100)
    If lngHwnd = 0 Then 'не удалось получить дескриптор
        bRetArr(0) = False 'ошибка
    Else
        'активируем рабочий стол
        lngRet = SwitchDesktop(lngHwnd)
        If lngRet = 0 Then 'если активировать не удалось
            If Err.LastDllError = 0 Then
                bRetArr(0) = True 'ошибок нет
                bRetArr(1) = True 'заблокирован
            Else
                bRetArr(0) = False 'ошибка
            End If
        Else
            bRetArr(0) = True 'ошибок нет
            bRetArr(1) = False 'не заблокирован
        End If
        lngRet = CloseDesktop(lngHwnd) 'завершаем работу с рабочим столом
        'If lngRet = 0 Then IsLocked(1) = False 'ошибка
    End If
    IsLocked = bRetArr
End Function

'функция блокировки компьютера
Public Function LockWS() As Integer
    LockWS = LockWorkStation()
End Function

У класса пара свойств: ILErr - наличие ошибок, и ILLocked - наличие блокировки, и один метод - LockWS - собственно блокировка.
Код скрипта:

Const strDll = "DADeskTop.dll" 'библиотека
Set wshShell = CreateObject("WScript.Shell")
'пытаемся зарегистрировать библиотеку
ret = wshShell.Run("regsvr32.exe /i /s  " & strDll & ",0,True")
'проверяем успех регистрации
If ret <> 0 Then 'если не удалось зарегистрировать
    wshShell.PopUp ,1,"Не удалось зарегистрировать библиотеку " & strDll ,16 
    Set wshShell = Nothing
    WScript.Quit
End If
Set wshShell = Nothing
'создаем экземпляр класса из либы = strDll
Set objDADeskTop = CreateObject("DADeskTop.DAClass")        
MsgBox "Отсутствие ошибок: " & objDADeskTop.ILErr & vbCrLf & _
        "Компьютер заблокирован: " & objDADeskTop.ILLocked

'5 секунд на блокировку компа - Win+L :)
WScript.Sleep 5000
MsgBox "Отсутствие ошибок: " & objDADeskTop.ILErr & vbCrLf & _
        "Компьютер заблокирован: " & objDADeskTop.ILLocked
'можно залочить компьютер
objDADeskTop.LockWS()        
Set objDADeskTop = Nothing

Как доставить скрипт с либой на целевой комп, думаю, догадаетесь .
Я бы сделал примерно так: fso.CopyFile "\\Имя_Компа\Admin$\Имя_Файла, наличие админской шары, разумеется, обязательно.
Здесь неплохая статья.

Мой проект

11 Ответ от dab00 (изменено: dab00, 2011-09-04 20:02:59)

  • dab00
  • Разработчик
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

По мотивам поста получилось вот такое HTA.
http://da440dil.narod.ru/lockmaster-images/lockmaster.png http://da440dil.narod.ru/lockmaster-images/lockmaster1.png
Алгоритм следующий:
- вводим имя компьютера вручную (по умолчанию) или выбираем из списка компьютеров в сети (после нажатия на кнопку "Выбрать")
- проверяем целевой компьютер на залоченность
- блокируем целевой компьютер в случае необходимости
Обошелся без Remote Scripting (хлопотно), PsExec и похожих фокусов с запуском службы (без Марка Руссиновича не обойтись), без планировщиков (долго ждать запуска процесса), только FSO и WMI. Ну и либу, конечно, на VB6 написал (исходник чуть выше).
Честно, не знаю что получилось, прошу заценить.
Код HTA:

<html>
<head>
  <title>LockMaster</title>
  <HTA:APPLICATION 
    ID = "LockMaster"
    APPLICATIONNAME="LockMaster"    
    SINGLEINSTANCE="yes"
    MAXIMIZEBUTTON = "no"
    SCROLL="no"
    Icon = "daffodil.ico"
    Version = "1.0">
    </HTA:APPLICATION>
    
<style type="text/css">
    body{
    color:#fff;
    font: bold sans-serif;
    }    
    .button{
    font: bold;
    color:#fff;
    background-color:000055; 
    width:150px; 
    height:35px;
    }
  </style>
</head>
<script language="VBScript">
On Error Resume Next
Dim bDivState
Dim objWMI, wshShell, fso
Const strAdmShareName = "ADMIN$" 'имя админской шары
Const strOption0 = "Выберите компьютер" 'первый option select-a - заголовок
Const strDll = "DADeskTop.dll" 'имя библиотеки
Const strScr = "LockMaster.vbs" 'имя скрипта
Const strLM = "lm" 'имя файла, в который пишется результат проверки на залоченность

'процедура изменения размера окна при загрузке
Sub OnLoad()
    Window.ResizeTo 200, 200
    Window.MoveTo 20, 20
    'чтобы при любом раскладе загрузился интерфейс
    Window.setTimeout "FillCompInput",1, "vbscript"        
End Sub

'выход из приложения - чистим ссылки
Sub Window_OnUnload()
    Set fso = Nothing
    Set wshShell = Nothing
    Set objWMI = Nothing
End Sub

'процедура заполнения DIV-а INPUT-ом - окошком для ввода имени компьютера вручную и DIV-a кнопкой Выбрать     
Sub FillCompInput()
    strCompList.innerhtml = "<input id=""txtComputer"" type=""text"" />"        
    buttons.innerhtml = "<input type=""button"" class=""button""value=""Выбрать"" onclick=""FillCompList"">"        
    bDivState = False 'ставим флаг
End Sub

Sub FillCompList()
    Dim objNameSpace, objComp, objDom
    Dim strHTMLCompList, strHTMLDomList, i        
    i = 0        
    'первая строка списка компьютеров
    strHTMLCompList = "<select name=""txtComputer""><option value=" & i & ">" & strOption0 & "</option>"
    
    Set objNameSpace = GetObject("WinNT:")
    objNameSpace.Filter = Array("Domain") 'берем домены        
    For Each objDom In objNameSpace 'бежим по доменам            
        objDom.Filter = Array("Computer") 'берем компы домена
        For Each objComp In objDom 'бежим по компьютерам
            'заполняем список компьютеров в домене - прочие OPTION-ы SELECT-a txtComputer
            strHTMLCompList = strHTMLCompList & "<option value=" & i & ">" & objComp.Name & "</option>"
            i = i + 1
        Next                        
    Next        
    Set objNameSpace = Nothing 'удалим ссылку
    
    strHTMLCompList = strHTMLCompList & "</select>"    'закрываем тэг        
    strCompList.innerhtml = strHTMLCompList    'заполним DIV
    'изменим кнопку
    buttons.innerhtml = "<input type=""button"" class=""button""value=""Вручную"" onclick=""FillCompInput"">"        
    bDivState = True 'ставим флаг            
End Sub

'нажатие на кнопку
Sub OnClickBtn(bChk)
    Dim strCompSelected
    If bDivState Then 'если в DIV-е SELECT             
        strCompSelected = txtComputer.Options(txtComputer.selectedIndex).Text
    Else 'если в DIV-е INPUT
        strCompSelected = txtComputer.Value
    End If
    
    '--- проверки
    'не пустое имя
    If strCompSelected = vbNullString Then
        MsgBox "Введите имя компьютера"
        Exit Sub
    'не option 0
    ElseIf strCompSelected = strOption0 Then
        MsgBox "Выберите имя компьютера"
        Exit Sub    
    'пингуем
    ElseIf Not CompAvailable(strCompSelected) Then
        MsgBox "Компьютер " & strCompSelected & " не найден"
        Exit Sub
    End If        
    
    'подключаемся к WMI целевого компа
    Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strCompSelected & "\Root\CIMV2")
    If Err.Number <> 0 Then
        MsgBox "Не удалось подключиться к пространству имен CIMV2 компьютера " & _
                strCompSelected & vbCrLf & ConnectionErrors(Err.Number)
        Exit Sub
    End If
    
    'сразу инициализируем, чтобы чистить все ссылки
    Set wshShell = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")    
    
    'если выбран локальный компьютер
    If IsLocalComp() Then
        Window_OnUnload
        MsgBox "Выберите удаленный компьютер"
        Exit Sub
    'проверяем наличие админской шары
    ElseIf Not HaveShare() Then
        Window_OnUnload
        MsgBox "На компьютере " & strCompSelected & " не найден общий ресурс " & strAdmShareName
        Exit Sub
    End If
    
    'собираем пути к файлам библиотеки и скрипта
    strDllPath = wshShell.CurrentDirectory & "\" & strDll
    strScrPath = wshShell.CurrentDirectory & "\" & strScr    
    
    'проверяем наличие файла библиотеки в текущем каталоге
    If Not fso.FileExists(strDllPath) Then
        Window_OnUnload
        MsgBox "Файл " & strDllPath & " не найден"
        Exit Sub
    'проверяем наличие файла скрипта в текущем каталоге
    ElseIf Not fso.FileExists(strScrPath) Then
        Window_OnUnload
        MsgBox "Файл " & strScrPath & " не найден"
        Exit Sub
    End If    
    
    'копируем файлы на удаленный компьютер с заменой существующих
    bRet = fso.CopyFile(strDllPath, "\\" & strCompSelected & "\" & strAdmShareName & "\" & strDll, True)
    If Not bRet Then
        Window_OnUnload
        MsgBox "Не удалось скопировать файл " & strDll & " на компьютер " & strCompSelected
        Exit Sub
    End If
    bRet = fso.CopyFile(strScrPath, "\\" & strCompSelected & "\" & strAdmShareName & "\" & strScr, True)
    If Not bRet Then
        Window_OnUnload
        MsgBox "Не удалось скопировать файл " & strScr & " на компьютер " & strCompSelected
        Exit Sub
    End If
    
    'пытаемся запустить процесс на удаленной машине
    bRet = CreateProcess(bChk, strScr)
    If Not bRet Then
        Window_OnUnload
        MsgBox "Не удалось создать процесс на компьютере " & strCompSelected
        Exit Sub
    End If
    
    If bChk Then 'если проверка
        Set objFile  = fso.GetFile("\\" & strCompSelected & "\" & strAdmShareName & "\" & strLM)
        If Err.Number <> 0 Then
            Window_OnUnload
            MsgBox "Не удалось получить файл " & "\\" & strCompSelected & "\" & strAdmShareName & "\" & strLM
            Exit Sub
        End If
        If objFile.Size = 0 Then
            Window_OnUnload
            MsgBox "Файл " & "\\" & strCompSelected & "\" & strAdmShareName & "\" & strLM & " - пустой"
            Exit Sub
        End If
        'открываем файл для чтения
        Set f = fso.OpenTextFile(objFile.Path,1)
        Set objFile = Nothing
        'читаем файл
        strContents = Trim(f.ReadLine)
        f.Close 'закрываем файл
        Set f = Nothing
        'проверяем длину строки может быть только True или False
        If Len(strContents) > 5 Then
            Window_OnUnload
            MsgBox "Не удалось прочитать содержание файла " & "\\" & strCompSelected & "\" & strAdmShareName & "\" & strLM
            Exit Sub
        End If
        'проверяем содержимое файла
        If CBool(strContents) Then 'если True
            MsgBox "Компьютер " & strCompSelected & " заблокирован"
        Else
            MsgBox "Компьютер " & strCompSelected & " не заблокирован"
        End If
    Else 'если лочим
        MsgBox "Компьютер " & strCompSelected & " успешно заблокирован"
    End If
    
End Sub    

'запускаем процесс на удаленном компе
Function CreateProcess(bChk, strScr)
    Set objStartup = objWMI.Get("Win32_ProcessStartup")    
    Set objConfig = objStartup.SpawnInstance_
    objConfig.ShowWindow = 0 'не показываем окно процесса
    'если лочим комп - добавим к запуску скрипта параметр /l
    If Not bChk Then strScr = strScr & " /l" 
    Set objProcess = objWMI.Get("Win32_Process")
    intRet = objProcess.Create(strScr, Null, objConfig, intProcessID)
    Set objProcess = Nothing
    Set objConfig = Nothing
    Set objStartup = Nothing
    If intRet = 0 Then        
        CreateProcess = True        
    Else
        CreateProcess = False
    End If    
End Function

'проверка наличия компа в сети при помощи пинга
Function CompAvailable(strCompName)        
    Dim objPing, objStatus    
    CompAvailable = False 'значение по умолчанию на случай ошибки
    'выполняем запрос из локального WMI
    Set objPing = GetObject("winmgmts:\\.\Root\CIMV2").ExecQuery _
            ("Select * from Win32_PingStatus Where Address = '" & strCompName & "'")        
    For Each objStatus in objPing
        If objStatus.StatusCode = 0 Then CompAvailable = True            
    Next
    Set objPing = Nothing
End Function

'функция проверки наличия у компа админской шары
Function HaveShare()
    Dim colShares, objShare
    HaveShare = False 'значение по умолчанию
    Set colShares = objWMI.ExecQuery("Select * from Win32_Share Where Name = '" & strAdmShareName & "'")    
    For Each objShare In colShares
        HaveShare = True
    Next
    Set colShares = Nothing        
End Function

'функция проверки, является ли текущий комп локальным
Function IsLocalComp()    
    Set objWinOS = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")    
    For Each objObj In objWinOS        
        strCSName = objObj.CSName 'Name of the scoping computer system            
    Next    
    Set objWinOS = Nothing        
    IsLocalComp = False        
    If strCSName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%") Then IsLocalComp = True    
End Function

'ловим ошибки подключения
Function ConnectionErrors(zn)
    Dim res
    Select Case zn
        Case -2147217400
            res = "Ошибка подключения"
        Case -2147749891
            res = "Неверные учетные данные пользователя"            
        Case -2147749902
            res = "Не найдено пространство имен"
        Case -2147749896
            res = "Неверный параметр"
        Case -2147749894
            res = "Недостаточно памяти"
        Case -2147749909
            res = "Ошибка сети"
        Case -2147217308
            res = "Учетные данные пользователя не могут быть использованы" & _
                    vbCrLf & "для подключения к локальному компьютеру"    
        Case -2147749889
            res = "Ошибка не определена"
        Case Else
            res = "Неизвестная ошибка"
    End Select    
    ConnectionErrors = "Код ошибки: " & zn & vbCrLf & res
End Function

</script>
<!-- Изменяем размер окна и рисуем нарядную градиентную заливку :) -->        
<body onload="OnLoad()" 
    STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=1, StartColorStr='#000000', EndColorStr='#0000FF')">
    <table align=center>        
        <tr>
            <td>                
                <div id="strCompList"></div>            
            </td>
        </tr>
        <tr>
            <td>
                <div id="buttons"></div>                
            </td>
        </tr>
        <tr>
            <td>
                <input type="button" class="button" name="btnCheck" id="btnCheck" value="Проверить" onclick="OnClickBtn True">            
            </td>
        </tr>
        <tr>
            <td>
                <input type="button" class="button" name="btnCheck" id="btnCheck" value="Блокировать" onclick="OnClickBtn False">            
            </td>
        </tr>
    </table>
</body> 
</html>

Код VBS:

Option Explicit    

Const strDll = "DADeskTop.dll" 'библиотека
Const strOutputFileName = "lm"

'пытаемся зарегистрировать библиотеку
If RegLib(strDll) Then
    Dim objDADeskTop
    'создаем экземпляр класса из либы = strDll
    Set objDADeskTop = CreateObject("DADeskTop.DAClass")
    'если нет аргументов - пишем наличие залоченности в файл
    If WScript.Arguments.Count = 0 Then 
        Dim fso
        Dim objOutputFile 'файл вывода данных        
        Set fso = CreateObject("Scripting.FileSystemObject")
        'создаем файл, если уже существует - перезапишем
        Set objOutputFile = fso.CreateTextFile(strOutputFileName, True)
        'если либа отработала без ошибок - пишем состояние блокировки
        If objDADeskTop.ILErr Then objOutputFile.WriteLine objDADeskTop.ILLocked    
        'закрываем файл
        objOutputFile.Close
        Set objOutputFile = Nothing
        Set fso = Nothing
    Else 'блокируем компьютер        
        objDADeskTop.LockWS()
    End If
    Set objDADeskTop = Nothing    
End If

'функция регистрации библиотеки
Function RegLib(strDll)
    Dim wshShell, intRet
    Set wshShell = CreateObject("WScript.Shell")    
    intRet = wshShell.Run("regsvr32.exe /s  " & strDll )
    Set wshShell = Nothing
    If intRet = 0 Then 'если удалось зарегистрировать - True
        RegLib = True
    Else
        RegLib = False
    End If    
End Function

По идее все должно работать так:
- через FSO в шару ADMIN$ удаленного компа копируются библиотека и скрипт
- запускается скрипт через Win32_Process.Create
- в случае проверки скрипт создает файл с информацией о состоянии залоченности компа, HTA читает файл через FSO и выдает MsgBox о состоянии
- в случае блокировки скрипт запускается с параметром и если процесс запускается без проблем, то скрипт отрабатывает единственный метод библиотеки и блокирует компьютер
Надеюсь, что все так и есть
Хотелось бы мнение уважаемых специалистов. Check it out

Мой проект

12 Ответ от Rom5

  • Rom5
  • Участник
  • Неактивен

Re: Vbscript: определение залоченности пользователем системы

Спасибо огромное за проделанный труд - и за библиотеку и за скрипт с готовым приложением!

WBR. Roman