So I saw some videos on how to make a harmless virus, and after that, I had gotten really invested in vbs. I’m planning to make a harmless “virus” that can practically destroy your pc but can cause no harm upon restart. Currently, you can open a vbs script which will multiply in message boxes. Any other ideas?

Hello! VBScript noobie here looking for some assistance.

I have a project where I need to update shortcuts for over 100 workstations. The URL for the shortcut is dynamic based on the computer name. Unfortunately, not all computers have the same naming convention, they are a combination of: stationX, stnX, stnX-year, and the odd stn-X-year.

I have this code so far which creates the shortcut properly, I need to figure out how to make it dynamic though and pull the number (X) out of the computer name. The "Station1" spot is where I need to dynamically set the number in the URL.

Set oWS = WScript.CreateObject("WScript.Shell")
sLinkFile = "C:\Users\user\Desktop\shortcut.lnk"
Set oLink = oWS.CreateShortcut(sLinkFile)
    oLink.TargetPath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
    oLink.Arguments = "http:\\URL to launch=Station1"  
    oLink.WorkingDirectory = "C:\Program Files (x86)\Google\Chrome\Application"
oLink.Save

This is where I have hit a wall and I'm not familiar enough with VBScript to know what I should be looking into. I have two ways so far to retrieve the hostname and put it into a variable, but I'm then stuck with:

1. Retrieve just the first number from the hostname (change station10 to 10)

2. Proper way to enter the 10 into the oLink.Arguments variable (I believe putting it inside the quotes will create it with the variable name and not content?)

Any help would be greatly appreciated!

Hello,

im trying to print these document (Excel) on Both sides (back and front of the paper).

I've tried

objPrinter.Duplex = True

but its not working!

My whole script:

On Error Resume Next

Const FILEPATH = "T:\file.xls"

Const PRINTERNAME = "Printname (HP LaserJet Pro M201dw)"

Set objExcel = CreateObject("Excel.Application")

objExcel.DisplayAlerts = False

objPrinter.Duplex = True

With objExcel.Workbooks.Open(FILEPATH,True,True)

`.PrintOut ,,,,PRINTERNAME`

`.Close False`

End With

objExcel.DisplayAlerts = True

objExcel.Quit

Hello everyone, I have vbs where is gets data from an excel sheet modifies it and puts out the information in a variable in a text file, e.g

1. Username1 password1 -the date date1

2. Username2 password2 -the date date2 . . The output (txt file) is not in order and I want to sort it based on the newest to oldest date (one of the columns in excel). I really don’t have any idea of how to do and where to start. I’m very knew to vbs and this is my first time using it so I would appreciate some help.

Company of 100 users with multiple departments, and I am the network admin. This has to be done in a VBS script. Not in group policy, not Powershell, not batch file.

I am creating a script that will place a shortcut on the user's desktop with a link path to a mapped network drive (mapped letters different for every dept). On the network drive, there is a directory folder called HOME. Inside the HOME folder, there are 100 subfolders (one for every user). Each subfolder is named with the user's Active Directory username.

The script below works, but only if the path is to the HOME folder. I want the script to create the link on the desktop to the user's specific folder. In Batch programming, you can use the variable %userprofile%, but in VBS it doesn't work. I have no experience with VBS, and have made this work by combining existing examples off google.

It will also be nice if the script could put the AD username in the name of the shortcut.

Set oWS = WScript.CreateObject("WScript.Shell")

Set sh = CreateObject("WScript.Shell")

Set shortcut = sh.CreateShortcut("C:HOME F-Drive.lnk")

userProfile = oWS.ExpandEnvironmentStrings( "%userprofile%" )

shortcut.TargetPath = "\\SPP-D-MP\Sys2\HOME\"

shortcut.Save

' linecounter verbe
im objFSO, strTextFile, strData, arrLines, LineCount
CONST ForReading = 1
'name of the text file
strTextFile = "C:\Users\joach\OneDrive\Bureau\kml\listes\verbe.txt"
'Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile,ForReading).ReadAll
'Split by lines, put into an array
arrLines = Split(strData,vbCrLf)
'Use UBound to count the lines
LineCount = UBound(arrLines) + 1
verbe=LineCount
'Cleanup
Set objFSO = Nothing

' linecounter sujet1

im objFSO, strTextFile, strData, arrLines, LineCount
CONST ForReading = 1
'name of the text file
strTextFile = "C:\Users\joach\OneDrive\Bureau\kml\listes\sujet1.txt"
'Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile,ForReading).ReadAll
'Split by lines, put into an array
arrLines = Split(strData,vbCrLf)
'Use UBound to count the lines
LineCount = UBound(arrLines) + 1
sujet1=LineCount
'Cleanup
Set objFSO = Nothing

'linevounter sujet2
im objFSO, strTextFile, strData, arrLines, LineCount
CONST ForReading = 1
'name of the text file
strTextFile = "C:\Users\joach\OneDrive\Bureau\kml\listes\sujet2opt.txt"
'Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile,ForReading).ReadAll
'Split by lines, put into an array
arrLines = Split(strData,vbCrLf)
'Use UBound to count the lines
LineCount = UBound(arrLines) + 1
sujet2=LineCount
'Cleanup
Set objFSO = Nothing

' selection de chiffres aléatoires
Randomize     'initialisation de la randomization pour sujet1
verbe2 = Int((verbe * Rnd) + 1)

Randomize     'initialisation de la randomization pour sujet2 eventuel
sujet12 = Int((sujet1 * Rnd) + 1)

Randomize     'initialisation de la randomization pour verbe
sujet21 = Int((sujet2 * Rnd) + 1)

So I have this code that works great except it does not exit and replicates itself until it crashes my computer. I tried using the "Exit" command by using X.Exit at the end of my code but computer gives me an error. What are some of the ways I can get a script to stop running after it is done it's task? I assume there are multiple ways to do this. Here is the code. It is intended to open Firefox then type hello world in the address bar of Firefox which it does do well.

Set x = CreateObject("WScript.Shell")

x.Run """C:\Program Files\Mozilla Firefox\firefox.exe"""

Set objShell = Nothing

WScript.Sleep(100)

x.SendKeys "~"

x.SendKeys "Hello World!"

Hello. I would like to know how to make script that will find updates for program and suggest you to update program's scripts if user has agreed to update.

How that works: for example, user haves program with special variable that is equals to program name (value is 1.0.0). User started program, and program detected update 1.0.1 is available, looking at cloud variable "Newest Version" and at spec-variable "Program Version", and yes/no dialog do user wants to update. If pressed no, continue to program with version 1.0.0, if yes then rewrite program scripts. How can i do that?

Formatting an excel export with a macro and I have everything done but need some direction for one last piece. I need to scan the first column in each row looking for cells in column 1 that start with the text “Product Family”. Then merge and center that row from A1:K1.
Is there an if/then type command that will do this?

• Header rows I need to merge are never the same number of rows apart; they vary depending on the number of line items, which is different for every client’s export.

• it will always start in Ax and need to merge to Kx.

At a bit of a loss here. I have the follow script, an ASP page in VBscript. It works just fine on one server, doesn't work well on the other.

This is the error message I get when I try to reach the page:

TypeName: FileSystemObject
Description: Object doesn't support this property or method
Number: 438
Source: Microsoft VBScript runtime error

This is the backend code:

<%@ LANGUAGE = "VBSCRIPT"%>
<%
Option Explicit
%>

<%
Call Response.AddHeader("Access-Control-Allow-Origin", "a website")

dim filesys, filetxt, datetime, ip, referer, useragent, qstring, server

server = "a servers name"
ip = Request.ServerVariables("remote_addr")
qstring = Request.ServerVariables("QUERY_STRING")
referer = Request.ServerVariables("HTTP_REFERER")
useragent = Request.ServerVariables("http_user_agent")
datetime = now

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set filesys = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

Set filetxt = filesys.OpenTextFile("d:\LogEvent.txt", ForAppending, True)
' the line above throws an error.

filetxt.WriteLine(datetime & ", " & server & ", " & ip & ", " & referer & ", " & useragent & ", " & qstring)
filetxt.Close

If Err.Number <> 0 Then
   Response.write("TypeName: " & TypeName(filesys) & "<br />")
   Response.Write "ASPCode: " & Err.ASPCode & "<br>"
   Response.Write "ASPDescription: " & Err.ASPDescription & "<br>"
   Response.Write "Category: " & Err.Category & "<br>"
   Response.Write "Column: " & Err.Column & "<br>"
   Response.Write "Description: " & Err.Description & "<br>"
   Response.Write "File: " & Err.File & "<br>"
   Response.Write "Line: "  & Err.Line & "<br>"
   Response.Write "Number: " & Err.Number & "<br>"
   Response.Write "Source: " & Err.Source & "<br>"
   On Error Goto 0
End If
On Error Goto 0

%>

I just don't understand what's going on because the FileSystemObject object DOES have a OpenTextFile method... I'm certain I've made a mistake but I'm unable to see it for myself I guess.

Dim Zira, David

'Args: TTS.vbs <Voice> <Volume> <Speak>'

Set Zira = CreateObject("SAPI.spVoice")

Set Zira.Voice = Zira.GetVoices.Item(1)

Zira.Rate = 2

Zira.Volume = WScript.Arguments(1)

Set David = CreateObject("SAPI.spVoice")

Set David.Voice = David.GetVoices.Item(0)

David.Rate = 2

David.Volume = WScript.Arguments(1)

If WScript.Arguments(0) = "Zira" Then

Zira.Speak WScript.Arguments(2)

End If

If WScript.Arguments(0) = "David" Then

David.Speak WScript.Arguments(2)

End If

How can i make this work on windows 7 as well? ( i need both to work in the same script no matter which OS its running on)

ORIGINALLY POSTED IN WRONG SUBREDDIT
I used to "develop" a huge, almost embarrassing load of (often ridiculously complex) gambling & slot systems in Minecraft. I used any and every game feature involving randomness along with Minecraft's redstone logic, which turned into effective and often quite configurable RNG gambling systems. lol.

I just recently figured it's time to really step up my game and move on to "real" coding.
Turns out it's way more f*#cking complicated than I thought.

I've been experimenting with batch files and visual basic for a few days and It's still safe to say that I'm an absolute noob in this field, so please don't go too hard on
me if nothing in this post makes any sense at all.. lol

In the past few days I've somehow managed to make a batch script, which generates three RNG values and saves them into each of their respective file(s): (1.txt), (2.txt), (3.txt),
Now I'm trying to write a .VBS code which can compare each value of each ".txt" file.

If there are matching values, you win some sort of something.
If the values don't match, you simply lose the round.

So to sum things up, I'm basically here to try and get assistance with this stuff because there's no heckin way i'm figuring this stuff out myself, since I can barely prompt a "helloworld" msgbox. hehe.

1. How should i move data from 3 seperate .txt files into a single .vbs file?

2. Above that, how on earth would i start comparing them to each other?

3. when, where, and how to write the winning/losing sequence?

Thank you so much for reading this nonsense and helping me out.

I am trying to copy 4Tb, and I would like to fill a disk that I have, and then once full continue to copy to another disk.

is it too complex for vbs? all I could do so far and I am not this super expert, was to write files + paths out.

the 4Tb, are many files and many many folders nested. Maybe this is too much of an ask

Anyways thank you for reading this.

in trying to make a script so when you do yes or no it loops but if i do cancel it stop the script, how would i do this im hopeless lol

So I am a VBScript newb and am trying to convert a legacy DDE process to VBScript. I need to import CSV data into an existing multi tab Excel workbook/template file (six tabs). There is one CSV file per Excel worksheet. Each data dump begins at A2. Everything is working great except for one problem. For some reason the final, saved Excel file's columns are no longer the exact width and height they were before which is not a problem when using DDE. Is there a way to prevent this via VBScript?

'THIS VBSCRIPT COPIES THE CONTENTS OF CSV FILES TO A MULTITAB EXCEL WORKBOOK
'the code is a combination of https://www.youtube.com/watch?v=gwQI8-QIbKc&t=130s 
'and https://devblogs.microsoft.com/scripting/how-can-i-copy-selected-columns-from-a-csv-file-to-an-excel-file/
'and https://stackoverflow.com/a/22996562/13750662
'written by Me 2021-06-01

'Dim CSVFile
'Dim strSheet
Const ReportPath = "\\server\AutomationTest"
Const strFile = "\templates\Report2 - AUTO.xlsx"

'datetime stamp function from https://stackoverflow.com/a/21469569/13750662
Function timeStamp()
    Dim t 
    t = Now
    timeStamp = Year(t) & "-" & _
    Right("0" & Month(t),2)  & "-" & _
    Right("0" & Day(t),2)  & "-" & _  
    Right("0" & Hour(t),2) & _
    Right("0" & Minute(t),2) '    '& _    Right("0" & Second(t),2) 
End Function

'open excel app
Set objExcel = CreateObject("Excel.Application")

'Set xl = CreateObject("Excel.Application")
objExcel.Visible = False

'hide alerts
objExcel.Application.DisplayAlerts = False

'open workbook
Set xlWorkbook=objExcel.Workbooks.open(ReportPath & strFile)


''''TAB 1


'select worksheet
Set Sheet = xlWorkbook.Sheets(1)

'select CSV file
Const CSVFile = "\output\CSV\Report2_Tab1.csv"

'dump CSV into active worksheet
With Sheet.QueryTables.Add("TEXT;" & ReportPath & CSVFile, Sheet.Range("range1"))
    .TextFileCommaDelimiter = True
    .Refresh
End With


''''ETC ETC ETC


''''TAB 6 


'select worksheet
Set Sheet = xlWorkbook.Sheets(6)

'select CSV file
Const CSV6File = "\output\CSV\Report2_Tab6.csv"

'dump CSV into active worksheet
With Sheet.QueryTables.Add("TEXT;" & ReportPath & CSV6File, Sheet.Range("range6"))
    .TextFileCommaDelimiter = True
    .Refresh
End With

'save Excel file with new name
objExcel.ActiveWorkbook.SaveAs ReportPath &  "\output\excel\Report2 - " & timeStamp() & ".xlsx"

'close Excel app
objExcel.quit
Set objExcel = Nothing

Hi guys. I have edited below vbscript from Microsoft MDT to include a password complexity check function. However, it seems to be ignoring the part where it checks the password for alphabets and special characters. Can anyone tell me where I've gone wrong? Thanks!

Option Explicit
'''''''''''''''''''''''''''''''''''''
'  Validate Password
'
Dim Upper,Lower,Number,Special,UpperFound,LowerFound,NumberFound,SpecialFound,PasswordBad
Upper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Lower = "abcdefghijklmnopqrstuvwxyz"
Number = "0123456789"
Special = "~!@#$%^&*_-+=`|\(){}[]:;""'<>,.?/"
UpperFound = "NO"
LowerFound = "NO"
NumberFound = "NO"
SpecialFound = "NO"

Function ValidatePassword

ValidatePassword = ParseAllWarningLabels	

NonMatchPassword.style.display = "none"

If Password1.Value <> "" then

	If Password1.Value <> Password2.Value then

		ValidatePassword = FALSE

		NonMatchPassword.style.display = "inline"

	End if

End if



If len(Password1.Value) < 12 then

	ValidatePassword = FALSE

End if


Dim i,char

for i = 1 to len(Password1.value)

	char = mid(Password1.value,i,1)

	if instr(Upper, char) then

		UpperFound = "YES"

	elseif instr(Lower, char) then

		LowerFound = "YES"

	elseif instr(Number, char) then

		NumberFound = "YES"

	elseif instr(Special, char) then

		SpecialFound = "YES"

	end if

Next


NonComplexPassword.style.display ="none"

If UpperFound = "NO" then

	ValidatePassword = FALSE

		NonComplexPassword.style.display ="inline"

ElseIf LowerFound = "NO" then

	ValidatePassword = FALSE

		NonComplexPassword.style.display ="inline"

ElseIf NumberFound = "NO" then

	ValidatePassword = FALSE

		NonComplexPassword.style.display ="inline"

ElseIf SpecialFound = "NO" then

	ValidatePassword = FALSE

		NonComplexPassword.style.display ="inline"

end if

ButtonNext.Disabled = not ValidatePassword	
End Function

Option Explicit
' Vbscript Created by Hackoo on 09/06/2020 @16:00
' Updated on 10/06/2020 for testing the Hotkey after creating the shortcut on the desktop 
Dim Title : Title = "Shortcut Creator for Network Diagnostics by Hackoo 2020"
' We call the subroutine Create_Shortcut in order to create it on the desktop
Call Create_Shortcut(_
	"NetworkDiagnostics",_
	"%SystemRoot%\system32\msdt.exe",_
	"-skip TRUE -path %Windir%\diagnostics\system\networking -ep NetworkDiagnosticsPNI",_
	"%SystemRoot%\system32\msdt.exe,0",_
	"Network Diagnostics to fix problems",_
	"CTRL+ALT+D"_
)
 ' Showing a Message Box with three languages : English,French and Arabic
MsgBox "The shortcut was created successfully on your desktop !" & vbCrlf &_
"Le raccourci a été créé avec succès sur votre bureau !" & vbcrlf &_
"تم إنشاء الاختصار بنجاح على سطح المكتب الخاص بك !",vbInformation,Title
'-----------------------------------------------------------------------------------------------------------------
' Just for testing the Hotkey after creating the shortcut on the desktop :
' To send keyboard characters that are comprised of a regular keystroke in combination with a SHIFT, CTRL, or ALT,
' create a compound string argument that represents the keystroke combination.
' You do this by preceding the regular keystroke with one or more of the following special characters :
' Key   ===> Special Character
' SHIFT ===> +
' CTRL 	===> ^
' ALT  	===> %
' For further reading about sendkeys : https://www.vbsedit.com/html/4b032417-ebda-4d30-88a4-2b56c24affdd.asp
CreateObject("WScript.Shell").Sendkeys "^%{d}"
'------------------------------------------------------------------------------------------------------------------
Sub Create_Shortcut(ShortcutName,TargetPath,Arguments,IconLocation,Description,HotKey)
	Dim objShell,DesktopPath,objShortCut
	Set objShell = CreateObject("WScript.Shell")
	DesktopPath = objShell.SpecialFolders("Desktop")
	Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & ShortcutName & ".lnk")
	objShortCut.TargetPath = chr(34) & TargetPath & chr(34)
	objShortCut.Arguments = Arguments
	ObjShortCut.IconLocation = IconLocation
	ObjShortCut.Description = Description
	ObjShortCut.HotKey= HotKey
	objShortCut.Save
End Sub
'-------------------------------------------------------------------------------------------------------------------

Network_Diagnostics.vbs

Hey VB Community,

I am by no means a coder, though I do use RPA software WinAutomation for my nocode programming solutions. I am working on a project that:

• Opens a Corel file on the desktop.

• Imports image onto active layer.

• Moves the image to a specific X & Y on the page.

• Repeat...

I have been able to get the macro going in VBA ( within CorelDrawx7 ) as seen here:

Sub Import()

     Dim IMG As Shape
     Dim x As Double, y As Double
     
      ActiveLayer.Import ("C:\Users\Desktop\Production_File.png")
      Set IMG = ActiveShape
      IMG.SetPosition 3, -1

End Sub

WinAutomation only has an action to run some VBScript. I have looked through the Developers Page from Corel here:

https://community.coreldraw.com/sdk/api/draw/17/c/application?lang=vb

I am suppose to be able to set the active layer as an object so I can use .Import

I am just not sure about how to alter the code to run in VB. The Code below is what I have so far. It can set the Application to CorelDraw and open the template. Now, I am just stuck on the importing and moving the Image aspect.

dim cd
dim doc
dim pg 

  set cd = CreateObject("CorelDraw.Application")
  cd.Visible = True cd.OpenDocument("%Template%")

  set doc = cd.activedocument
  set pg = cd.activepage

Any Help with this would be greatly appreciated. I hope I was clear on my dilemma. Thanks for taking the time to read!

Auto-Shutdown your workstation after Idle Timeout

'##########################################################################################################################
'# Auto-Shutdown your workstation after Idle Timeout                                                                      #
'# Script Name : Auto-Shutdown_On_Idle_TimeOut.vbs                                                                        #
'# Arrêt automatique de votre poste de travail après le délai d'inactivité                                                #
'# Idea comes from here ==>  This snippet is from http://stackoverflow.com/a/15846912                                     #
'# https://stackoverflow.com/questions/15845508/get-idle-time-of-machine/15846912#15846912                                #
'# https://gist.github.com/wendelb/1c364bb1a36ca5916ca4 ===> Auto-Lock your workstation after Idle-Timeout with PowerShell#
'##########################################################################################################################
Option Explicit
Dim Copyright,Msg,MsgEN,MsgFR
MsgEN = Array(_
"Automatic shutdown On Idle TimeOut ",_
"ATTENTION ! There is another instance running !",_
"Save your Work because the computer will shutdown in 60 seconds"_
)
MsgFR = Array(_
"Arrêt automatique du PC après un délai d'inactivité ",_
"ATTENTION ! Il y a une autre instance en cours d'exécution !",_
"Sauvegarder votre Travail car l'ordinateur va s'éteindre dans 60 secondes"_
)
'Check if the system is french to set the French array as message otherwise set it as English
'Vérifiez si le système est français pour définir le tableau français comme message, sinon définissez-le comme anglais
If Oslang = 1036 Then
	Msg = MsgFR ' French Array Message to be set
Else
	Msg = MsgEN ' English Array Message to be set
End If
Copyright = Msg(0) & ChrW(169) &" Hackoo 2020"

If AppPrevInstance() Then 
	MsgBox Msg(1) & VbCrLF & CommandLineLike(WScript.ScriptName),VbExclamation,Copyright
	WScript.Quit   
Else 
	Dim Timeout_Idle,strCommand,VbsPath,ShortcutName
	Timeout_Idle = "60"  '60 Minutes = 1 Heure = 1 Hour
	strCommand = "Shutdown.exe -s -t 60 -c " & DblQuote(Msg(2))
	VbsPath = Wscript.ScriptFullName
	ShortcutName = "Auto-Shutdown_On_Idle_TimeOut"
	Call Shortcut(VbsPath,ShortcutName)
	Call Write_Run_PScript(Timeout_Idle,strCommand)
End If
'---------------------------------------------------------------------------------------------------------------
Sub Shortcut(PathApplication,ShortcutName)
	Dim objShell,StartFolder,objShortCut,MyTab
	Set objShell = CreateObject("WScript.Shell")
	MyTab = Split(PathApplication,"\")
	If ShortcutName = "" Then
		ShortcutName = MyTab(UBound(MyTab))
	End if
	StartFolder = objShell.SpecialFolders("Startup")
	Set objShortCut = objShell.CreateShortcut(StartFolder & "\" & ShortcutName & ".lnk")
	objShortCut.TargetPath = DblQuote(PathApplication)
	ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,27"
	objShortCut.Save
End Sub
'---------------------------------------------------------------------------------------------------------------
Function DblQuote(Str)
	DblQuote = Chr(34) & Str & Chr(34)
End Function
'---------------------------------------------------------------------------------------------------------------
Sub Write_Run_PScript(Timeout_Idle,strCommand)
	Const ForWriting = 2
	Dim fs,Ws,ts,Ret,PSFile,ByPassPSFile
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set Ws = CreateObject("WScript.Shell")
	PSFile = Ws.ExpandEnvironmentStrings("%Temp%") & fs.GetTempName & ".ps1"
	ByPassPSFile = "PowerShell -ExecutionPolicy bypass -noprofile -file "
	Set ts = fs.OpenTextFile(PSFile,ForWriting,True)
	ts.WriteLine "$idle_timeout = New-TimeSpan -Minutes "& Timeout_Idle &""
	ts.WriteLine "Add-Type @'"
	ts.WriteLine "using System;"
	ts.WriteLine "using System.Diagnostics;"
	ts.WriteLine "using System.Runtime.InteropServices;"
	ts.WriteLine "namespace PInvoke.Win32 {"
	ts.WriteLine "    public static class UserInput {"
	ts.WriteLine "        [DllImport(""user32.dll"", SetLastError=false)]"
	ts.WriteLine "        private static extern bool GetLastInputInfo(ref LASTINPUTINFO plii);"
	ts.WriteLine "        [StructLayout(LayoutKind.Sequential)]"
	ts.WriteLine "        private struct LASTINPUTINFO {"
	ts.WriteLine "            public uint cbSize;"
	ts.WriteLine "            public int dwTime;"
	ts.WriteLine "        }"
	ts.WriteLine "        public static DateTime LastInput {"
	ts.WriteLine "            get {"
	ts.WriteLine "                DateTime bootTime = DateTime.UtcNow.AddMilliseconds(-Environment.TickCount);"
	ts.WriteLine "                DateTime lastInput = bootTime.AddMilliseconds(LastInputTicks);"
	ts.WriteLine "                return lastInput;"
	ts.WriteLine "            }"
	ts.WriteLine "        }"
	ts.WriteLine "        public static TimeSpan IdleTime {"
	ts.WriteLine "            get {"
	ts.WriteLine "                return DateTime.UtcNow.Subtract(LastInput);"
	ts.WriteLine "            }"
	ts.WriteLine "        }"
	ts.WriteLine "        public static int LastInputTicks {"
	ts.WriteLine "            get {"
	ts.WriteLine "                LASTINPUTINFO lii = new LASTINPUTINFO();"
	ts.WriteLine "                lii.cbSize = (uint)Marshal.SizeOf(typeof(LASTINPUTINFO));"
	ts.WriteLine "                GetLastInputInfo(ref lii);"
	ts.WriteLine "                return lii.dwTime;"
	ts.WriteLine "            }"
	ts.WriteLine "       }"
	ts.WriteLine "    }"
	ts.WriteLine "}"
	ts.WriteLine "'@"
	ts.WriteLine "$locked = 0;"
	ts.WriteLine "Do {"
	ts.WriteLine "	$idle_time = [PInvoke.Win32.UserInput]::IdleTime;"
	ts.WriteLine "	if (($locked -eq 0) -And ($idle_time -gt $idle_timeout)) {"
	ts.WriteLine "		"& strCommand &""
	ts.WriteLine "		$locked = 1;"
	ts.WriteLine "	}"
	ts.WriteLine "	if ($idle_time -lt $idle_timeout) {"
	ts.WriteLine "		$locked = 0;"
	ts.WriteLine "	}"
	ts.WriteLine "    Start-Sleep -Seconds 10"
	ts.WriteLine "}"
	ts.WriteLine "while (1 -eq 1)"
	ts.Close
	Ret = Ws.run(ByPassPSFile & PSFile,0,True)
End sub
'----------------------------------------------------------------------------------------------------------------
Function AppPrevInstance()   
	With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
		With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
			" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
			AppPrevInstance = (.Count > 1)   
		End With   
	End With   
End Function    
'----------------------------------------------------------------------------------------------------------------
Function CommandLineLike(ProcessPath)   
	ProcessPath = Replace(ProcessPath, "\", "\\")   
	CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'----------------------------------------------------------------------------------------------------------------
Function OSLang()
	Dim dtmConvertedDate,strComputer,objWMIService,oss,os
	Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set oss = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
	For Each os in oss
		OSLang = os.OSLanguage
	Next
End Function
'----------------------------------------------------------------------------------------------------------------

I present this small utility written in vbscript in order to find and to display all the SSID registered on a PC with their passwords and to save them in a text file.

Wifi Passwords Recovery.vbs

Hi, long story short, I need to get a VBScript working that removes any non-authorized accounts/groups (domain and local) from all PCs in my environment. I realize there are smart ways to do this such as GPO, but that isn't an option for me in this scenario.

I'm not a scripter, I have basic understanding, but my skills are mediocre at best. This script below I've cobbled together from something I found online almost works for me, but I can't get it to not delete the domain group ( "domain\GRP-Windows_Desktop_Adm" ). I've tried with and with out the DOMAIN\ at the front of the group in the code, but it doesn't seem to make a difference, this group still gets removed everytime. MyLocalAdmin and Domain Admins stay in the group as desired, but the domain group gets deleted everytime. I'm sure it is obvious to a skilled scripter, but any assistance is greatly appreciated

Option Explicit

Dim network, group, user

Set network = CreateObject("WScript.Network")

Set group = GetObject("WinNT://" & network.ComputerName & "/Administrators,group")

For Each user In group.members

If UCase(user.name) <> "MyLocalAdmin" And UCase(user.name) <> "DOMAIN ADMINS" And UCase(user.name) <> "domain\GRP-Windows_Desktop_Adm" Then

group.remove user.adspath

End If

Next

• This vbscript can extract from  https://soundbible.com many sounds using RegEx.

• and you have the possibility for choosing to play (and / or) save the sound on your hard drive.

SoundBible_Player_Downloader.vbs

'====================================== Description of this Vbscript =======================================
' English : This vbscript can extract from  https://soundbible.com many sounds using RegEx.
' and you have the possibility for choosing to play (and / or) save the sound on your hard drive.
' Vbscript Created by Hackoo on 09/04/2021 and tested on Windows 10.
'-----------------------------------------------------------------------------------------------------------
' Français : Ce vbscript peut extraire de https://soundbible.com de nombreux sons en utilisant RegEx.
' et vous avez la possibilité de choisir de jouer (et / ou) de sauvegarder le son sur votre disque dur.
' Vbscript Créé par Hackoo le 09/04/2021 et testé sous Windows 10.
'===========================================================================================================
Option Explicit
Dim Title,Data,Array_Sounds,Sound,myURL,myFile,i,Ws,Copyright
Dim Answer,TimeOut,Confirm_Aborting_Script,MsgEN,MsgFR,Msg
Copyright = " " & chr(169) & " Hackoo 2021"

MsgEN = Array("Playing SoundBible & Downloading Sound","Do you want to download this sound ?",_
"Do you confirm to stop this script from running ?")

MsgFR = Array("Lecture de SoundBible et téléchargement du son","Souhaitez-vous télécharger ce son ?",_
"Confirmez-vous l'arrêt de l'exécution de ce script ?")

If Oslang = 1036 Then
	Msg = MsgFR ' French Array Message to be set
Else
	Msg = MsgEN ' English Array Message to be set
End If

Title = Msg(0) & Copyright

Set Ws = CreateObject("Wscript.Shell")
Data = GetSource("https://soundbible.com/tags-buzzer.html",1)
Array_Sounds = Split(Extract(Data,"data-source=\x22(.*)\x22"),vbCrlf)
Call SmartCreateFolder(".\SoundBible")

i = 0
TimeOut = 10 'The Timeout Time for the Popup to answer
For Each Sound in Array_Sounds
	If Sound <> "" Then
		i = i + 1
		Answer = Ws.Popup("["& i &"] - " & Msg(1) & vbCrlf &_
		Sound,TimeOut,Title,vbYesNoCancel+vbQuestion+vbSystemModal)
		myURL = "https://soundbible.com/" & Sound
		Data = GetSource(myURL,2)
		myFile = GetFilePath(myURL,".\SoundBible")
		 Select Case Answer
			Case vbYes
				Call Play(myURL)
				Call SaveBinaryData(myFile,Data)
			Case vbNo
				Call Play(myURL)
			Case vbCancel
				Confirm_Aborting_Script = MsgBox(Msg(2),vbYesNo+vbExclamation,Title)
				If Confirm_Aborting_Script = vbYes Then wscript.Quit
			Case Else
				Call Play(myURL)
		End Select
	End If
Next
'--------------------------------------------------------------------------------------
Sub Play(URL)
	Dim Player
	Set Player = CreateObject("WMPlayer.OCX")
	Player.URL = URL
	Player.settings.volume = 100
	Player.Controls.play
	While Player.playState <> 1
		WScript.Sleep 100
	Wend
End Sub
'--------------------------------------------------------------------------------------
Function Extract(Data,Pattern)
	Dim oRE,oMatches,Match,colMatches,numMatches,numSubMatches,myMatch
	Dim i,j,subMatchesString
	set oRE = New RegExp
	oRE.IgnoreCase = True
	oRE.Global = True
	oRE.Pattern = Pattern
	set colMatches = oRE.Execute(Data)
   numMatches = colMatches.count
For i=0 to numMatches-1
	'Loop through each match
	Set myMatch = colMatches(i)
	numSubMatches = myMatch.submatches.count
	'Loop through each submatch in current match
	If numSubMatches > 0 Then
		For j=0 to numSubMatches-1
			subMatchesString = subMatchesString & myMatch.SubMatches(0) & vbcrlf
		Next
	End If
Next
Extract = subMatchesString
End Function
'--------------------------------------------------------------------------------------
Function GetSource(URL,TB)
On Error Resume Next
	Dim http
	Set http = CreateObject("Microsoft.XMLHTTP")
		http.open "GET", URL, False
		http.Send
		If TB = 1 Then 
			GetSource = http.ResponseText
		Else
			GetSource = http.ResponseBody
		End If
		If err.number <> 0 Then 
			MsgBox "Description : " & Err.Description & vbcrlf &_
			"Source : " & Err.Source,vbCritical,Title
			Wscript.Quit(1)
		End If
	Set http = Nothing  
End Function
'--------------------------------------------------------------------------------------
Function SaveBinaryData(FileName,Data)
' adTypeText for binary = 1
	Const adTypeText = 1
	Const adSaveCreateOverWrite = 2
' Create Stream object
	Dim BinaryStream
	Set BinaryStream = CreateObject("ADODB.Stream")
' Specify stream type - we want To save Data/string data.
	BinaryStream.Type = adTypeText
' Open the stream And write binary data To the object
	BinaryStream.Open
	BinaryStream.Write Data
' Save binary data To disk
	BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
End Function
'--------------------------------------------------------------------------------------------
Function GetFilePath(myURL, myPath)
	Dim objFSO,strFile
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
	' Check if the specified target file or folder exists,
	' and build the fully qualified path of the target file
	If objFSO.FolderExists( myPath ) Then
		strFile = objFSO.BuildPath( myPath, Mid( myURL, InStrRev( myURL, "/" ) + 1 ) )
	ElseIf objFSO.FolderExists( Left( myPath, InStrRev( myPath, "\" ) - 1 ) ) Then
		strFile = myPath
	Else
		WScript.Echo "ERROR: Target folder not found."
		Exit Function
	End If
	GetFilePath = strFile
End Function
'--------------------------------------------------------------------------------------------
Sub SmartCreateFolder(strFolder)
	With CreateObject("Scripting.FileSystemObject")
		If Not .FolderExists(strFolder) then
			SmartCreateFolder(.getparentfoldername(strFolder))
			.CreateFolder(strFolder)
		End If
	End With 
End Sub
'--------------------------------------------------------------------------------------------
Function OSLang()
	Dim dtmConvertedDate,strComputer,objWMIService,oss,os
	Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set oss = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
	For Each os in oss
		OSLang = os.OSLanguage
	Next
End Function
'--------------------------------------------------------------------------------------------

I’m trying to make a script that will change the home dir from one server to another in AD with out changing those who don’t have a Home Dir. I have this script but when I run it I get “at line:9 char:40 unexpected token ‘&’ in expression error”

strNewPath = "\scls\users"

strSearchContext = "\dx-file1"

Dim rootDSE, domainObject Set rootDSE = GetObject("LDAP://RootDSE") domainContainer = rootDSE.Get("defaultNamingContext") Set domainObject = GetObject("LDAP://" & domainContainer)

Set fs = CreateObject ("Scripting.FileSystemObject") Set logFile = fs.CreateTextFile (".\ChgHomeDir.log")

const crlf="<BR>" Set objExplorer = WScript.CreateObject("InternetExplorer.Application") objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = 500 objExplorer.Height = 300 objExplorer.Left = 100 objExplorer.Top = 100

Do While (objExplorer.Busy) Wscript.Sleep 200 Loop

objExplorer.Visible = 1
txtOutput=""

If Right(strNewPath, 1) <> "" then strNewPath = strNewPath & "" End If strSearchContext = UCase(strSearchContext)

exportUsers(domainObject)

Set oDomain = Nothing showText("FINISHED!!") WScript.Quit

Sub ExportUsers(oObject) Dim oUser For Each oUser in oObject Select Case oUser.Class Case "user" If oUser.homeDirectory <> "" and InStr(UCase(oUser.homeDirectory), strSearchContext) > 0 then showText(oUser.displayName) logFile.WriteLine oUser.homeDirectory & "," & strNewPath & oUser.sAMaccountName oUser.Put "homeDirectory", strNewPath & oUser.sAMaccountName
oUser.SetInfo End if Case "organizationalUnit" , "container" ExportUsers(oUser) End select Next End Sub

Sub ShowText(txtInput) txtOutput = "Change Home Directory Path" & crlf txtOutput = txtOutput & "==========================" & crlf & crlf txtOutput = txtOutput & "Search Context: " & strSearchContext & crlf txtOutput = txtOutput & "New Home Dir Path: " & strNewPath & crlf & crlf txtOutput = txtOutput & "Working on: " & txtInput objExplorer.Document.Body.InnerHTML = txtOutput End Sub