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

Dragokas · Регистрация: 25.12.2011

Студворк — интернет-сервис помощи студентам

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

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

Правила темы:

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

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

******************* Перечень полезных скриптов: *******************
Отправка файла на FTP (Drag & Drop) и копирование ссылки в буфер обмена ссылка
Получение времени сервера ссылка

@мама Стифлера · 20.09.2021, 14:10

Осмелюсь выложить скрипт от FlasherX, делался для меня. Инфу авторства добавил и считаю данный скрипт полезным.
Назначение в шапке.

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
'———————————————————————————————————————————————
' Инфа из журнала событий ПК, времени
' выключения/включения, ухода в сон/выхода из сна,
' а так же время аварийного выключения ПК 
' Автор — FlasherX (05.08.2021)
' Работа под заказ, ссылка на тему:
' https://www.cyberforum.ru/cmd-bat/thread2860915.html
'———————————————————————————————————————————————
Option Explicit: Const Max = 10 ' максимальное число строк
Dim TZ, oDate, oColl, i, Mess, Arr, D, Dt, s, Text, c
With CreateObject("WScript.Shell")
   TZ = Mid(.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\" &_
   .RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\TimeZoneKeyName") & "\Display"), 5, 3)
End With
If Left(TZ, 1) = ")" Then TZ = 0 Else TZ = Int(TZ)
Set oDate = CreateObject("WbemScripting.SWbemDateTime")
Set oColl = CreateObject("System.Collections.ArrayList")
 
For Each i In GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery _
("Select EventCode,Message,TimeWritten from Win32_NTLogEvent Where Logfile='System' AND (EventCode=1 OR " &_
"EventCode=12 OR EventCode=13 OR EventCode=109 Or EventCode=1074 Or EventCode=6005 Or EventCode=6006 Or EventCode=6008)")
   Mess = Replace(i.Message, vbCrLf & vbCrLf, vbCrLf): Dt = Empty
   If i.EventCode = 1 Then
      Arr = Split(Mess, vbCrLf)
      If UBound(Arr) = 3 Then Mess = Array(M(Arr(2)), M(Arr(1))) Else Mess = Empty
   Else
      If InStr(" 12 13 ", " " & i.EventCode & " ") Then Mess = M(Mess) Else _
      oDate.Value = i.TimeWritten: D = Split(oDate.GetVarDate): Dt = Dx
      Mess = Array(Mess)
   End If
   If Not IsEmpty(Mess) Then
      For Each s In Mess
         c = c + 1: If c <= Max Then oColl.Add Dt & s
      Next
   End If
   If c >= Max Then Exit For
Next
 
oColl.Sort: oColl.Reverse
With New RegExp
   .Global = 1: .Pattern = "(^|\n)(\d{4})(\.\d{2}\.)(\d{2})(?=[^\n]+)"
   WSH.Echo String(20, "-") & vbLf & .Replace(Join(oColl.ToArray, vbLf & String(20, "-") & vbLf), "$1$4$3$2") & vbLf & String(20, "-")
End With
oColl.Clear: Set oColl = Nothing: Set oDate = Nothing
 
Function M(Msg)
   Dim TM: TM = Split(Msg)(UBound(Split(Msg)))
   D = Split(DateAdd("h", TZ, Replace(Replace(Split(TM, ".")(0), ChrW(8206), ""), "T", " ")))
   M = Dx & Replace(Msg, ": " & TM, "") & "."
End Function
 
Function Dx
   Dx = Year(D(0)) & "." & Right("0" & Month(D(0)), 2) & "." & Right("0" & Day(D(0)), 2) & " " & Right("0" & D(1), 8) & vbTab
End Function

@HACKER KAY · 21.09.2021, 14:15

Меняем заголовок консоли (cscript)

Visual Basic
1
2
3
4
5
Function title(txt)
    Set objWSH = CreateObject("WScript.Shell")
    strCommand = "cmd.exe /c title " & txt
    Set objA = objWSH.Exec(strCommand)
End Function

Использование:

Visual Basic
1
title("Console title")

FlasherX · 25.11.2021, 22:40

Тут где-то спрашивали про производительность (Win7+). Выложу свой стырый код, пожалуй:

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
'—————————————————————————————————————————————————————————
' Назначение:  Оценка производительности компьютера
' Публикация:  https://www.cyberforum.ru/post15878188.html
' Авторство:   FlasherX (25.01.2013)
'—————————————————————————————————————————————————————————
For Each I in GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * From Win32_WinSAT")
   CPU   = I.CPUScore
   Mem   = I.MemoryScore
   Graph = I.GraphicsScore
   Game  = I.D3DScore
   HD    = I.DiskScore
   Min   = I.WinSPRLevel
Next
MsgBox _
"Процессор:"             & vT(3) & CPU    & vbCr &_
"Память (RAM):"          & vT(3) & Mem    & vbCr &_
"Графика:"               & vT(4) & Graph  & vbCr &_
"Графика для игр:"       & vT(3) & Game   & vbCr &_
"Основной жёсткий диск:" & vT(2) & HD & vbCr & vbCr &_
"Минимальная оценка:"    & vT(2) & Min    & vbCr &_
"Средняя оценка:"        & vT(3) & (CPU+Mem+Graph+Game+HD)/5,_
262208, "     Оценка производительности компьютера"
Function vT(n): vT = String(n, vbTab): End Function

@trdm · 05.01.2022, 12:06

Если у вас система x64 и VBScript перестает вызывать отладчик по команде stop или отладчик глючит,
попробуйте запустить скрипт из под x32-разрядного приложения. К примеру из-под "Total Commander 32 bit"

обнаружил тот же эффект для javascript/debugger;
убил день на это

Отладчик запускается и пашет (Microsoft Visual Studio 2005).

@Jenyok2 · 28.09.2022, 10:37

Скрипты запуска из командной строки БЕЗ C(W)Script.exe в командной строке и с передачей аргументов скриптам.
.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function forceCScriptExecutionC()
  Dim WshShell, Arg, Arguments
  If Not LCase(Right(WScript.FullName, 11)) = LCase("CScript.exe") Then
    Arguments = ""
    For Each Arg In WScript.Arguments
      If InStr(Arg, " ") Then Arg = """" & Arg & """"
      Arguments = Arguments & " " & Arg
    Next
    Set WshShell = CreateObject("Wscript.Shell")
    WshShell.Run "CScript.exe //nologo " & Chr(34) & WScript.ScriptFullName & Chr(34) & Space(1) & Arguments, 1
    WScript.Quit
  End If
  Arg = Empty
  Arguments = Empty
End Function

.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function forceCScriptExecutionW()
  Dim WshShell, Arg, Arguments
  If Not LCase(Right(WScript.FullName, 11)) = LCase("WScript.exe") Then
    Arguments = ""
    For Each Arg In WScript.Arguments
      If InStr(Arg, " ") Then Arg = """" & Arg & """"
      Arguments = Arguments & " " & Arg
    Next
    Set WshShell = CreateObject("Wscript.Shell")
    WshShell.Run "WScript.exe //nologo " & Chr(34) & WScript.ScriptFullName & Chr(34) & Space(1) & Arguments, 1
    WScript.Quit
  End If
  Arg = Empty
  Arguments = Empty
End Function

.
Вызов скриптов.
.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
' ===== main part =====
CALL forceCScriptExecutionC()
'
' Тело функции "forceCScriptExecutionC()" здесь
'
' Исполняемый код скрипта ниже
'
If DEBUG_VBS_INIT = 1 Then
  WScript.StdOut.WriteLine "Test"
  WScript.Echo "Test"
End If 
WScript.Sleep 3000

.

@Jenyok2 · 30.09.2022, 06:50

Проверка заданной папки на существование папки(ок) или файла(ов) по маске.
ffFileorFolder = True - проверка файлов по маске
ffFileorFolder = False - проверка подпапок по маске
.

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
Option Explicit
On Error Resume Next
Function FileFolderExistsMask(ffPath, ffMask, ffFileorFolder)
  ' ffFileorFolder = True  -> Files Mask
  ' ffFileorFolder = False -> Folders Mask
  Dim objShellApp
  Dim objFolder
  Dim objFolderItems
  FileFolderExistsMask = False
  Set objShellApp = CreateObject("Shell.Application")
  Set objFolder = objShellApp.NameSpace(ffPath)
  Set objFolderItems = objFolder.Items
  '0x20 = 32  - учитывать папки
  '0x40 = 64  - учитывать НЕ папки
  '0x80 = 128 - учитывать скрытые элементы
  If ffFileorFolder = True Then
    objFolderItems.Filter 64 + 128, ffMask
  End If
  If ffFileorFolder = False Then
    objFolderItems.Filter 32 + 128, ffMask
  End If
  If objFolderItems.Count > 0 Then
    FileFolderExistsMask = True
  End If
  Set objShellApp = Nothing
  Set objFolder = Nothing
  Set objFolderItems = Nothing
End Function
' Вызов и проверка функции
WScript.StdOut.WriteLine "Files: " & FileFolderExistsMask("C:\TMP", "*.docx", True)
WScript.StdOut.WriteLine "Files: " & FileFolderExistsMask("C:\TMP", "*.tmp", True)
WScript.StdOut.WriteLine "Files: " & FileFolderExistsMask("C:\TMP", "*.*", True)
WScript.StdOut.WriteLine "Folders: " & FileFolderExistsMask("C:\TMP", "2021_??", False)
WScript.StdOut.WriteLine "Folders: " & FileFolderExistsMask("C:\TMP", "2022_??", False)
WScript.Quit 0

.

@Jenyok2 · 07.10.2022, 09:13

Скрипт "vbs_execute2.vbs" для массовой архивации файлов или папок по году (лог файлы, файлы с именем одинаковой структуры, папки с выгруженной информацией одинаковой структуры)
и последующим удалением архивированных файлов или папок.
См. прикрепленный архив.
.
Исправил ошибки в скрипте.
.
Скрипт можно запускать из командной строки
"vbs_execute2.vbs"
или
"cscript.exe vbs_execute2.vbs"
.
В заголовке скрипта есть настроечные константы для отладки скрипта с комментариями.
.
Имя файла архива создается из имени директории где архивируются файлы и/или папки.
Если имя архива уже существует, то к имени файла архива добавляется индекс "_01", "_02" и т.д.
В имени файла архива можно убрать часть имени настроечной константой, например, имя корневой директории.
.
Все действия скрипта пишутся в подробный лог файл.
.
Параметры скрипта
"ARC_Year" - год архивации
"Folder_to_ARC" - папка в которой содержаться файлы или папки для архивации
"Folder_where_ARC" - папка в которую помещается готовый архив. Папки "Folder_to_ARC" и "Folder_where_ARC" могут совпадать.
"ARC_Attrib" - атрибут архивации
"FileDir_Mask" - маска файлов или папок для архивации. Этот параметр необходим ТОЛЬКО для атрибута архивации "FileMask" или "DirMask".
.
Атрибут архивации
"FileMask" - архивация файлов по маске файла, например, маска файла(ов) для архивации "2022_??*.log" и тому подобное. В маске файла(ов) должен содержаться год архивации.
"DirMask" - архивация папок по маске папки, например, маска папки(ок) для архивации "2022-??-??" и тому подобное. В маске папки(ок) должен содержаться год архивации.
"FileDate" - архивация файлов по дате (году) СОЗДАНИЯ файла, например, дата СОЗДАНИЯ файла(ов) равна дате параметра скрипта "ARC_Year".
"DirDate" - архивация папок по дате (году) СОЗДАНИЯ папки, например, дата СОЗДАНИЯ папки(ок) равна дате параметра скрипта "ARC_Year".
.
В папке, откуда запущен скрипт, должны находиться следующие файлы: "Rar.exe" и "rarreg.key" не ниже версии 6 .
.

@nekit270 · 30.06.2024, 07:49

Скачивание бинарного (т.е. любого) файла

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub DownloadBinaryFile(url, fileName)
    ' Отправка запроса на сервер
    Set xhr = WSH.CreateObject("WinHttp.WinHttpRequest.5.1")
    xhr.open "GET", url, 0 ' Конфигурация запроса (0 - синхронный запрос)
    xhr.send ' Отправка запроса
 
    ' Запись ответа в файл
    Set db = CreateObject("ADODB.Stream")
    db.Open ' Открытие потока
    db.Type = 1 ' Установка типа потока (1 - бинарный)
    db.Write xhr.responseBody ' Запись ответа от сервера в поток
    db.SaveToFile fileName, 2 ' Сохранение данных из потока в файл (2 - если файл не существует, он будет создан)
    db.Close ' Закрытие потока
End Sub
 
' Проверка скачивания
DownloadBinaryFile "https://nekit270.ch/files/cat.jpg" "cat.jpg"

Парсинг JSON

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
' Создание объекта HTMLFile
Set oHtmlFile = CreateObject("HTMLFile")
 
' Установка версии ie = 9, для включения поддержки JSON
oHtmlFile.write("<meta http-equiv='X-UA-Compatible' content='ie=9'>")
 
' Сохранение объекта JSON в отдельную переменную
Set JSON = oHtmlFile.ParentWindow.JSON
 
' Парсинг JSON из строки
Set oResult = JSON.parse("{""param1"": ""string"", ""param2"": 5, ""param3"": false}")
 
' Вывод свойств полученного объекта
WSH.Echo oResult.param1
WSH.Echo oResult.param2
WSH.Echo oResult.param3 ' false отобразится как 0

Кастомный диалог на HTA (при нажатии любой кнопки возвращается ее текст)
Не следует ставить слишком длинный заголовок, иначе может не запуститься

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function HtmlDialog(title, htmlStr, width, height)
    ' Создание объекта WshShell
    Set oShell = CreateObject("WScript.Shell")
    
    ' Запуск mshta.exe с html-кодом
    Set oExec = oShell.Exec("mshta ""about:<meta http-equiv=x-ua-compatible content='ie=9'><hta:application selection=no border=dialog maximizeButton=no minimizeButton=no scroll=no contextMenu=no><body><script>f=new ActiveXObject('Scripting.FileSystemObject');document.body.innerHTML+=f.GetStandardStream(0).ReadAll();resizeTo("& width &","& height &");document.title='"& title &"';document.body.onclick=function(e){t=e.target;if(t.nodeName=='BUTTON'){f.GetStandardStream(1).Write(t.innerText);close()}}</script></body>""")
 
    ' Отправка текста диалога в stdin
    oExec.StdIn.Write htmlStr
    oExec.StdIn.Close
 
    ' Получение и возврат значения из stdout
    HtmlDialog = oExec.StdOut.ReadAll()
End Function
 
' Проверка диалога
WSH.Echo HtmlDialog("Диалог", "Выберите: <br><button>Вариант 1</button><br><button>Вариант 2</button><br><button>Вариант 3</button>", 400, 300)

@katopesovka · 04.04.2025, 10:56

(vbs+bat+powershell+c#)Простенький скрипт для запуска приложения с параметрами, можно разместить в папке send-to или добавить пункт в контекстного меню в реестре.

Без наличия аргументов убивает процесс активного окна
Функции перезапуска оболочки/машины
Дубликат файла с переименованием в туже директорию
Копирование содержимого текстовых файлов
Регистрация пунктов контекстного меню в реестре и их удаление

Кликните здесь для просмотра всего текста

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
dim arg, WshArguments, SpVoice
if wscript.arguments.count=0 then
arg=" -w Hidden ""Add-Type 'using System;using System.Runtime.InteropServices;public class APIFuncs{[DllImport(""""""""user32.dll"""""""")]public static extern IntPtr GetForegroundWindow();[DllImport(""""""""oleacc.dll"""""""")] public static extern IntPtr GetProcessHandleFromHwnd(IntPtr hwnd);[DllImport(""""""""kernel32.dll"""""""")]public static extern int GetProcessId(IntPtr handle);}';ps|Where Id -eq ([apifuncs]::GetProcessId([apifuncs]::GetProcessHandleFromHwnd([apifuncs]::GetForegroundWindow())))|kill"""
CreateObject("WScript.Shell").Run "C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe"&arg, 0, True
WScript.Quit
end If
if wscript.arguments(0)="copy" then
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
'arg=" -c ""Add-Type 'using System;using System.Runtime.InteropServices;public static class Kernel32{[DllImport(""""""""kernel32.dll"""""""", SetLastError = true)]public static extern IntPtr OpenThread(uint dwDesiredAccess, bool bInheritHandle, uint dwThreadId);[DllImport(""""""""kernel32.dll"""""""", SetLastError=true)]public static extern bool CloseHandle(IntPtr hHandle);[DllImport(""""""""kernel32.dll"""""""",SetLastError=true)]public static extern int SuspendThread(IntPtr hThread);}';ForEach($ProcessThread in (Get-Process -Name explorer).Threads){$hThread = [Kernel32]::OpenThread(0x0002 , $False, $ProcessThread.ID);if ($hThread -ne [IntPtr]::Zero) {[Kernel32]::SuspendThread($hThread);[Kernel32]::CloseHandle($hThread);}}"""
'CreateObject("WScript.Shell").Run "C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe"&arg, 0, True
arg=InputBox("Rename file","Dublicate",FileSystemObject.GetFileName(wscript.arguments(1)))
if not FileSystemObject.GetFileName(wscript.arguments(1))=arg and not arg="" then
FileSystemObject.CopyFile wscript.arguments(1), FileSystemObject.GetParentFolderName(wscript.arguments(1))&"\"&arg, false
end if
'arg=" -c ""Add-Type 'using System;using System.Runtime.InteropServices;public static class Kernel32{[DllImport(""""""""kernel32.dll"""""""", SetLastError = true)]public static extern IntPtr OpenThread(uint dwDesiredAccess, bool bInheritHandle, uint dwThreadId);[DllImport(""""""""kernel32.dll"""""""", SetLastError=true)]public static extern bool CloseHandle(IntPtr hHandle);[DllImport(""""""""kernel32.dll"""""""",SetLastError=true)]public static extern int ResumeThread(IntPtr hThread);}';ForEach($ProcessThread in (Get-Process -Name explorer).Threads){$hThread = [Kernel32]::OpenThread(0x0002 , $False, $ProcessThread.ID);if ($hThread -ne [IntPtr]::Zero) {[Kernel32]::ResumeThread($hThread);[Kernel32]::CloseHandle($hThread);}}"""
'CreateObject("WScript.Shell").Run "C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe"&arg, 0, True
WScript.Quit
end If
if wscript.arguments(0)="reboot" then
arg=" -c Restart-Computer -force;echo """
CreateObject("WScript.Shell").Run "C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe"&arg, 0, false
WScript.Quit
end If
if wscript.arguments(0)="relaunch" then
arg=" process where name=""sihost.exe"" call terminate"
CreateObject("WScript.Shell").Run "wmic"&arg, 0, false
WScript.Quit
end If
if wscript.arguments(0)="cliptxt" then
CreateObject("WScript.Shell").Run "cmd /c clip <"&wscript.arguments(1), 0,false
WScript.Quit
end If
if wscript.arguments(0)="reg" then
runas()
Set WShell=CreateObject("WScript.Shell")
WShell.RegWrite "HKCR\*\shell\copyinside\icon","shell32.dll,-16822","REG_SZ"
WShell.RegWrite "HKCR\*\shell\copyinside\MUIverb","@shell32.dll,-23887","REG_SZ"
WShell.RegWrite "HKCR\*\shell\copyinside\command\","rundll32 SHELL32.DLL,ShellExec_RunDLL "&WScript.ScriptFullName&" cliptxt ""%1""","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Dublicate\icon","shell32.dll,-243","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Dublicate\MUIverb","@shell32.dll,-13608","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Dublicate\command\","rundll32 SHELL32.DLL,ShellExec_RunDLL "&WScript.ScriptFullName&" copy ""%1""","REG_SZ"
WScript.Quit
end If
if wscript.arguments(0)="unreg" then
runas()
Set WShell=CreateObject("WScript.Shell")
WShell.RegDelete "HKCR\*\shell\copyinside\command\"
WShell.RegDelete "HKCR\*\shell\copyinside\"
WShell.RegDelete "HKCR\*\shell\Dublicate\command\"
WShell.RegDelete "HKCR\*\shell\Dublicate\"
WScript.Quit
end If
arg=InputBox("with arguments","RUN","-languageforcooking=rus")
if arg=false then
arg=StrReverse(Split(StrReverse(Split(WScript.Arguments(0),"\")(ubound(Split(WScript.Arguments(0),"\")))),".",2)(1))
For Each i In GetObject("winmgmts:\root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name="""&arg&".exe"&"""", , 48):i.Terminate:Next
CreateObject("WScript.Shell").Run "taskkill /f /im "&arg, 0, True
set SpVoice=WScript.CreateObject("sapi.SpVoice")
'MsgBox arg
SpVoice.Speak arg&"terminated"
WScript.Quit
end If
set WshArguments=WScript.Arguments
WshArguments=""""&WshArguments(0)&""""
Set WshShell = WScript.CreateObject("WScript.Shell") 
WshShell.Run(WshArguments&arg)
 
Function runas()
if CreateObject("WScript.Shell").Run("net session", 0,true) then
CreateObject("shell.application").ShellExecute "wscript", " //nologo //e:vbscript """&WScript.ScriptFullName&""" "&wscript.arguments(0),"", "runas",1
WScript.Quit
end If
'MsgBox CreateObject("WScript.Shell").Run("net session", 0,true)
End Function

Сообщение от nekit270

dwm.exe - зло

помню как-то приостановил его работу через монитор ресурсов(perfmon.exe /res)-было весело))

@katopesovka · 05.04.2025, 14:26

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

Кликните здесь для просмотра всего текста

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
dim arg, WshArguments, SpVoice
if wscript.arguments.count=0 then
arg=InputBox("Ключ - функция"&vbCr&"REG - Добавление пунктов в контекст. меню"&vbCr&"UNREG - Удаление пунктов из контекст. меню"&vbCr&"RELAUNCH - Перезагружает проводник"&vbCr&"REBOOT - Перезагружает компьютер"&vbCr&"KILLWINDOW - Убивает процесс активного окна",CreateObject("Scripting.FileSystemObject").GetFileName(WScript.ScriptFullName),"REG")
if arg=false then WScript.Quit
WScript.CreateObject("WScript.Shell").Run(""""&WScript.ScriptFullName&""""&arg)
WScript.Quit
end If
if StrComp(wscript.arguments(0),"killwindow",1)=0 then
arg=" -w Hidden ""Add-Type 'using System;using System.Runtime.InteropServices;public class APIFuncs{[DllImport(""""""""user32.dll"""""""")]public static extern IntPtr GetForegroundWindow();[DllImport(""""""""oleacc.dll"""""""")] public static extern IntPtr GetProcessHandleFromHwnd(IntPtr hwnd);[DllImport(""""""""kernel32.dll"""""""")]public static extern int GetProcessId(IntPtr handle);}';ps|Where Id -eq ([apifuncs]::GetProcessId([apifuncs]::GetProcessHandleFromHwnd([apifuncs]::GetForegroundWindow())))|kill"""
CreateObject("WScript.Shell").Run "C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe"&arg, 0, False
WScript.Quit
end If
if wscript.arguments(0)="arg" then
arg=InputBox(CreateObject("Scripting.FileSystemObject").GetFileName(wscript.arguments(1))&" ???","RUN with arguments","-languageforcooking=rus")
if arg=false then WScript.Quit
WshArguments=""""&wscript.arguments(1)&""""
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run(WshArguments&arg)
WScript.Quit
end If
if wscript.arguments(0)="copy" then
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
arg=InputBox("Rename file","Dublicate",FileSystemObject.GetFileName(wscript.arguments(1)))
if not FileSystemObject.GetFileName(wscript.arguments(1))=arg and not arg="" then
FileSystemObject.CopyFile wscript.arguments(1), FileSystemObject.GetParentFolderName(wscript.arguments(1))&"\"&arg, False
end if
WScript.Quit
end If
if StrComp(wscript.arguments(0),"reboot",1)=0 then
arg=" -c Restart-Computer -force;echo """
CreateObject("WScript.Shell").Run "C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe"&arg, 0, False
WScript.Quit
end If
if StrComp(wscript.arguments(0),"relaunch",1)=0 then
arg=" process where name=""sihost.exe"" call terminate"
CreateObject("WScript.Shell").Run "wmic"&arg, 0, False
WScript.Quit
end If
if wscript.arguments(0)="cliptxt" then
CreateObject("WScript.Shell").Run "cmd /c chcp 1251&clip <"&wscript.arguments(1), 0,False
WScript.Quit
end If
if StrComp(wscript.arguments(0),"reg",1)=0 then
runas()
Set WShell=CreateObject("WScript.Shell")
WShell.RegWrite "HKCR\*\shell\copyinside\icon","shell32.dll,-16822","REG_SZ"
WShell.RegWrite "HKCR\*\shell\copyinside\MUIverb","@shell32.dll,-23887","REG_SZ"
WShell.RegWrite "HKCR\*\shell\copyinside\command\","rundll32 SHELL32.DLL,ShellExec_RunDLL "&WScript.ScriptFullName&" cliptxt ""%1""","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Dublicate\icon","shell32.dll,-243","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Dublicate\MUIverb","@shell32.dll,-13608","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Dublicate\command\","rundll32 SHELL32.DLL,ShellExec_RunDLL "&WScript.ScriptFullName&" copy ""%1""","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Argument\icon","shell32.dll,-246","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Argument\MUIverb","@shell32.dll,-28958","REG_SZ"
WShell.RegWrite "HKCR\*\shell\Argument\command\","rundll32 SHELL32.DLL,ShellExec_RunDLL "&WScript.ScriptFullName&" arg ""%1""","REG_SZ"
WShell.RegWrite "HKCR\exefile\shell\Killexe\icon","shell32.dll,-200","REG_SZ"
WShell.RegWrite "HKCR\exefile\shell\Killexe\MUIverb","@shell32.dll,-9740","REG_SZ"
WShell.RegWrite "HKCR\exefile\shell\Killexe\command\","rundll32 SHELL32.DLL,ShellExec_RunDLL "&WScript.ScriptFullName&" kill ""%1""","REG_SZ"
WScript.Quit
end If
if StrComp(wscript.arguments(0),"unreg",1)=0 then
runas()
Set WShell=CreateObject("WScript.Shell")
WShell.RegDelete "HKCR\*\shell\copyinside\command\"
WShell.RegDelete "HKCR\*\shell\copyinside\"
WShell.RegDelete "HKCR\*\shell\Dublicate\command\"
WShell.RegDelete "HKCR\*\shell\Dublicate\"
WShell.RegDelete "HKCR\*\shell\Argument\command\"
WShell.RegDelete "HKCR\*\shell\Argument\"
WShell.RegDelete "HKCR\exefile\shell\Killexe\command\"
WShell.RegDelete "HKCR\exefile\shell\Killexe\"
WScript.Quit
end If
if wscript.arguments(0)="kill" then
arg=StrReverse(Split(StrReverse(Split(WScript.Arguments(1),"\")(ubound(Split(WScript.Arguments(1),"\")))),".",2)(1))
For Each i In GetObject("winmgmts:\root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name="""&arg&".exe"&"""", , 48):i.Terminate:Next
CreateObject("WScript.Shell").Run "taskkill /f /im "&arg, 0, False
set SpVoice=WScript.CreateObject("sapi.SpVoice")
SpVoice.Speak arg&"terminated"
'MsgBox arg
WScript.Quit
end If
 
Function runas()
if CreateObject("WScript.Shell").Run("net session", 0,true) then
CreateObject("shell.application").ShellExecute "wscript", " //nologo //e:vbscript """&WScript.ScriptFullName&""" "&wscript.arguments(0),"", "runas",1
WScript.Quit
end If
'MsgBox CreateObject("WScript.Shell").Run("net session", 0,true)
End Function

Новые блоги и статьи Все статьи Все блоги /
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .

Dragokas 18030 / 7733 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16

	Полезные VBS скрипты и программы по работе с ними 15.10.2012, 00:41. Показов 220152. Ответов 49 Метки нет (Все метки) В этой теме выкладываем скрипты, которые часто используются Вами или на Ваш взгляд могут иметь большое практическое значение. Также приветствуются скрипты высокой степени сложности, полезные с точки зрения изучения принципа их работы. Правила темы: При выкладывании скрипта постарайтесь тщательно описывать принцип его работы и по-больше комментировать строки Вашего кода. Если Ваш код очень большой, помещайте его под CUT. Также можно сделать 2 варианта: 1. Чистый код. 2. С комментариями. Запрещаются любые обсуждения выложенных здесь работ; если в этом есть необходимость, создайте отдельную тему в которой опишите замечание или проблему при работе с данным скриптом, указав ссылку на сообщение из этой темы (правый клик по слову "Permalink" вверху каждого сообщения). Если Вы хотите внести исправление в выложенный Вами код - пишите мне в личку ссылку на Ваше старое сообщение и новый исправленный вариант. (полный вариант с тегами Вашего старого сообщения можно получить, нажав на него - кнопка "Цитата"). Допускается размещение обзора программ, помогающих редактировать/отлаживать код. Схожая тема: Полезные макросы, надстройки и шаблоны (VBA) Смежная тема: Полезные BAT/CMD скрипты ***************** Перечень полезных скриптов: ***************** Отправка файла на FTP (Drag & Drop) и копирование ссылки в буфер обмена ссылка Получение времени сервера ссылка 7

@trdm 182 / 37 / 5 Регистрация: 29.01.2013 Сообщений: 256
	05.01.2022, 12:06
	Если у вас система x64 и VBScript перестает вызывать отладчик по команде stop или отладчик глючит, попробуйте запустить скрипт из под x32-разрядного приложения. К примеру из-под "Total Commander 32 bit" обнаружил тот же эффект для javascript/debugger; убил день на это Отладчик запускается и пашет (Microsoft Visual Studio 2005). 0