Форум программистов, компьютерный форум, киберфорум
Наши страницы

VBScript/JScript/WSH/WMI/HTA

Войти
Регистрация
Восстановить пароль
 
 
Dragokas
Эксперт WindowsАвтор FAQ
16042 / 6860 / 826
Регистрация: 25.12.2011
Сообщений: 10,613
Записей в блоге: 16
#1

Полезные VBS скрипты и программы по работе с ними - VBScript/JScript

15.10.2012, 00:41. Просмотров 81558. Ответов 30
Метки нет (Все метки)

В этой теме выкладываем скрипты, которые часто используются Вами
или на Ваш взгляд могут иметь большое практическое значение.

Также приветствуются скрипты высокой степени сложности, полезные с точки зрения
изучения принципа их работы.

Правила темы:
  • При выкладывании скрипта постарайтесь тщательно описывать принцип его работы и по-больше комментировать строки Вашего кода.
  • Если Ваш код очень большой, помещайте его под CUT. Также можно сделать 2 варианта: 1. Чистый код. 2. С комментариями.
  • Запрещаются любые обсуждения выложенных здесь работ;
  • если в этом есть необходимость, создайте отдельную тему в которой опишите замечание или проблему при работе с данным скриптом, указав ссылку на сообщение из этой темы (правый клик по слову "Permalink" вверху каждого сообщения).
  • Если Вы хотите внести исправление в выложенный Вами код - пишите мне в личку ссылку на Ваше старое сообщение и новый исправленный вариант. (полный вариант с тегами Вашего старого сообщения можно получить, нажав на него - кнопка "Цитата").
  • Допускается размещение обзора программ, помогающих редактировать/отлаживать код.

Схожая тема: Полезные макросы, надстройки и шаблоны (VBA)
Смежная тема: Полезные BAT/CMD скрипты


******************* Перечень полезных скриптов: *******************
Отправка файла на FTP (Drag & Drop) и копирование ссылки в буфер обмена ссылка
Получение времени сервера ссылка
5
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
15.10.2012, 00:41
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Полезные VBS скрипты и программы по работе с ними (VBScript/JScript):

Как вызвать скрипты .vbs из .wsf? - VBScript/JScript
Добрый день! Пытаюсь освоить WSH с целью автоматического создания фиксированного набора папок в каталоге, выбранном пользователем....

VBS, метод POST, заполнение полей и иже с ними - VBScript/JScript
С помощью скрипта лезу на сайт. Далее нужно заполнить поля формы. Тут ступор — как обращаться к ним? у них есть имена, но Set...

Vbs -скрытый запуск программы с параметрами и её отслеживание - VBScript/JScript
Требуется скрыто запускать программу с параметром, если она завершится, скрыто перезапускать её с параметрами, один из форумчан говорит что...

Добавление программы в автозагрузку через скрипт vbs - VBScript/JScript
Доброго врмени суток. Никак не могу найти скрипт vbs добавления в автозагрузку. У меня есть только такой код, но он не работает(( ...

Создание бинарного файла из vbs / Как создать exe файл из vbs - VBScript/JScript
Имеется файл с расширением exe. Нужно как-нибудь занести массив байт в скрипт, и чтоб потом этот файл создавался при запуске vbs

Вывод сообщений из программы сценария VBScript (.vbs-файл) - VBScript/JScript
Дано: Win2003Srv До переустановки системы сценарий VBScript выводил сообщения (командой WScript.Echo "Сообщение...") одно за другим в...

30
Mehonchegg
30 / 12 / 3
Регистрация: 08.05.2013
Сообщений: 78
02.10.2014, 14:19 #16
Еще раз доброго времени суток всем. Хочу поделиться своими скриптами VBS, которые использую для своей работы.
К слову я сисадмин и часто пользуюсь VBS. Возможно некоторые скрипты будут не очень полезны так как их действия легко реализовать через ГПО, но тем не менее мне удобнее использовать скрипт. плюс некоторые легче кому то реализовать в CMD, но тем не менее мне нравится VBS

Кликните здесь для просмотра всего текста
1.Удаленное выключение ПК - очень простой скрипт, но очень полезный в моей работе
Visual Basic
1
2
3
4
5
6
Option Explicit
dim strPC, po
 
Set po = WScript.CreateObject("WScript.Shell")   
strPC = inputbox ("введите имя ПК в сети, который хотите выключить","Выключение ПК")
po.Run "shutdown.exe /s /f /t 0 /m \\"& strPC


Кликните здесь для просмотра всего текста
Проверка ПК на доступность, возвращение имени подключенного пользователя
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Computer = InputBox("Имя компьютера") 
If (Computer = "") Then
    Wscript.Echo "Укажите имя компьютера"
Else
 
Sub PingPc(Pc)
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
        ExecQuery("select * from Win32_PingStatus where address = '"_
        & Pc & "'")
For Each objStatus In objPing
   If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then
wscript.echo "Не могу подключиться"
WScript.Quit
end if
next
End Sub
 
Sub UserPc(Pc)
Set objWMIService = GetObject("winmgmts:" _ 
& "{impersonationLevel=impersonate}!\\" & Pc & "\root\cimv2") 
 
Set colComputer = objWMIService.ExecQuery _ 
("Select * from Win32_ComputerSystem") 
For Each objComputer in colComputer 
If (objComputer.UserName <> "") Then
    Wscript.Echo "Пользователь: "& vbCrLf & objComputer.UserName
Else
    Wscript.Echo "Не авторизировано"
end if
Next
End Sub
 
Call PingPc(Computer)
Call UserPc(Computer)
 
end if

Кликните здесь для просмотра всего текста
Регистрация библиотек
Кладем библиотеку рядом со скриптом, запускаем, вводим имя библиотеки с расширением и нажимаем ОК.
Думаю можно переделать чтоб регистрировал все библиотеки рядом со скриптом или из списка.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Option Explicit
 
Dim strDLLShare
Dim strDLLName
 
Dim objSvcsvc
 
 
strDLLShare = "."
strDLLName  = inputbox ("Введите название DLL вместе с расширением", "", "qwe.dll")
 
On Error Resume Next
 
Set objSvcsvc = WScript.CreateObject("Svcsvc.Service")
 
If Err.Number <> 0 Then
    On Error Goto 0
    
    With WScript.CreateObject("Scripting.FileSystemObject")
        If .FileExists(.BuildPath(strDLLShare, strDLLName)) Then
            .CopyFile .BuildPath(strDLLShare, strDLLName), .BuildPath(.GetSpecialFolder(1).Path, "\")
            WScript.CreateObject("WScript.Shell").Run "regsvr32.exe  """ & .BuildPath(.GetSpecialFolder(1).Path, "\" & strDLLName) & """", 0, True
 
Else
 
msgbox "Библиотека не найдена!"
 
        End If
    End With
Else
 
msgbox "Ничего не зарегестрировано!"
    On Error Goto 0
 
End If
 
WScript.Quit 0

Кликните здесь для просмотра всего текста
Запуск_остановка служб на удаленном ПК

Запускаем, вводим имя ПК в сети, вводи название службы: если есть служба проверяет запущена или нет и предлагает запустить или остановить. При вводе знака ? выводит на экран все службы на удаленном ПК (выводит неудобно, в боксе, может кто посмотрит и подскажет как сделать вывод в файл например)
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Option Explicit 
Dim objWMIService, objItem, objService, objShell 
Dim colListOfServices, Action 
Dim strServiceList, strServiceName, strComputer, strService 
Const TIMEOUT = 2 
 
Set objShell = WScript.CreateObject("WScript.Shell") 
 
'Введите  имя компьютера. 
Do  
       strComputer = InputBox  ("Введите  имя компьютера","Computer Name","djs-klon") 
       If strComputer = " " Then 
          WScript.Quit 
       ElseIf strComputer = " " Then 
          MsgBox "Вы  должны ввести уникальное имя компьютера",vbOkOnly,"Computer Name Required" 
       End If 
Loop Until strComputer <> " " 
 
'сюда  добавить имя сервиса
Do  
    strService = InputBox  ("Ввведите имя сервиса который необходио сотановить или запустить" &_ 
           vbCrLf & "или введите ? для вывода списка всех сервисов" &_ 
           vbCrLf & "имя сервиса чувствительно к регистру","Service Name"," ") 'сюда  добавить имя сервиса
       If strService = "" Then 
          WScript.Quit 
       ElseIf strService = " " Then 
        MsgBox "Вы  должны ввести уникальное имя сервиса",vbOkOnly,"Service Name Required" 
       End If 
    'еслии ввели ? то
    If strService = "?" Then 
        Set objWMIService = GetObject("winmgmts:" _ 
            & "{impersonationLevel=impersonate}!\\" _ 
            & strComputer & "\root\cimv2") 
        Set colListOfServices = objWMIService.ExecQuery _ 
            ("Select * from Win32_Service ")         
        strServiceList = LeftPad("Service Name", 30, Chr(32)) & vbTab & "Service Display Name" 
        strServiceList = strServiceList & vbCrLf & LeftPad("------------", 30, Chr(32)) & vbTab & "--------------------" 
        For Each objService in colListOfServices 
            strServiceName = objService.name 
            strServiceName = LeftPad(strServiceName, 30, Chr(32)) 
            strServiceList = strServiceList & vbCrLf & strServiceName & vbTab & objService.DisplayName 
        Next         
        Set colListOfServices = nothing 
        Set objWMIService = Nothing  
        WScript.Echo strServiceList 
    End If 
Loop Until strService <> " " And strService <> "?" 
strService = "'" & strService & "'" 
 
'проверка статус сервиса и выбор противоположного от статуса действия
'если  выбрано остановить задаётся вопрос  об отключении сервиса 
Set objWMIService = GetObject("winmgmts:" _ 
& "{impersonationLevel=impersonate}!\\" _ 
& strComputer & "\root\cimv2") 
Set colListOfServices = objWMIService.ExecQuery _ 
("Select * from Win32_Service Where Name =" & strService & " ") 
For Each objService in colListOfServices 
    If objService.State = "Running" Then 
        Action = MsgBox("The " & strService & " сервис запущен, Вы хотите остановить сервис?", vbYesNo, "Stop Service?") 
        If Action = vbYes Then 
            objService.StopService() 
            objShell.Popup "Сервис остановлен", TIMEOUT 
            If objService.StartMode = "Auto" Then 
                Action = MsgBox("The " & strService & " сервис остановлен.  Вы хотите  выключить его?", vbYesNo, "Disable Service?") 
                If Action = vbYes Then 
                    errReturnCode = objService.Change( , , , , "Disabled")  
                    objShell.Popup "Сервис отключён", TIMEOUT 
                End If 
            End If 
        End If 
    ElseIf objService.State = "Stopped" Then 
        If objService.StartMode = "Disabled" Then 
            MsgBox "The " & strService & " сервис отключён. Запуск из данного скрипта  не возможен. Обратитесь в  Кабинет 203",vbOkOnly,"Service Disabled" 
        Else 
            Action = MsgBox("The " & strService & " сервес остановлен. Вы хотите запустить сервис?", vbYesNo,"Start Service?") 
            If Action = vbYes Then 
                objService.StartService() 
                objShell.Popup "Сервес запущен.", TIMEOUT 
            End If 
        End If 
    Else 
        objShell.Popup "Сервис не обнаружен, проверьте правильность введённого имени, для вывода вего списка сервисов  введите знак ?", TIMEOUT 
    End If 
Next  
 
set objShell = Nothing 
Set objService = Nothing 
Set objItem = Nothing 
Set objWMIService = Nothing 
 
WScript.Quit 
 
Function LeftPad(strData, intLen, chrPad) 
    Dim intPadLen 
    intPadLen = intLen - Len(strData) 
    If intPadLen > 0 Then 
         LeftPad = String(intPadLen, chrPad) & strData 
    Else 
         LeftPad = strData 
    End If 
End Function

Кликните здесь для просмотра всего текста
Добавление сайта в надежные узлы
Очень полезен в моей работе так как много приходит мануалов из москвы по которым необходимо что либо настроить пользователям. Вот для удобства сделал себе такой скрипт - ненужно запускать или завершать IE - все происходит через реестр. (Вариаций на эту тему очень много, например есть у меня так же готовый скрипт автоматически настраивающий параметры прокси и надежные узлы и блокировку всплывающих окон и параметры интрасети одним нажатием. Использую его при установке нового ПК. Дополню тем что по сути можно настроить это через ГПО - но опять же для оперативности пользуюсь скриптом)
Собственно скрипт - запускаем вводим сайт (добавил проверку ввели ли вы доменную зону чтоб всякого в реестр не поподало) жмем окей. Скрипт будет продолжаться пока не нажмете отмену ну или пока строка не будет пустая собственно что и возвращает кнопка ОТМЕНА
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Option Explicit
 
dim strABC, s
 
Do
strABC = Inputbox("Введите адрес сайта для добавления его в Надежные узлы.","Адрес сайта")
s= UzlIb(strABC)
Loop  Until InStr(1, strABC ) = 1
 
Function UzlIb(strABC)
 
dim sh, key, strPath, strA1, strA2, strA3, strA4, strA5
Set Sh = CreateObject("WScript.Shell")
 
strA1 = ".ru"
strA2 = ".com"
strA3 = ".org"
strA4 = ".net"
strA5 = ""
key =  "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\"
 
strPath = key & strABC
 
 if UBound(Split(strABC, strA1 ))>0 then
Sh.RegWrite strPath &"\\", "", "REG_SZ"
 
Sh.RegWrite strPath &"\\https", 2,"REG_DWORD"
 
Sh.RegWrite strPath &"\\http", 2,"REG_DWORD"
 
elseif UBound(Split(strABC, strA2 ))>0 then 
Sh.RegWrite strPath &"\\", "", "REG_SZ"
 
Sh.RegWrite strPath &"\\https", 2,"REG_DWORD"
 
Sh.RegWrite strPath &"\\http", 2,"REG_DWORD"
 
elseif UBound(Split(strABC, strA3 ))>0 then 
Sh.RegWrite strPath &"\\", "", "REG_SZ"
 
Sh.RegWrite strPath &"\\https", 2,"REG_DWORD"
 
Sh.RegWrite strPath &"\\http", 2,"REG_DWORD"
 
elseif UBound(Split(strABC, strA4 ))>0 then 
Sh.RegWrite strPath &"\\", "", "REG_SZ"
 
Sh.RegWrite strPath &"\\https", 2,"REG_DWORD"
 
Sh.RegWrite strPath &"\\http", 2,"REG_DWORD"
 
 
elseif strABC = "" then 
 
msgbox "Пустая строка! Скрипт Завершен!", vbInformation
 
else
 
msgbox "Сайт не содержит доменные зоны:" & vbCrLf & strA1 & chr(160) &  strA2 & chr(160) & strA3 & chr(160) & strA4
 
end if
 
end Function


Если будет появляться у меня что нибудь полезное - обязательно выложу сюда.
3
Mehonchegg
30 / 12 / 3
Регистрация: 08.05.2013
Сообщений: 78
02.10.2014, 20:59 #17
Добавлю пожалуй еще один скрипт
Добавление сетевого принтера.
Visual Basic
1
2
3
4
5
6
7
8
9
10
Option Explicit
Dim WshNetwork
 
 
dim  strPrinterPath 
 
strPrinterPath = InputBox("Введите полный сетевой путь принтера, " & vbCrLf & " который хотите установить на данный ПК"& vbCrLf &"(БЕЗ ПРОБЕЛОВ!!)", "Путь к принтеру", "\\ServerName\PrinterName")
 
Set WshNetwork = WScript.CreateObject("WScript.Network")
WshNetwork.AddWindowsPrinterConnection(strPrinterPath)
Скрипт можно изменить например задать несколько строковых переменных содержащих в себе адреса сетевых принтеров. У меня на работе например таких принтеров 3 - они общие и пользуются ими все, изменил скрипт удалив INPUTBOX и просто расшарил по ГПО пользователи включили ПК и все все три принтера у них имеются. Скажем для удобства на будущее дабы не удалять его из ГПО можно в скрипт добавить проверку существования добавляемого принтера.

Добавлено через 34 минуты
Еще пару скриптов
Собственно скрипт 1.vbs запрашивает имя компа (по умолчанию возвращает имя ПК на котором он запустился), далее создает запрос WQL и дальше с помощью класса и свойств WMI возвращаются, сохраняясь в файл *.csv основные параметры вашего ПК - скажем такая мини инвенторизация. В скрипте я указал где можно и как прописать путь для сохранения файла CSV
Второй скрипт (2.vbs) преобразует файл CSV из первого скрипта в HTML при открытии которого в браузере достаточно удобно выводится вся собранная информация об указанном ПК
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
Const SILENT = False 
Const DATA_DIR = "c:\" 'сетевой ресурс + "\" в конце
Const TITLE = "Инвентаризация компьютеров" 
Const DATA_EXT = ".csv" 'расширение файла отчета
Const HEAD_LINE = True 
'On Error Resume Next
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
'объект WMI
Dim wmio
Dim tf
Dim nwo, comp
Set nwo = CreateObject("WScript.Network")
comp = LCase(nwo.ComputerName)
 
If Not SILENT Then
    comp = InputBox("Введите имя компьютера:", TITLE, comp)
    'проверить доступность компьютера
    If Unavailable(comp) Then
        MsgBox "Компьютер недоступен:" & vbCrLf & comp, vbExclamation, TITLE
        comp = ""
    End If
End If
'провести инвентаризацию
If Len(comp) > 0 Then InventComp(comp)
 
If Len(Err.Description) > 0 Then _
    If Not SILENT Then MsgBox comp & vbCrLf & "Ошибка:" & vbCrLf & Err.Description, vbExclamation, TITLE
Sub InventComp(compname)
    Set wmio = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\" & compname & "\Root\CIMV2")
    'некоторые WMI-классы поддерживаются не во всех версиях Windows
    Dim build
    build = BuildVersion()
    
    Set tf = fso.CreateTextFile(DATA_DIR & compname & DATA_EXT, True)
    'первая строка - заголовки
    If HEAD_LINE Then tf.WriteLine "Секция отчета;Параметр;Номер экземпляра;Значение"
    'дата проверки
    tf.WriteLine "Компьютер;Дата проверки;1;" & Now
    Log "Win32_ComputerSystemProduct", _
        "UUID", "", _
        "Компьютер", _
        "UUID"
    Log "Win32_ComputerSystem", _
        "Name,Domain,PrimaryOwnerName,UserName,TotalPhysicalMemory", "", _
        "Компьютер", _
        "Сетевое имя,Домен,Владелец,Текущий пользователь,Объем памяти (Мб)"
    Log "Win32_OperatingSystem", _
        "Caption,Version,CSDVersion,Description,RegisteredUser,SerialNumber,Organization,InstallDate", "", _
        "Операционная система", _
        "Наименование,Версия,Обновление,Описание,Зарегистрированный пользователь,Серийный номер,Организация,Дата установки"
    Log "Win32_BaseBoard", _
        "Manufacturer,Product,Version,SerialNumber", "", _
        "Материнская плата", _
        "Производитель,Наименование,Версия,Серийный номер"
    Log "Win32_BIOS", _
        "Manufacturer,Name,SMBIOSBIOSVersion,SerialNumber", "", _
        "BIOS", _
        "Производитель,Наименование,Версия,Серийный номер"
    'не определяется Core 2 в XP SP2, см. [url]http://support.microsoft.com/kb/953955[/url]
    Log "Win32_Processor", _
        "Name,Caption,CurrentClockSpeed,ExtClock,L2CacheSize,SocketDesignation,UniqueId", "", _
        "Процессор", _
        "Наименование,Описание,Частота (МГц),Частота FSB (МГц),Размер L2-кеша (кб),Разъем,UID"
    Log "Win32_PhysicalMemory", _
        "Capacity,Speed,DeviceLocator", "", _
        "Модуль памяти", _
        "Размер (Мб),Частота,Размещение"
    'пропускаются USB-диски
    Log "Win32_DiskDrive", _
        "Model,Size,InterfaceType", "InterfaceType <> 'USB'", _
        "Диск", _
        "Наименование,Размер (Гб),Интерфейс"
    'только локальные диски
    'пропускаются USB-диски, размер которых обычно NULL
    Log "Win32_LogicalDisk", _
        "Name,FileSystem,Size,FreeSpace,VolumeSerialNumber", "DriveType = 3 AND Size IS NOT NULL", _
        "Логический диск", _
        "Наименование,Файловая система,Размер (Гб),Свободно (Гб),Серийный номер"
    Log "Win32_CDROMDrive", _
        "Name", "", _
        "CD-привод", _
        "Наименование"
    'только для XP/2003 и выше
    'пропускаются "двойники", имеющие в названии слово "Secondary"
    If build >= 2600 Then
        Log "Win32_VideoController", _
        "Name,AdapterRAM,VideoProcessor,VideoModeDescription,DriverDate,DriverVersion", "NOT (Name LIKE '%Secondary')", _
        "Видеоконтроллер", _
        "Наименование,Объем памяти (Мб),Видеопроцессор,Режим работы,Дата драйвера,Версия драйвера"
    Else 'для Windows 2000
        Log "Win32_VideoController", _
        "Name,AdapterRAM,VideoProcessor,VideoModeDescription,DriverDate,DriverVersion", "", _
        "Видеоконтроллер", _
        "Наименование,Объем памяти (Мб),Видеопроцессор,Режим работы,Дата драйвера,Версия драйвера"
    End If
    'только для XP/2003 и выше
    'пропускаются отключенные сетевые адаптеры, в том числе минипорты
    'пропускаются виртуальные адаптеры VMware
    If build >= 2600 Then
        Log "Win32_NetworkAdapter", _
        "Name,AdapterType,PermanentAddress,MACAddress", "NetConnectionStatus > 0 AND NOT (Name LIKE 'VMware%')", _
        "Сетевой адаптер", _
        "Наименование,Тип,IP-адрес,MAC-адрес"
    Else 'для Windows 2000
        Log "Win32_NetworkAdapter", _
        "Name,PermanentAddress,MACAddress", "", _
        "Сетевой адаптер", _
        "Наименование,IP-адрес,MAC-адрес"
    End If
    Log "Win32_SoundDevice", _
        "Name", "", _
        "Звуковое устройство", _
        "Наименование"
    Log "Win32_SCSIController", _
        "Name", "", _
        "SCSI контроллер", _
        "Наименование"
    If build >= 2600 Then
        Log "Win32_Printer", _
        "Name,PortName,ShareName", "(Local = True OR Network = False) AND (PortName LIKE '%USB%' OR PortName LIKE '%LPT%')", _
        "Принтер", _
        "Наименование,Порт,Сетевое имя"
    End If
    Log "Win32_PortConnector", _
        "ExternalReferenceDesignator,InternalReferenceDesignator", "", _
        "Разъем порта", _
        "Внешний,Внутренний"
    Log "Win32_Keyboard", _
        "Name,Description", "", _
        "Клавиатура", _
        "Наименование,Описание"
    Log "Win32_PointingDevice", _
        "Name", "", _
        "Мышь", _
        "Наименование"
        tf.Close
    If Not SILENT Then MsgBox "Отчет сохранен в файл:" & vbCrLf & DATA_DIR & compname & DATA_EXT, vbInformation, TITLE
End Sub
'составить WQL-запрос, выполнить и записать строку в CSV-файл
'входные параметры:
'from - класс WMI
'sel - свойства WMI, через запятую
'where - условие отбора или пустая строка
'sect - соответствующая секция отчета
'param - соответствующие параметры внутри секции отчета, через запятую
Sub Log(from, sel, where, sect, param)
    Const RETURN_IMMEDIATELY = 16
    Const FORWARD_ONLY = 32
    Dim query, cls, item, prop
    query = "Select " & sel & " From " & from
    If Len(where) > 0 Then query = query & " Where " & where
    Set cls = wmio.ExecQuery(query,, RETURN_IMMEDIATELY + FORWARD_ONLY)
    Dim props, names, num, value
    props = Split(sel, ",")
    names = Split(param, ",")
    num = 1 'номер экземпляра
    For Each item In cls
        For i = 0 To UBound(props)
            Set prop = item.Properties_(props(i))
            value = prop.Value
            'без проверки на Null возможнен вылет с ошибкой
            If IsNull(value) Then
                value = ""
            ElseIf IsArray(value) Then
                value = Join(value,",")
                ElseIf Right(names(i), 4) = "(Мб)" Then
                value = CStr(Round(value / 1024 ^ 2))
            ElseIf Right(names(i), 4) = "(Гб)" Then
                value = CStr(Round(value / 1024 ^ 3))
        ElseIf prop.CIMType = 101 Then
                value = ReadableDate(value)
            End If
            value = Trim(Replace(value, ";", "_"))
            If Len(value) > 0 Then tf.WriteLine sect & ";" & names(i) & ";" & num & ";" & value
        Next 'i
        num = num + 1
    Next 'item
End Sub
Function ReadableDate(str)
    ReadableDate = Mid(str, 7, 2) & "." & Mid(str, 5, 2) & "." & Left(str, 4)
End Function
Function BuildVersion()
    Dim cls, item
    Set cls = wmio.ExecQuery("Select BuildVersion From Win32_WMISetting")
    For Each item In cls
        BuildVersion = CInt(Left(item.BuildVersion, 4))
    Next
End Function
Function Unavailable(addr)
    Dim wmio, ping, p
    Set wmio = GetObject("WinMgmts:{impersonationLevel=impersonate}")
    Set ping = wmio.ExecQuery("SELECT StatusCode FROM Win32_PingStatus WHERE Address = '" & addr & "'")
    For Each p In ping
        If IsNull(p.StatusCode) Then
            Unavailable = True
        Else
            Unavailable = (p.StatusCode <> 0)
        End If
    Next
End Function
1
Mehonchegg
30 / 12 / 3
Регистрация: 08.05.2013
Сообщений: 78
02.10.2014, 20:59 #18
Скрипт 2.vbs
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Const TITLE = "Инвентаризация компьютеров" 
'Const DATA_DIR = "comp\" 
Const DATA_DIR = "c:\" 
Const DATA_EXT = ".csv" 
Const HEAD_LINE = True 
Const REPORT_FILE = "comp_report_%DATE%.htm" 
Dim col(21) 
col(0) = "Компьютер;Сетевое имя"
col(1) = "Компьютер;UUID"
col(2) = "Компьютер;Текущий пользователь"
col(3) = "Операционная система;Наименование"
col(4) = "Операционная система;Обновление"
col(5) = "Материнская плата;Производитель"
col(6) = "Материнская плата;Наименование"
col(7) = "Процессор;Наименование"
col(8) = "Процессор;Частота (МГц)"
col(9) = "Компьютер;Объем памяти (Мб)"
col(10) = "Модуль памяти;Размер (Мб)"
col(11) = "Модуль памяти;Частота"
col(12) = "Диск;Наименование"
col(13) = "Диск;Размер (Гб)"
col(14) = "Диск;Интерфейс"
col(15) = "CD-привод;Наименование"
col(16) = "Видеоконтроллер;Наименование"
col(17) = "Видеоконтроллер;Объем памяти (Мб)"
col(18) = "Сетевой адаптер;Наименование"
col(19) = "Сетевой адаптер;MAC-адрес"
col(20) = "Звуковое устройство;Наименование"
col(21) = "Принтер;Наименование"
Dim header, footer
header = "<html><head>" _
    & "<title>" & TITLE & "</title>" & vbCrLf _
    & "<meta http-equiv=""Content-Type"" content=""text/html; charset=windows-1251"" />" & vbCrLf _
    & "<style><!--" & vbCrLf _
    & "body,table {font: 10pt Arial, sans-serif}" & vbCrLf _
    & "table {border-collapse: collapse}" & vbCrLf _
    & "tr,td,th {border: 1px solid gray; padding: 8px}" & vbCrLf _
    & "td {vertical-align: top}" & vbCrLf _
    & "--></style>" & vbCrLf _
    & "</head><body>" & vbCrLf _
    & "<h3>" & TITLE & ", " & Date & "</h3>" & vbCrLf _
    & "<table>" & vbCrLf
footer = "</table>" & vbCrLf _
    & "</body></html>"
On Error Resume Next
Dim fso, report
Set fso = CreateObject("Scripting.FileSystemObject")
report = Replace(REPORT_FILE, "%DATE%", Date)
Set rep = fso.CreateTextFile(report, True)
rep.Write header
rep.WriteLine "<tr><th>" & Replace(Join(col, "</th><th>"), ";", ":<br />") & "</th></tr>"
Dim dir, fc, f, row
Set dir = fso.GetFolder(DATA_DIR)
Set fc = dir.Files
For Each f in fc
    If Right(f.Name, 4) = DATA_EXT Then row = ReadCSV(dir.Path & "\" & f.Name)
    If Len(row) > 0 Then rep.WriteLine row
Next
rep.Write footer
rep.Close
MsgBox "Отчет сохранен в файл:" & vbCrLf & report & vbCrLf &"на рабочем столе", vbInformation, TITLE
Function IndexCol(s)
    IndexCol = -1
    Dim i
    For i = 0 To UBound(col)
        If col(i) = s Then
            IndexCol = i
            Exit For
        End If
    Next
End Function
Function ReadCSV(fname)
    Dim tf, s, a, k, i
    Dim v()
    ReDim v(UBound(col))
        For i = 0 To UBound(v)
        v(i) = "-"
    Next
    Set tf = fso.OpenTextFile(fname)
    If HEAD_LINE Then tf.ReadLine 
    Do Until tf.AtEndOfStream
        s = tf.ReadLine
        a = Split(s, ";")
        k = a(0) & ";" & a(1)
        i = IndexCol(k)
        If i > -1 Then
            If a(2) > 1 Then 
                v(i) = v(i) & ";" & a(3)
            Else
                v(i) = a(3)
            End If
        End If
    Loop
    tf.Close
    For i = 0 To UBound(v)
        If InStr(v(i), ";") Then v(i) = Replace(v(i), ";", "<br />") 
        'If InStr(v(i), ";") Then v(i) = "<ul><li>" & Replace(v(i), ";", "</li><li>") & "</li></ul>"
    Next
    ReadCSV = "<tr><td>" & Join(v, "</td><td>") & "</td></tr>"
End Function
3
Sergzh
14 / 1 / 0
Регистрация: 20.06.2015
Сообщений: 12
28.06.2015, 14:28 #19
Может кому-то пригодится.
Этот скрипт превращает любой текстовый редактор (Notepad, Notepad++ и др.) в более комфортную среду разработки.
Также, позволяет бесплатно и легально использовать VbsEdit.

Смысл такой:
Висит постоянно диалог запуска (как бы кнопка Run).
При нажатии, скрипт пользователя сохраняется и стартует, отлавливается ошибка и курсор передвигается на строку с ошибкой.
Видео обзор:
https://www.youtube.com/watch?v=47s7L_CX6VQ

Пример для обычного блокнота:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
'### VBS_Starter.vbs ###
'Алгоритм при нажатии кнопки "старт":
'- Активировать окно редактора
'- Послать сочетание клавишь для сохранения файла
'- Запустить редактируемый скрипт пользователя при помощи cscript
'- Получить лог ошибок
'- Вывести сообщение об ошибке
'- Послать в редактор клавиши перемещения в строку с ошибкой
 
 
'получение админских прав, если их нет (скопипастил, автору спасибо)
If WScript.Arguments.length =0 Then
  Set objShell = CreateObject("Shell.Application")
  'Pass a bogus argument with leading blank space, say [ uac]
  objShell.ShellExecute "wscript.exe", Chr(34) & _
  WScript.ScriptFullName & Chr(34) & " uac", "", "runas", 1
Else
'теперь права есть
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = WScript.CreateObject("WScript.Shell")
 
'смена текущего каталога
shell.CurrentDirectory=fso.GetParentFolderName(Wscript.ScriptFullName)
 
'все ли файлы есть для работы
'project.vbs - это файл пользователя
If Not fso.FileExists("project.vbs") Then
    Set f = fso.CreateTextFile ("project.vbs",True)
    f.WriteLine ("'Test file")
    f.WriteLine ("x=10")
    f.WriteLine ("y=20")
    f.WriteLine ("z=?/(y-y)")
    For c=0 To 100
        f.WriteLine ("")
    Next
    f.WriteLine ("z=y/(x-x)")
    f.Close
End If 
 
shell.Run "notepad project.vbs"
 
'перенаправить вывод cscript в файл получилось только из cmd, увы...
If Not fso.FileExists("run.cmd") Then
    Set f = fso.CreateTextFile ("run.cmd",True)
    f.WriteLine ("CScript project.vbs //U 2>>err.log")
    f.Close
End If 
 
'главный цикл
do
    'Popup не замораживает окно редактора
    res=shell.Popup("Запустить project.vbs?",0,"VBS_Starter",vbOkCancel)
    If res=1 Then 
            'активация окна project.vbs
            shell.AppActivate "project.vbs"
            WScript.Sleep (100)
            
            'это последовательность кнопок для сохранения файла в Notepad
            'как послать Ctrl+S я не понял...
            shell.SendKeys "%"
            WScript.Sleep (100)
            For cc=1 To 3
                shell.SendKeys "{DOWN}"
                WScript.Sleep (100)
            Next
            shell.SendKeys "{ENTER}"
 
    
        'удаляем старый лог ошибок
        If fso.FileExists("err.log") then
            Set f = fso.GetFile("err.log")
            f.Delete
        End If
 
            'запускаем project.vbs с помощью cmd
            shell.Run "run.cmd",0, True
        
            If fso.FileExists("err.log") Then   'лог есть
                Set f=fso.GetFile("err.log")    
                If f.Size > 0 Then              'не пустой, значит в project.vbs есть ошибка
                        
                        'читаем лог
                        Set ts = fso.OpenTextFile("err.log",1,-1,-1)
                        s = ts.ReadLine
                        ts.Close
                        'получить номер строки с ошибкой
                        ar = Split(s,"(")
                        ar2 = Split (ar(1),",")
                        ar3 = Split (s,")")
                        ns = ar2(0)
                            
                            'идем в окно project.vbs
                            shell.AppActivate "project.vbs"
                            WScript.Sleep (100)
 
                            'курсор в самое начало
                            'ВНИМАНИЕ, для других редакторов будет другая !!!
                            shell.SendKeys "^{HOME}"
                            WScript.Sleep (100)
                            shell.AppActivate "project.vbs"
                            WScript.Sleep (100)
                                                        
                            'двигаем курсор до ошибки
                            For c=1 To ns-1
                                shell.SendKeys "{DOWN}"
                                WScript.Sleep (1)
                            Next
                                WScript.Sleep (100) 
                                For c=1 To 2
                                    shell.SendKeys "{TAB}"
                                    WScript.Sleep (500)
                                    shell.SendKeys "{BACKSPACE}"
                                    WScript.Sleep (500)
                                Next
                                'сообщаем об ошибке
                                shell.Popup "(" + ar(1),0,"VBS_Starter",16
                                WScript.Sleep (100)
                                'далее все повторяется
                Else 
                        MsgBox "Ваш скрипт успешно завершен.",0,"VBS_Starter"
                End If
            End If
    Else
        'удаляем старый лог ошибок
        If fso.FileExists("err.log") then
            Set f = fso.GetFile("err.log")
            f.Delete
        End If
        'удаляем cmd, для красоты
        If fso.FileExists("run.cmd") then
            Set f = fso.GetFile("run.cmd")
            f.Delete
        End If  
                            'закрываем редактор
                            shell.AppActivate "project.vbs"
                            WScript.Sleep (100)
                            shell.SendKeys "%{F4}"
                            WScript.Sleep (100)                                     
        WScript.Quit        
    End if 
Loop
 
End If
п.с : Путь до папки с проектом не должен содержать символов "(" и ")" иначе может номер строки с ошибкой не правильно распарситься.
1
greg zakharov
Покинул форум
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
22.09.2015, 20:24 #20
Пара стареньких vbs'ок, написанных некогда мной для расширения кругозора.
Аналог утилиты strings от SysInternals:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
On Error Resume Next
Err.Clear
 
Dim args : Set args = WScript.Arguments
Dim pars : Set pars = args.Named
Dim anon : Set anon = args.Unnamed
Dim rexp : Set rexp = New RegExp
 
Dim len, buf, str, enc, ofs, mat, m
 
If args.Count < 1 Then
  WScript.Echo WScript.ScriptName & " v1.0 - search strings in file"
  WScript.Echo "Copyright (C) 2015 greg zakharov" & vbCrLf
  WScript.Echo "Usage: " & WScript.ScriptName & " [/b][/n][/o][/u][/p:<file>]"
  WScript.Echo "  /b - bytes of file to scan"
  WScript.Echo "  /n - minimum string length (default is 3)"
  WScript.Echo "  /o - print offset in file string was located"
  WScript.Echo "  /u - unicode-only search"
  WScript.Quit 1
End If
 
Sub Except()
  If Err.Number <> 0 Then
    WScript.Echo "Error: 0x" & Hex(Err.Number)
    WScript.Quit 1
  End If
End Sub
 
With CreateObject("Scripting.FileSystemObject")
  If Not .FileExists(anon(0)) Then
    WScript.Echo "File not found or does not exist."
    WScript.Quit 1
  End If
  
  anon = .GetAbsolutePathName(anon(0)) 'required for SpFileStream
  len = .GetFile(anon).Size
End With
 
'bytes to process
If pars.Exists("B") Then
  If CInt(pars.Item("B")) > len Then
    WScript.Echo "Out of range."
    WScript.Quit 1
  End If
  
  len = CInt(pars.Item("B"))
End If
 
With CreateObject("SAPI.SpFileStream")
  .Open anon, 0
  Except() 'error opening file
  .Read buf, len
  .Close
End With
 
'string length
If pars.Exists("N") Then
  str = CInt(pars.Item("N"))
Else
  str = 3
End If
 
'encoding
If pars.Exists("U") Then
  Set enc = CreateObject("System.Text.UnicodeEncoding")
Else
  Set enc = CreateObject("System.Text.UTF7Encoding")
End If
 
'offsets condition
If pars.Exists("O") Then
  ofs = True
End If
 
'looking for strings
rexp.Pattern = "[\x20-\x7E]{" & CStr(str) & ",}"
rexp.Global = True
rexp.IgnoreCase = True
 
Set mat = rexp.Execute(enc.GetString((buf)))
For Each m In mat
  If ofs Then
    WScript.Echo m.FirstIndex & ": " & m
  Else
    WScript.Echo m
  End If
Next
Вычисление md5 файла:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
On Error Resume Next
 
Dim args : Set args = WScript.Arguments
Dim arg, len, buf, raw, res
 
Sub Exception()
  If Err.Number <> 0 Then
    WScript.Echo "Error: 0x" & Hex(Err.Number)
    Err.Clear
    WScript.Quit Err.Number
  End If
End Sub
 
If args.Count <> 1 Then
  WScript.Echo "Index is out of range."
  WScript.Quit 1
End If
 
arg = args.Unnamed(0)
With CreateObject("Scripting.FileSystemObject")
  If Not .FileExists(arg) Then
    WScript.Echo "File not found or does not exist."
    WScript.Quit 1
  End If
  
  len = .GetFile(arg).Size
  arg = .GetAbsolutePathName(arg)
End With
 
With CreateObject("SAPI.spFileStream")
  .Open arg, 0
  Exception()
  .Read buf, len
  .Close
End With
 
With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
  Exception()
  raw = .ComputeHash_2((buf))
  For i = 1 To LenB(raw)
    res = res & Right("0" & Hex(AscB(MidB(raw, i, 1))), 2)
  Next
  
  WScript.Echo LCase(res)
End With
2
greg zakharov
Покинул форум
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
10.11.2015, 10:16 #21
Uptime (без использования WMI):
Javascript
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
(function() {
  var enc, arr, i, s = '', std,
      loc = {
        419 : ['019', '1251'],
        409 : ['009', '1252']
      };
  
  Array.prototype.to_s = function() {
    var s = '';
    
    for (var i = 0; i < this.length; i++) {
      s += i === 0 ? parseInt(this[i]) + '.'
        : (parseInt(this[i]) < 10 ? '0' + parseInt(this[i]) : parseInt(this[i])) + ':';
    }
    return s.replace(/\:$/, '');
  };
  
  with (new ActiveXObject('WScript.Shell')) {
    enc = Number(RegRead('HKCU\\Control Panel\\International\\Locale'));
    arr = RegRead(
      'HKLM\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\' +
      'PerfLib\\' + loc[enc][0] + '\\Counter'
    ).toArray();
    
    for (i = 0; i < arr.length; i++) {
      if (parseInt(arr[i]) === 2 || parseInt(arr[i]) === 674) {
        s += '\\' + arr[i + 1];
      }
    }
    
    std = Exec('cmd /c chcp');
    i = std.StdOut.ReadAll().match(/\d+/);
    std = Exec('cmd /q /k echo off');
    std.StdIn.WriteLine('chcp ' + loc[enc][1]);
    std.StdIn.WriteLine('typeperf "' + s + '" -sc 1');
    std.StdIn.WriteLine('chcp ' + i + '&exit');
    s = parseInt(std.StdOut.ReadAll().match(/\d+\.\d+/g)[2]);
  };
  WScript.echo([s / 86400, s / 3600 % 24, s % 3600 / 60, s % 60].to_s());
}());
Генерация случайного файла (функция генерирует случайное имя со случайным расширением):
Javascript
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(function(len) {
  if (isNaN(len) || (len > 32 || len < 1)) {
    WScript.echo('Should be a number ranging from 1 to 32.');
    WScript.Quit(1);
  }
  
  var getRandom = function(min, max) {
    return Math.floor(Math.random() * (max - min + 1)) + min;
  };
  
  var std, arr, i, ext = [];
  with (new ActiveXObject('WScript.Shell')) {
    std = Exec('cmd /q /k echo off');
    std.StdIn.WriteLine('assoc & exit');
    arr = std.StdOut.ReadAll().split('\n');
  }
  
  for (i = 0; i < arr.length; i++) {
    if (!arr[i].match(/.\d+\=/) && arr[i].match(/=\w+/)) {
      ext.push(arr[i].split('=')[0]);
    }
  }
  
  with (new ActiveXObject('Scriptlet.TypeLib')) {
    WScript.echo(GUID.substring(1, 37).replace(/-/g, '')
      .toLowerCase().slice(0, len) + ext[getRandom(0, ext.length - 1)]
    );
  }
}(
  WScript.Arguments.length !== 1
  ? WScript.Quit(1)
  : WScript.Arguments.Unnamed(0)
));
2
xeon13
-17 / 32 / 1
Регистрация: 22.11.2012
Сообщений: 256
13.11.2015, 09:15 #22
Uptime простейший.
Visual Basic
1
2
3
4
5
6
7
'Писал для себя по примерам в интернете. E}|{uk@RUSnet
Set objDT = CreateObject ("WbemScripting.SWbemDateTime") 
For Each objItem in GetObject ("winmgmts:root\cimv2").Get ("Win32_OperatingSystem").Instances_ 
       objDT.value = objItem.LastBootUpTime 
       nUp = DateDiff ("n", objDT.GetVarDate (TRUE), NOW) 
       wscript.echo "Up for", int (nUp/1440), "Day(s)", int (nUp/60) mod 24, "hour(s)", nUp mod 60, "minute(s)" 
Next
Добавлено через 38 минут
Скрипт получения имени пользователя и по имени локального компа по SIDу
Часто бывает необходим для выяснения кто стал причиной ошибки в журнале виндовс.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
'Скрипт получения имени пользователя и по имени локального компа по SIDу (VBScript)
'Просто в появившемся диалоговом окне вводим SID нужного юзверя ОК
'Автор E}|{uk@RUSnet (xeon) 2013г.
 
sSID = InputBox ("Введите SID пользователя:")
 
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & strComputer & "\root\cimv2")
Set objAccount = objWMIService.Get _
("Win32_SID.SID='" & sSID & "'")
Wscript.Echo "ИмяПольз\ИмяКомпДомен: " & objAccount.AccountName & " \ " & objAccount.ReferencedDomainName
Добавлено через 20 минут
Visual Basic
1
2
3
4
'Скрпт синхронизирующий время с указанной рабочей станции. \\adms
'Автор E}|{uk@RUSnet (xeon)
set WshShell = WScript.CreateObject("WScript.Shell")  
WSHShell.Run "net time \\adms /set /yes", 0, True
1
greg zakharov
Покинул форум
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
16.11.2015, 11:05 #23
Определяет физическое местоположение COM-модуля.
Javascript
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(function(com) {
  try {
    with (new ActiveXObject('WScript.Shell')) {
      WScript.Echo(RegRead('HKLM\\SOFTWARE\\Classes\\CLSID\\' +
        RegRead('HKLM\\SOFTWARE\\Classes\\' + com + '\\CLSID\\') +
      '\\InProcServer32\\'));
    }
  }
  catch (e) {
    WScript.echo('Error (' + e.number + '): unknown COM on this system.');
  }
}(
  WScript.Arguments.length !== 1
  ? (function() {
    WScript.echo('Usage: ' + WScript.ScriptName + ' <COM>');
    WScript.echo('e.g.: ' + WScript.ScriptName + ' Scripting.FileSystemObject');
    WScript.Quit(1);
  }()) : WScript.Arguments.Unnamed(0)
));
1
xeon13
-17 / 32 / 1
Регистрация: 22.11.2012
Сообщений: 256
20.11.2015, 16:03 #24
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
'####################################################
'#  Скрипт для автоматического изменения или добавления логотипа  Фирмы#
'#  в свойствах системы Win7. Можно использовать в доменных политиках      #
'# Необходимо, чтобы в папке со скриптом лежал сам логотип oemlogo.bmp
'# У мена размер логотипа был: 120 x 33 x 24 BPP
'#   Автор: E}|{uk@RUSnet 2015год                    #
'####################################################
 
'Копирование логотипа
 
strComputer = "."
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
 
'#######добавил проверку наличия папки и её создание########
'переменная пути с папкой логотипа
strDirectory = "c:\Windows\System32\oobe\info"
 
'если переменная strDirectory есть то...
If objFSO.FolderExists(strDirectory) Then 
'попытка открытия папки.
Set objFolder = objFSO.GetFolder(strDirectory) 
'Для оповещения ниже строчку можно раскоментировать.
'WScript.Echo "Папка  ''"& strDirectory &"''  уже создана " 
Else
Set objFolder = objFSO.CreateFolder(strDirectory) 
'Для оповещения ниже строчку можно раскоментировать.
'WScript.Echo "Вновь созданная папка ''"& strDirectory &"''."
End If
 
'##########проверка окончена#################################
 
objFSO.CopyFile "oemlogo.bmp", "c:\Windows\System32\oobe\info\oemlogo.bmp", True
    If Err.Number <> 0 Then
set  mes = Err.Number & ": " & Err.Description
MsgBox mes, 0, " Внимание!!!"
'       WScript.Quit
    end if
 
'Удаление лишний инфы с реестра OEMINFO.
On error Resume Next
Set SHELL = CreateObject("WScript.Shell")
 
RegValue = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows" & _
"CurrentVersion\OEMInformation\Manufacturer"
SHELL.RegWrite RegValue, "", "REG_SZ"
    If Err.Number <> 0 Then
        WScript.Echo "Не добавился ключ: " & RegValue
        WScript.Quit
    end if
 
RegValue = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows" & _
"CurrentVersion\OEMInformation\Model"
SHELL.RegWrite RegValue, "", "REG_SZ"
    If Err.Number <> 0 Then
        WScript.Echo "Не добавился ключ: " & RegValue
        WScript.Quit
    end if
 
RegValue = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows" & _
"CurrentVersion\OEMInformation\SupportHours"
SHELL.RegWrite RegValue, "", "REG_SZ"
    If Err.Number <> 0 Then
        WScript.Echo "Не добавился ключ: " & RegValue
        WScript.Quit
    end if
 
RegValue = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows" & _
"CurrentVersion\OEMInformation\SupportPhone"
SHELL.RegWrite RegValue, "", "REG_SZ"
    If Err.Number <> 0 Then
        WScript.Echo "Не добавился ключ: " & RegValue
        WScript.Quit
    end if
 
RegValue = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows" & _
"CurrentVersion\OEMInformation\SupportURL"
SHELL.RegWrite RegValue, "", "REG_SZ"
    If Err.Number <> 0 Then
        WScript.Echo "Не добавился ключ: " & RegValue
        WScript.Quit
    end if
 
RegValue = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows" & _
"CurrentVersion\OEMInformation\Logo"
SHELL.RegWrite RegValue, "\Windows\System32\oobe\info\oemlogo.bmp", "REG_SZ"
    If Err.Number <> 0 Then
        WScript.Echo "Не добавился ключ: " & RegValue
        WScript.Quit
    end if
 
wscript.echo "Логотип добавлен, инфа oeminf стёрта."
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
'####################################################
'# Скрипт на изменение добавление логотипа Фирмы   #
'# В свойствах системы WinXP   Можно использовать в доменных политиках  #
'# Необходимо, чтобы в папке со скриптом лежал сам логотип oemlogo.bmp
'# и файл oeminfo.ini с содержанием:
'# [General]
'# Manufacturer=СуперКомпьютер:
'# Model=
'# 
'# [Support Information]
'# Line1=
'# Line2=
'# У мена размер логотипа был: 120 x 33 x 16бит. при 24Битах - отображается белый фон.
'#   Автор: E}|{uk@RUSnet 2010год                    #
'####################################################
 
'Копирование логотипа
 
strComputer = "."
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
 
objFSO.CopyFile "oemlogo.bmp", "c:\Windows\System32\oemlogo.bmp", True
    If Err.Number <> 0 Then
set  mes = Err.Number & ": " & Err.Description
MsgBox mes, 0, " Внимание!!!"
'       WScript.Quit
    end if
 
objFSO.CopyFile "oeminfo.ini", "c:\Windows\System32\oeminfo.ini", True
    If Err.Number <> 0 Then
set  mes = Err.Number & ": " & Err.Description
MsgBox mes, 0, " Внимание!!!"
'       WScript.Quit
    end if
 
wscript.echo "Логотип добавлен"
1
greg zakharov
Покинул форум
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
30.11.2015, 13:22 #25
Crc32 файла
Суть идеи - запихать файл в zip и уже оттуда получить Crc32 файла (смещение 14 байт от начала архива, само поле crc32 - 4 байта). Концепт расчитан прежде не на шибко большие файлы.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
On Error Resume Next
 
If WScript.Arguments.Count <> 1 Then
  WScript.Echo "Usage: " & WScript.ScriptName & " <file>"
  WScript.Echo ".e.g.: " & WScript.ScriptName & " E:\sandbox\app.exe"
  WScript.Quit(1)
End If
 
Dim strFile
Dim strTemp
Dim objFile
Dim objDump
Dim strDump
 
strFile = WScript.Arguments.Unnamed(0)
 
With CreateObject("Scripting.FileSystemObject")
  If Not .FileExists(strFile) Then
    WScript.Echo "Could not locate specified file."
    WScript.Quit(1)
  End If
  
  strFile = .GetAbsolutePathName(strFile)
  strTemp = .BuildPath(.GetSpecialFolder(2), "~crc32.zip")
  
  Set objFile = .CreateTextFile(strTemp)
  objFile.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
  objFile.Close
  
  With CreateObject("Shell.Application")
    .NameSpace(strTemp).CopyHere strFile
    WScript.Sleep 500
  End With
  
  With CreateObject("SAPI.SpFileStream")
    .Open strTemp, 0
    .Seek 14, 1
    .Read objDump, 4
    .Close
  End With
  
  With CreateObject("Microsoft.XMLDOM")
    Set strDump = .createElement("Binary")
    strDump.dataType = "bin.hex"
    strDump.nodeTypedValue = objDump
  End With
  
  strDump = strDump.text
  WScript.StdOut.Write "0x"
  For i = Len(strDump) - 1 To 0 Step -2
    WScript.StdOut.Write UCase(Mid(strDump, i, 2))
  Next
  WScript.Echo
  .GetFile(strTemp).Delete
End With
1
xeon13
-17 / 32 / 1
Регистрация: 22.11.2012
Сообщений: 256
11.12.2015, 15:04 #26
Скрипт получения полного имени пользователя и его описание из домена
возникла необходимость узнавать, кто открыл файл ексель.
Автор E}|{uk@RUSnet 2015г.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
'#####################################################
'# Скрипт получения полного имени пользователя и его описание из домена
'# возникла необходимость узнавать, кто открыл файл ексель.
'# Автор E}|{uk@RUSnet 2015г.
'#####################################################
 
set nw = WScript.CreateObject("WScript.Network")
username=InputBox ("Введите логин пользователя:")
 
'Вместо DOMEN меняем на свой домен в сети.
set objuser = GetObject("WinNT://DOMEN/" & username)
 
wscript.Echo (username) & " => " & (objuser.fullname) & " (" & (objuser.description) &")"
1
Oleg_cyber
5 / 5 / 1
Регистрация: 03.02.2012
Сообщений: 102
15.03.2016, 13:53 #27
Доброго времени суток!
Предлагаю вашему вниманию небольшой vbскриптик с помощью которого можно создать ярлык для программы в меню программ кнопки Пуск

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Dim FSO, file, oFile, objArgs, n, p, pf, WshShell, link
Set objArgs = WScript.Arguments
If objArgs.Count > 0 Then file = objArgs(0)
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
Set oFile = FSO.GetFile(file)
p = oFile.Path
n = FSO.GetBaseName(p)
pf = oFile.ParentFolder
Set WshShell = WScript.CreateObject("WScript.Shell")
Set link = WshShell.CreateShortcut("C:\Users\имя_пользователя\AppData\Roaming\Microsoft\Windows\Start Menu\Programs" & n & ".lnk")
link.TargetPath = p
link.WindowStyle = 1
link.Description = "Shortcut Script"
link.WorkingDirectory = pf
link.Save
MsgBox "     Ярлык создан!"
Скопируйте код в блокнот и сохраните с расширением .vbs (в 10-й строке замените имя_пользователя на ваше имя)
Затем нажмите win+R и введите shell:sendto и ОК
Перетащите файл в эту папку. Далее просто: ПКМ на нужном файле > Отправить > Ваш скрипт--Готово!
1
xeon13
-17 / 32 / 1
Регистрация: 22.11.2012
Сообщений: 256
15.04.2016, 15:25 #28
NetCompNameMAIN+Timer.vbs Скрипт вывода сообщения Имени Компьютера и Юзера по таймеру. (Можно засунуть в доменные политики)

Несколько лет бился с тем что юзеры не желают знать сетевого имени своего компа и имени юзера.
Написал поначалу скрипт вывода сообщения при включении и всунул в политики домена. Юзеры стали тупо нажимать ОК и не читали, а потом при звонке в ИТ отдел только бе и ме, "придите сами посмотрите". Бегать неохота, проще подключиться удалённо, но без опознавательных координат это сложно. Вобщем вот сегодня прикрутил таймер к этому скрипту, чтобы ленивый юзер задолбался нажимать ОК, так как сообщение будет выскакивать снова поверх окон и заставит его вчитаться и запомнить. Вобщем собрал по интернетам из кусков скриптег и добавил свои вкусности . Думаю мою работу оценять многие начинающие админы ))).

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
'Скрипт вывода Имени Компьютера и имени пользователя
'Сообщение нельзя закрыть по истечению времени
' Автор: E}|{uk@RUSnet #Dimitrovgrad 2016г.
' Спасибо "гуру" из интернета создавшему вывод сообщения по таймеру...
 
 
rem Option Explicit
 
Dim WshShell
 
Dim intTime4Show                  ' Заданное (оно же максимально возможное) время показа сообщения
Dim intMinimumTime                ' Минимальное время показа сообщения
Dim intTimeStartShowing           ' Время начала показа сообщения
Dim intRetValue                   ' Возвращаемое значение метода .Popup
Dim WshSysEnv, SysInfo, COMPUTERNAME, USERNAME 
 
Set WshShell = WScript.CreateObject("WScript.Shell")
 
intTime4Show    = 60              ' Заданное    время показа сообщения — 1 минута
intMinimumTime  = 10              ' Минимальное время показа сообщения — 10 секунд
 
intTimeStartShowing = Timer       ' Засекаем время
 
 
Function Server()
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    If Err.Number <> 0 Then
        rem WScript.Echo Err.Number & Err.Description
        WScript.Quit
    End If
    Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    strInfo = vbNullString
    For Each objOperatingSystem in colOperatingSystems
        strInfo=objOperatingSystem.Caption & " __ " & objOperatingSystem.Version
        Exit For
    Next
    Server = 0
    If InStr(LCase(strInfo),LCase("server"))>0 Then 
        Server = 1
    End If
End Function
 
 
If Server()=0 Then
    'создаем объект WshShell: 
    Set WshShell = WScript.CreateObject("WScript.Shell") 
 
    'создаем объект Environment со значением SYSTEM: 
    COMPUTERNAME = WshShell.Environment("PROCESS").Item("COMPUTERNAME")
    USERNAME = WshShell.Environment("PROCESS").Item("USERNAME")
 
    SysInfo = "Для обращения в отдел ИТ Запомните!     " & vbCrLf & vbCrLf & _
    "Ваш  ""КОМПЬЮТЕР"" —  " & COMPUTERNAME & "          "  & vbCrLf & vbCrLf & _
    "Ваш  ""ПОЛЬЗОВАТЕЛЬ"" —  "  & USERNAME & vbCrLf _
 
End If
 
Do
 
'   Код 262144 - поверх всех окон, а 64 значёк информативного сообщения.
    MsgBox SysInfo, 262144 + 64, " Внимание!!!"
 
    ' Повторяем вывод сообщения, пока не будет выполнено одно из условий:
    ' 1. Истечёт отведённое время и сообщение будет закрыто по таймауту [intRetValue = -1]
    ' 2. Сообщение будет закрыто вручную и с момента первого показа
    '    сообщения до текущего момента пройдёт не менее минимального [intMinimumTime]
    '    времени [(Timer - intTimeStartShowing) > intMinimumTime]
 
Loop Until intRetValue = -1 Or (Timer - intTimeStartShowing) > intMinimumTime
 
Set WshShell = Nothing
 
WScript.Quit 0
2
Dragokas
Эксперт WindowsАвтор FAQ
16042 / 6860 / 826
Регистрация: 25.12.2011
Сообщений: 10,613
Записей в блоге: 16
15.05.2017, 20:11  [ТС] #29
Registry Time Decoder

Консольный VBS скрипт.

Позволяет увидеть в привычном формате DD.MM.YYYY hh:mm:ss даты, которые указаны в реестре в бинарном формате или в виде 16-ричного значения.

Можно указывать на выбор:
  • бинарную строку
  • 16-ричное число
  • путь к параметру реестра
Поддерживаемые форматы:
  • Unix-Time (4 байта)
  • FILETIME (8 байт)
  • SYSTEMTIME (16 байт)

Фейс и доп. инфа

Полезные VBS скрипты и программы по работе с ними

Примечание:
Скрипт поддерживает задание конвертируемой строки через аргументы, например:
Код
cscript путь\RegTimeDecoder.vbs 00,80,8c,a3,c5,94,c6,01
Скрипт может попросить повышения привилегий, если ему их не хватит, чтобы прочитать параметр реестра.

Буфер обмена
Чтобы вставить содержимое буфера обмена в окно консоли CSCRIPT, нажмите правой кнопкой мыши по заголовку окна => Свойства => Общие => Поставьте галочку на "Выделение мышью" => ОК.
Теперь вы сможете вставлять буфер правой кнопкой мышки.
Полезные VBS скрипты и программы по работе с ними

1
Вложения
Тип файла: zip RegTimeDecoder.zip (3.2 Кб, 2 просмотров)
buggydancer
250 / 238 / 16
Регистрация: 31.12.2009
Сообщений: 323
01.06.2017, 09:18 #30
Календарь к 100 летию "нового стиля" для применения в издательском/полиграфическом деле а также для SOHO/ИЧП, фрилансеров и просто хороших людей ; данный пост есть ссылка на соотв. тред в котором (в том треде) планируется возможные (надеюсь) доработки, обсуждения и более новый версии
HTA: Вечный календарь к 100 летию "нового стиля"
1
01.06.2017, 09:18
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
01.06.2017, 09:18
Привет! Вот еще темы с ответами:

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

Полезные BAT/CMD скрипты - CMD/BAT
В этой теме выкладываем скрипты, которые часто используются Вами или на Ваш взгляд могут иметь большое практическое значение. Также...

Полезные коды и авторские программы на Lisp - Lisp
Расскажите, пожалуйста, что на лиспе пишите? вкратце, хотя бы. Очень интересно. Понятно, что студенты пишут лабы, но вот все остальные,...

Полезные программы для програмистов под VB - Visual Basic
Предлагаю сюда скидывать все программы которые упрощают жизнь програмисту. Например: - Программа для генерации MsgBox в виде готовой...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
30
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru