Delete shortcut from remote computers with multiple users - vbscript

Warning I have zero VB knoeledge
So I found this handy script this morning:
InputFile = "C:\MachineList.Txt"
Const DeleteReadOnly = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InputFile)
Do While Not (objFile.AtEndOfStream)
strComputer = objFile.ReadLine
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile("\\" & strComputer & "\c$\Documents and Settings\all users\Desktop\Malwarebytes Anti-Malware.LNK")
Err.Clear
Loop
MsgBox "Done"
It did the job great. The problem I am facing is the shortcut is not always under all users or their name lets call it user1
So I would love for it to go through MachineList.txt and browse through all of the profiles searching for Malwarebytes Anti-Malware.LNK. I have seen a few scripts on this but I just cannot wrap my head around VB is a short amount of time. I appreciate any input.

I assume that what you provided results in valid paths... therefore this should work:
InputFile = "C:\MachineList.Txt"
Const DeleteReadOnly = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InputFile)
Do While Not (objFile.AtEndOfStream)
strComputer = objFile.ReadLine
For Each objsubfolder In objFSO.GetFolder("\\" & strComputer & "\c$\Documents and Settings\").subfolders
If objFSO.FileExists(objsubfolder.Path & "\desktop\Malwarebytes Anti-Malware.LNK") Then
objFSO.DeleteFile (objsubfolder.Path & "\desktop\Malwarebytes Anti-Malware.LNK")
End If
'To check another file uncomment this
'Add as many of these as you like here
'If objFSO.FileExists(objsubfolder.Path & "\desktop\Otherfile.LNK") Then
' objFSO.DeleteFile (objsubfolder.Path & "\desktop\Otherfile.LNK")
'End If
Next
Loop
MsgBox "Done"

Related

Do I need a wait time for setting a new folder vbs?

I am using the following code:
Set StorageFileSystem = CreateObject("Scripting.fileSystemObject")
Set StorageFolder = StorageFileSystem.GetFolder(PathToStorageFiles)
msgBox "Set folders for Storage"
for each Storagefile in StorageFolder.Files 'get the creation time of the oldest recording
msgBox "DateCreated: " & Storagefile.DateCreated & vbCrLf & "EarylDateTime: " & earlyDateTime & vbCrLf & "DateTime to compare: " & dateadd("h" ,-6, Now)
if Storagefile.DateCreated < dateadd("h" ,-6, Now) then
earlyDateTime = Storagefile.DateCreated
end if
next
I have used this before without problem, even in the program that this is in. However this time it never seems to do anything. The folder has over 130,000 files in it (391GB). I don't know if I should include a delay so that the program can emumerate them or if there is some other problem that I just don't see.
Any ideas? I'm using VBS, the msgBox between the 2 set statements and the for loop works, but the one between the opening of the for loop and the if statement does not.
Are you saying the codes in the For loop doesn't seem to work? It seems not work if the folder does not have any files in it. So check the value of PathToStorageFiles.
Your logic of getting the oldest recording creation time is flawed - any time that is 6 hours before Now is treated as oldest and set to earlyDateTime.
Try this code below, with sample output:
PathToStorageFiles = "C:\Test" ' <=- Change this!
Set StorageFileSystem = CreateObject("Scripting.fileSystemObject")
Set StorageFolder = StorageFileSystem.GetFolder(PathToStorageFiles)
sOldestFile = "" ' Stores the full name of the file
earlyDateTime = dateadd("h" ,-6, Now) ' Assuming 6 hours before script started is oldest (it can be just Now)
wscript.echo StorageFolder.Files.Count & " files in the folder " & PathToStorageFiles
for each Storagefile in StorageFolder.Files 'get the creation time of the oldest recording
if Storagefile.DateCreated < earlyDateTime then
sOldestFile = Storagefile.Path
earlyDateTime = Storagefile.DateCreated
wscript.echo "earlyDateTime changed to " & earlyDateTime & " | " & sOldestFile
end if
next
wscript.echo vbCrLf & "Oldest file: " & sOldestFile & vbCrLf & "Created on: " & earlyDateTime
On a side note, you should modify this to process sub folders too, then move files into folders. 130,000 files in a single folder is a mess!
UPDATE
Based on your posted solution, there are improvements you can do.
First, use 1 FileSystemObject.
Then the recentFile in the for loop. You should set it to zero first, rather than 2 comparisons. Having said that, you have the opportunity to time the differences.
recentFile = 0
For Each file in colFiles
If file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Lastly, if the D: on the server is a NAS, then you can split the code into 2 parts - one search for most recent, the other for oldest. Then use batch file start cscript.exe //nologo <script#.vbs> method to start them in 2 processes. This you need 2 txt files for output.
If there is only 1 folder to get the latest & oldest file, it can be in 1 for loop.
This is the code that I got to work:
Option Explicit
Dim LocalStorage, NewLocalStorage, recentFile, objFSO, colFiles, objFolder, file, OldestDate, strOldestDate, fso, ts, objFile
LocalStorage = "D:\BlueIris\Storage"
NewLocalStorage = "D:\BlueIris\New"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(NewLocalStorage)
Set colFiles = objFolder.Files
For Each file in colFiles
If recentFile = "" Then
recentFile = file.DateCreated
ElseIf file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Set objFolder = objFSO.GetFolder(LocalStorage)
Set colFiles = objFolder.Files
OldestDate = Now
For Each objFile in colFiles
if objFile.DateCreated < OldestDate Then
OldestDate = objFile.DateCreated
strOldestDate = objFile.DateCreated
End if
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile ("C:\DVRInfo.txt", true)
ts.writeline recentFile
ts.writeline strOldestDate
ts.close
I run this on the actual server so that it runs a lot faster than the original code I attempted. Let me know if you still flaws in this please, I want to be as efficient as possible.
Thanks
EDIT:
New code:
Option Explicit
Dim LocalStorage, NewLocalStorage, recentFile, objFSO, colFiles, objFolder, file, OldestDate, strOldestDate, fso, ts, objFile
LocalStorage = "D:\BlueIris\Storage"
NewLocalStorage = "D:\BlueIris\New"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(NewLocalStorage)
Set colFiles = objFolder.Files
Set recentFile = 0
For Each file in colFiles
If file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Set objFolder = objFSO.GetFolder(LocalStorage)
Set colFiles = objFolder.Files
OldestDate = Now
For Each objFile in colFiles
if objFile.DateCreated < OldestDate Then
OldestDate = objFile.DateCreated
strOldestDate = objFile.DateCreated
End if
Next
Set ts = fso.CreateTextFile ("C:\DVRInfo.txt", true)
ts.writeline recentFile
ts.writeline strOldestDate
ts.close

I am trying to find specific links on users desktops and create a file logging the results

I have used similar before and I have local admin rights on every computer in our network. The following code generates an error on line 16 char 1.
line 16 For Each objsubfolder In objFSO.GetFolder("\" & strComputer & "%HOMEPATH%").subfolders
If the file exists it should write a line in the text file to indicate so for each user with a profile. If the file doesn't exist is should write a line in the same text file.
The error I get is Path not found 800A004C.
The computers.txt file contains a list of all the computers I want to check.
InputFile = "computers.txt"
Const DeleteReadOnly = True
Const ForAppending = 8
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim gsLog : gsLog = ".\logdemo.log"
WScript.Echo gsLog, "exists:", CStr(goFS.FileExists(gsLog))
' .OpenTextFile(filename[, iomode[, create[, format]]])
Dim goLog : Set goLog = goFS.OpenTextFile(gsLog, ForAppending, True)
goLog.WriteLine Now & " start"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InputFile)
Do While Not (objFile.AtEndOfStream)
strComputer = objFile.ReadLine
For Each objsubfolder In objFSO.GetFolder("\\" & strComputer & "%HOMEPATH%").subfolders
If objFSO.FileExists(objsubfolder.Path & "\desktop\program1.LNK") Then
golog.WriteLine Join(Array(Now, strComputer, objsubfolder, "This Computer has Program 1"))
Else
golog.WriteLine Join(Array(Now, strComputer, objsubfolder, "None"))
End If
Next
Loop
golog.WriteLine Now & " End"
golog.WriteLine "-----------------------------------------------------------"
golog.Close
MsgBox "Done"
To prove that the FSO does not expand environment strings automagically:
Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim oWS : Set oWS = CreateObject("WScript.Shell")
Dim sPath
sPath = "%windir%\addins"
WScript.Echo qq(sPath), CStr(oFS.FolderExists(sPath))
sPath = oWS.ExpandEnvironmentStrings("%windir%\addins")
WScript.Echo qq(sPath), CStr(oFS.FolderExists(sPath))
output:
"%windir%\addins" False
"C:\WINDOWS\addins" True
So put some work into feeding a valid path to .GetFolder().

how to add a log to my vbscript

i have this script that reads a list of computers and check to see if the computers have the right software version install. the script echo to me the computers with the wrong version, but i want to make a log instead
Dim strComputer, objFSO, ObjShell, strDisplayName, objList, strObject
Dim objReg, arrSubKeys, strProduct, strVersion, strReqVersion
Const For_Writing = 2
Const ForReading = 1
const ForAppending = 3
Const HKLM = &H80000002
Const strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
strReqVersion = "8.2.1 MP2"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objList = objFSO.OpenTextFile("c:\test\test.txt",ForReading)
Do While Not objList.AtEndOfStream
strComputer = objList.ReadLine
If HostOnline(strComputer) = True Then
Inventory(strComputer)
End If
Loop
Function Inventory(strComputer)
Set objTextFile = objFSO.OpenTextFile("c:\test\inventory.txt",2,true)
'creating a dictionary object
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
' Enumerate the subkeys of the Uninstall key
objReg.EnumKey HKLM, strKeyPath, arrSubKeys
For Each strProduct In arrSubKeys
' Get the product's display name
objReg.GetStringValue HKLM, strKeyPath & "\" & strProduct, "DisplayName", strDisplayName
' Process only products whose name contain 'symantec'
If InStr(1, strDisplayName, "Symantec", vbTextCompare) > 0 Then
' Get the product's display version
objReg.GetStringValue HKLM, strKeyPath & "\" & strProduct, "DisplayVersion", strVersion
If strReqVersion <> strVersion Then
WScript.Echo strObject
objDictionary.Add strComputer, strVersion
For Each strObject In objDictionary
WScript.Echo strObject
objTextFile.WriteLine(strObject)
Next
objTextFile.Close
End If
End If
Next
End Function
Function HostOnline(strComputername)
'---------- Test to see if host or url alive through ping -----------------
' Returns True if Host responds to ping
'
' strComputername is a hostname or IP
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim objShell, objFSO, sTempFile, fFile
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = objFSO.GetSpecialFolder(2).ShortPath & "\" & objFSO.GetTempName
objShell.Run "cmd /c ping -n 2 -l 8 " & strComputername & ">" & sTempFile, 0 , True
Set fFile = objFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0
HostOnline = False
Case Else
HostOnline = True
End Select
ffile.close
objFSO.DeleteFile(sTempFile)
Set objFSO = Nothing
Set objShell = Nothing
End Function
can some one help me please thanks
There are several ways to do this. The simplest way, without any modification to your script, would be to call the script with cscript.exe (in a command prompt) and redirect the output to a file:
cscript your.vbs > output.log
However, if you want a log to be created even when users double-click your script you'll have to change your script so that it writes to a file instead of echoing the output. Open the log file at the beginning of the script:
Set myLog = objFSO.OpenTextFile("C:\my.log", For_Writing, True)
replace WScript.Echo ... with myLog.WriteLine ..., and close the file before you exit from the script:
myLog.Close
A somewhat more sophisticated approach would be to create a set of logging functions, which will allow you create log lines depending on certain conditions, e.g. LogInfo() for informational log messages and LogError() for errors.
Shameless plug: Some time ago I got fed up with writing the same boilerplate logging functions over and over again, so I wrote a logger class that encapsulates the usual logging facilities (interactive console, files, eventlog) and provides logging methods for 4 log levels (Error, Warning, Information, Debug). The class can be used for logging to a file like this:
Set myLog = New CLogger
myLog.LogToConsole = False
myLog.LogFile = "C:\my.log"
myLog.LogInfo "info message"
...
myLog.LogError "an error occurred"
The log file is automatically closed when the object is released.
Why not use the system's event log? I described how in this answer
It means most of the work is done for you and you don't need to worry about where to put your log file

vbscript : fso.opentextfile permission denied

In my code segment, when I script the file name, it gives me a permission denied
on the following line:
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
Here is the script
'output log info
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\eNet"
strFile = "\weeklydel.bat"
'strText = "Book Another Holiday"
strText = strToAdd
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 2
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
I have assigned the vbscript domain administrator permissions. Any ideas?
thanks in advance
I don't think this has to do with File Permissions per se. It has to do with the fact that you've created the file using:
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
That creates the file...and carries a reference to that file (objFile)
Then you don't close the file before you destroy the reference
...
'Missing objFile.Close here
Set objFile = nothing
Set objFolder = nothing
...
Consequently you're destroying the reference but leaving the textstream open in memory thus locking your file.
You are then proceeding to attempt to re-open the file while the file is already "open". This is a little long winded, you've already got a reference after you've created the file - it would be easier just to write straight to that rather than destroy the reference before creating another one.
for what its worth...
I was convinced I had a permission error because of this line:
Set LogFile = LogFSO.OpenTextFile(LogFileName, ForWriting, True)
Because that's the line that the 'permission denied' error pointed to. But in fact, my permission error was a few lines further down:
WshShell.AppActivate(ScreensToRemove(i))
WshShell.SendKeys ("~")
WScript.Sleep(1000)
There was no screen with such a caption, so the SendKeys is what did not have permission.
The solution, of course, was:
If WshShell.AppActivate(ScreensToRemove(i)) = True Then
WshShell.SendKeys ("~")
WScript.Sleep(1000)
End if
Hope that might help.
Also, make sure that you don't have the file open in Excel (I had this problem with a .csv file)...
In my particular case the file which existed before and all I had to do was give permission to the Everyone user
balabaster is exactly right. You either need to close the file before reopening it a second time for writing, or using the existing open handle.

VBScript: way to check why the script stopped?

I have this VBScript which runs however, while it is processing, it will randomly stop and require a user to hit the spacebar for it to display the rest of its ongoing output.
How do I figure out why this is happening?
Here is a copy of the script:
'On Error Resume Next
Dim arrFolders()
intSize = 0
Function StampNow()
Dim Hr, Mn, Yr, Mon, Dy, Date1
Date1=Now()
Hr=DatePart("h",Date1)
Mn=DatePart("n",Date1)
Yr = DatePart("yyyy",Date1)
Mon = DatePart("m",Date1)
Dy = DatePart("d",Date1)
StampNow = Yr & "-" & Mon & "-" & Dy
end function
'Output log info.
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\log"
strFile = "\dpadmin_copy2run-"& StampNow & ".bat"
'strText = "dpadmin_copy2"
strText = strToAdd
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists.
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript.
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strFolderName = "D:\1\production\Openjobs"
Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
dim diffindates
'Init vars for regex.
Dim retVal, retVal2
Dim Lastprop
Dim objRegExpr 'regex variable
Set objRegExpr = New regexp
Set objRegExprX31 = New regexp
objRegExpr.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9][A-Z][A-Z][A-Z]"
objRegExprX31.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]X31"
objRegExpr.Global = True
objRegExprX31.Global = True
objRegExpr.IgnoreCase = True
objRegExprX31.IgnoreCase = True
'Variables for getting last accessed property.
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
'Current time vars.
Dim currenttime
currenttime = Now()
ParentFolder = "D:\1\Production\Openjobs\ClosedJobs"
For Each objFolder in colSubfolders
intSize = intSize + 1
retVal = objRegExpr.Test(objFolder.Name)
retVal2 = objRegExprX31.Test(objFolder.Name)
if (retVal OR retVal2 ) then
'set filename to array
strFolderName = objFolder.Name
'Get last modified date.
Set f = fs.GetFolder(objFolder.Name)
Lastprop = f.DateLastModified
'MsgBox(Lastprop)
if ( DateDiff("m", f.DateLastModified, Now()) > 4) then
diffindates = DateDiff("m", f.DateLastModified, Now())
Set objShell = CreateObject("Shell.Application")
Set objCopyFolder = objShell.NameSpace(ParentFolder)
OutputToLog("rem " & f.DateLastModified & ":" & objFolder.Name )
outputtolog("move /Y """ & objFolder.Name & """ " & ParentFolder)
wscript.echo(diffindates & ":" & objFolder.Name & vbCr)
end if
end if
Next
Update
It stops at the line:
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
with the error Microsoft VBScript runtime error: Permission denied
I'm a little confusd by this. The logfile was only 356kb
I was able to run your script several times without it pausing for input. Run your script with the //X flag to start it in the debugger:
>cscript //nologo //X dpadmin_copy2.vbs"
You should be able to then step through the code.
You can also start putting in wscript.echo trace statements everywhere and see if you can narrow down what it's waiting on.
One thing that's gotten me in the past; If your command console is in QuickEdit mode and you accidentally click anywhere in the console window, the console will hang while it waits for you to press a key.
Well the first step is to remove any global On Error Resume Next statements. Better feedback would come if we could see the script.
You usually get an Permission denied when trying to write to a text file when the text file already has an open handle from some other process or because you have previously opened a handle earlier in you code which you have not closed. I haven't tried this but I don't know why this wouldn't work, you can look at using Handle from Sysinternals (Microsoft) to tell you what process has the open handle for the file. Please see here for a further reference of how to use Handle: http://www.orcsweb.com/blog/post/Closing-open-file-handles.aspx You could also write a second script which runs in a loop to monitor the main script. The second script can verify the first script by doing a WMI Process query which returns only processes that match a defined command line. The second script could then restart the main it stops, alert you, log a file, launch a handle search, etc.

Resources