VB Script to delete certain files and if files are found copy other files to directory - windows

I have a hard drive that is infected with a virus. The virus encrypts files and then asks for a ransom to unencrypt them. The files are HELP_DECRYPT.HTML, HELP_DECRYPT.PNG, HELP_DECRYPT.TXT and HELP_DECRYPT.URL.
There are thousands of infected files on the drive. I am trying to write a script to go through all the folders on the drive, and if it finds any of the malicious files it deletes them. I then want if to copy files from the backup drive in the same directory ie. if found in I\Folder\ if would get files from F\Folder\ .
In my case the infected drive is Y, and the backup drive is X.
I am relatively new to VBScripts and here is what I have so far:
set fso = CreateObject("Scripting.FileSystemObject")
ShowSubFolders FSO.GetFolder("Y:\"), 3
Sub ShowSubFolders(Folder, Depth)
If Depth > 0 then
For Each Subfolder in Folder.SubFolders
'Wscript.Echo Subfolder.Path
DeleteFiles(subFolder.path)
On Error Resume Next
ShowSubFolders Subfolder, Depth -1
Next
End if
End Sub
'deletes the malicious files and calls the copy function'
Function DeleteFiles(path)
'wscript.echo("in delete method")
set FSO2 = Createobject("Scripting.FileSystemObject")
set ofolder = createobject("Scripting.FileSystemObject")
set ofolder = FSO2.GetFolder(path)
if FSO2.FileExists("HELP_DECRYPT.URL") Then
ofolder.DeleteFile("HELP_DECRYPT.PNG")
ofolder.DeleteFile("HELP_DECRYPT.HTML")
ofolder.DeleteFile("HELP_DECRYPT.URL")
ofolder.DeleteFile("HELP_DECRYPT.TXT")
wscript.echo("DeletedFiles")
copyFiles(FSO.GetParentFolder)
end if
End Function
'copies files from the backup'
Function CopyFiles(from)
dim to1 'where we're copying to
to1=from 'where we're copying from
Call Replace (from, "Y:", "X:")
SET FSO3 = CreateObject("Scripting.FileSystemObject")
For Each file In from 'not sure about "file"
FSO3 = file
Call FSO3.CopyFile (from, to1, true)'copies file and overwrites if already there
Next
End Function

Here's what I would use:
Option Explicit
Dim FSO, badFiles
Set FSO = CreateObject("Scripting.FileSystemObject")
badFiles = Array("HELP_DECRYPT.PNG", "HELP_DECRYPT.URL", "HELP_DECRYPT.HTML", "HELP_DECRYPT.TXT")
Walk FSO.GetFolder("Y:\")
Sub Walk(folder)
Dim subFolder
For Each subFolder in folder.SubFolders
DeleteFiles subFolder, badFiles
RestoreFiles "X:", subFolder
Walk subFolder
Next
End Sub
Sub DeleteFiles(folder, filesToDelete)
Dim file
For Each file In filesToDelete
file = FSO.BuildPath(folder.Path, file)
If FSO.FileExists(file) Then FSO.DeleteFile file, True
Next
End Sub
Sub RestoreFiles(sourceRoot, destinationFolder)
Dim sourcePath, file
WScript.Echo "Restoring " & destinationFolder.Path & " ..."
sourcePath = Replace(destinationFolder.Path, destinationFolder.Drive, sourceRoot)
If FSO.FolderExists(sourcePath) Then
For Each file In FSO.GetFolder(sourcePath).Files
WScript.Echo file.Name
' maybe add a DateLastModified check here?
file.Copy FSO.BuildPath(destinationFolder.Path, file.Name), True
Next
Else
WScript.Echo "Warning! Folder not found: " & sourcePath
End If
End Sub
General tips for working with VBScript:
Always use Option Explicit
Avoid On Error Resume Next except in very closely confined situations. Simply suppressing any errors is never a good idea.
Run scripts like the above on the command line with cscript.exe so you can see the script's Echo output without having to click at 1000's of message boxes.
Use a global FSO object. No need to define a new one in every function
Try to be generic. Look how DeleteFiles() RestoreFiles() above are actually not at all tailored to your current problem. You might be able to re-use those functions in a different script without having to change them.

Related

VBScript - Delete json file in a sub-folder

I've looked around and all examples I can find are very general purpose, I simply need code to delete a single .json file from a randomly named subfolder within the Temporary Internet Files folder.
Currently I am downloading a very small file each time my VBScript is ran, however it seems to download that file to Temp Internet Files and on each subsequent run, grabs it from there instead of the Internet. This is a file that must always be new.
How can I search through all sub-folders within Temp Internet Files and delete forge[1].json? AND, delete it's parent folder?
For dbmitch:
' DELETE CACHED FORGE FILE ------------------------ '
Function DelFiles()
look_subfolders UserProfile & "AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.IE5\"
Set Folder = objFso.GetFolder ( fold )
Sub look_subfolders ( fold )
For Each objFile in Folder.Files
If objFile.Name = "forge[1].json" Then
objFile.Delete
End If
Next
'look into subfolders:
For Each Subfolder in Folder.SubFolders
look_subfolders Subfolder.Path
Next
End Sub
End Function
Set objFso = CreateObject( "Scripting.FileSystemObject" ) is defined elsewhere at the top of the script (which has worked for every other object I've used).
I also tried this too...
Path = UserProfile & "AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.IE5"
Set objFolder = objFso.GetFolder(Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If objFile.Name = "forge[1].json" Then
objFile.Delete
End If
Next
For Each objFile In objFolder.SubFolders
If objFile.Name = "forge[1].json" Then
objFile.Delete
End if
Next
It deletes the file from the main folder, but doesn't delve into any subfolders.
Try this, it's a recursive call:
Set fs = CreateObject("Scripting.FileSystemObject")
look_subfolders "C:\windows\temp" 'change the path to your temp folder
Sub look_subfolders(fold)
Set Folder = fs.GetFolder(fold)
'folder files:
For Each objFile in Folder.Files
If objFile.Name = "forge[1].json" Then
objFile.Delete
msgbox "File found and deleted" 'message to confirm deletion
WScript Quit
End If
Next
'look into subfolders:
For Each Subfolder in Folder.SubFolders
look_subfolders Subfolder.Path
Next
End Sub

vbscript - if any file exists then copy and rename

I have a vb script file - main.vbs. Its contents are:
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
If fileSystemObject.FileExists("D:\a\source.doc") Then
fileSystemObject.CopyFile "D:\b\template.doc", "D:\c\source.doc"
fileSystemObject.MoveFile "D:\a\source.doc" , "D:\d\"
End If
What this script does is: It checks if a file by the name of 'source.doc' exists in folder 'D:\a' . if it does, then the script,
(i) copies the file 'template.doc' kept in folder 'D:\b'
(ii) renames 'template.doc' to 'source.doc'
(iii) and moves this renamed file to folder 'D:\c'.
(iv) and also moves the file 'source.doc' from 'D:\a' to 'D:\d'
The script is working fine. But I want that the script should run when the filename 'source' varies (but same extension .doc).
The filename 'template.doc' remains the same.
How can I do this ?
This uses the FSO object more like a dir. Do tests on the name to decide if to process it or not. fso.copyfile is same as thing.copy using a collection and a For Each loop.
'On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Dirname = InputBox("Enter Dir name")
ProcessFolder DirName
Sub ProcessFolder(FolderPath)
' On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
msgbox Thing.Name & " " & Thing.DateLastModified
Next
'Uncomment below lines to do sub folders
' Set fldrs = fldr.subfolders
' For Each thing in fldrs
' ProcessFolder thing.path
' Next
End Sub

comparing/copying largest files to new folder

What I wish to do is:
Copy files from a variety of sub-folders under a single main folder to a destination folder.
Three options when copying:
If no file in destination folder exists then copy.
If file exists, copy over if filesize is larger than destination file.
If file exists and both are the same filesize compare date/time and copy over if most recent.
Here is my pseudocode so far:
Dim filesys, strSourceFile, strDestFolder, strDestFile
Set filesys = CreateObject("Scripting.FileSystemObject")
strSourceFile = S:\SoCal\Section_2\*\Autogen\texture\*.agn
strDestFolder = F:\ADDON_SCENERY\simwestSOCAL\texture
strDestFile = F:\ADDON_SCENERY\simwestSOCAL\texture\*.agn
COPY each file in strSourceFolder
If IsEmpty (SourceFile, DestFolder)
Else If (SourceFile FileSize > DestFile)
Else If (SourceFile DateTime > DestFile DateTime)
Then 'keep/copy most recent file
End if
Am I on the right track?
Do I need to add a Loop?
Can one compare file sizes? All my research has found nothing yet on this.
Can I compare Date and Time against files?
As an update to my original post... (hope I am following forum rules correctly),
I have spent the last several weeks non-stop just reading-reading-reading and testing-failure-testing. I am happy to say (and a little proud), that I have completed my very first script... and it appears to work as planned but for just one file. I now need to convert this to work on all files inside my 'sourcefolder'.
I am a bit "brain dead" from this so any direction on converting this would be most appreciated. I know I need loops but what type and where? Do I rename everything referring to a file to a folder or use '*.txt' for files? In the meantime I will keep studying.
Here is my script (yea, lot's of MsgBox's so I could follow along the script path):
dim dFolder
dFolder = "S:\Scripting Workfolder\destfolder\"
dim dFile
dFile= "S:\Scripting Workfolder\destfolder\File 1.txt"
dim sFile
sFile = "S:\Scripting Workfolder\sourcefolder\File 1.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
'Check to see if the file already exists in the destination folder
If Not fso.FileExists(dFile) Then
MsgBox "File does not exist - will copy over to dFolder"
fso.CopyFile sFile, dFolder, true
Elseif fso.FileExists(dFile) Then
MsgBox "File already exist in destination folder determine largest"
ReplaceIfLarger sFile, dFile
End If
Sub ReplaceIfLarger(sFile, dFile)
const overwrite_existing = true
dim objFSO
set objFSO = createobject("Scripting.FileSystemObject")
dim objSourceFile
set objSourceFile = objFSO.GetFile(sFile)
'dim kbSourceSize
kbSourceSize = objSourceFile.size
dim objTargetFile
set objTargetFile = objFSO.GetFile (dFile)
'dim kbTargetSize
kbTargetSize = objTargetFile.size
If kbSourceSize > kbTargetSize Then
MsgBox "Source file is LARGER and will overwrite to dest folder"
objFSO.CopyFile objSourceFile.Path, objTargetFile.Path, overwrite_existing
ElseIf kbSourceSize < kbTargetSize Then
MsgBox "Source file is smaller - Will not overwrite to dest folder"
Else
ReplaceIfNewer sFile, dFile
End If
End Sub
Sub ReplaceIfNewer(sFile, dFile)
MsgBox "Both files exist and are the same size. Keep newest file"
const overwrite_existing = true
dim objFSO
set objFSO = createobject("Scripting.FileSystemObject")
dim dtmSourceFile
set dtmSourceFile = objFSO.GetFile(sFile)
dim dtmTargetFile
set dtmTargetFile = objFSO.GetFile(dFile)
If (dtmSourceFile.DateLastModified > dtmTargetFile.DateLastModified) then
MsgBox "Source File is Newer than Target File - Overwrite Target file"
objFSO.CopyFile dtmSourceFile.Path, dtmTargetFile.Path, overwrite_existing
Else
MsgBox "Source File is Older than Target File - Will not overwrite file"
End If
End Sub

VBS to Search for Multiple Files Recursively in C:\Users

I need to recursively search for multiple files through the C:\Users directory tree recursively.
If I find any of the specified files in any of the sub-directories, I want to echo out the full path.
Here is what I have:
Dim fso,folder,files,sFolder,newFolder
Dim arr1
arr1 = Array("myFile1.pdf","myFile2.pdf","myFile3.pdf","nutbag.rtf","whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\Users"
Set folder = fso.GetFolder(sFolder)
Set files = folder.SubFolders
For each folderIdx In files
IF (Instr(folderIdx.Name,"Default") <> 1) Then
If (Instr(folderIdx.Name,"All Users") <> 1) Then
newFolder = sfolder & "\" & folderIdx.Name
CopyUpdater fso.GetFolder(newFolder)
End If
End If
Next
Sub CopyUpdater(fldr)
For Each f In fldr.Files
For Each i in arr1
If LCase(f.Name) = i Then
WScript.echo(f.name)
End If
Next
Next
For Each sf In fldr.SubFolders
CopyUpdater sf
Next
End Sub
If I run it as 'Administrator', I get:
VBScript runtime error: Permission Denied
If I run it as 'Local System' user, I get:
VBScript runtime error: Path not found
If I add, 'On Error Resume Next' to the beginning to suppress the errors, I get nothing back.
I have placed a text file called 'whoa.txt' in numerous locations around the C:\Users sub-dirs.
My suspicion is that it is a Windows permissions thing, but I am unsure.
Thanks much.
First I didn't use your code, it confuses me what you are trying to accomplish.
Next you should run the script in Administrator mode command prompt. This should allow you to check if the file is there.
Then paste code below to a vbs file and cscript it. This code displays all the matched filenames.My idea is that instead of going through all files in any folder for a matching filename, check if those wanted files exists in that folder - this is generally faster as some folders contains hundreds of files if not thousands (check your Temp folder!).
Option Explicit
Const sRootFolder = "C:\Users"
Dim fso
Dim arr1
Dim oDict ' Key: Full filename, Item: Filename
Main
Sub Main
arr1 = Array("myFile1.pdf", "myFile2.pdf", "myFile3.pdf", "nutbag.rtf", "whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDict = CreateObject("Scripting.Dictionary")
' Call Recursive Sub
FindWantedFiles(sRootFolder)
' Display All Findings from Dictionary object
DisplayFindings
Set fso = Nothing
Set oDict = Nothing
End Sub
Sub FindWantedFiles(sFolder)
On Error Resume Next
Dim oFDR, oItem
' Check if wanted files are in this folder
For Each oItem In arr1
If fso.FileExists(sFolder & "\" & oItem) Then
oDict.Add sFolder & "\" & oItem, oItem
End If
Next
' Recurse into it's sub folders
For Each oFDR In fso.GetFolder(sFolder).SubFolders
FindWantedFiles oFDR.Path
Next
End Sub
Sub DisplayFindings()
Dim oKeys, oKey
oKeys = oDict.Keys
For Each oKey In oKeys
wscript.echo oKey
Next
End Sub

Duplicating a complex folder structure with only shortcuts

There are 2 shared drives. One of them has a very complex folder structure. I would like to replicate the entire folder structure of Share 1 to Share 2. However I don't want to make duplicate files, rather I would want a shortcut or symbolic links to be present in the 2nd share. I tried to do this with existing tools like Robocopy and mklink and failed to achieve the result. Any Ideas to resolve this issue is highly appreciated.
You can do achieve this by Using the filesystemobject to work it's way down the folder structure, if the folder exists in the destination, do nothing and create shortcuts in that folder for all the hosting folders files. Otherwise, create the folder and create the shortcuts for the hosting files anyway.
The DoFolder sub widdles it's way down through all the subfolders.
The GetFN Function collects only the filenames of all the files in the hosting folder. Even if there are periods in the filename.
This was a fun program to write, thanks.
FolderShadows.vbs
Dim fso, HostFolder, DestFolder
'Host Folder - Folder must exist.
HostFolder = "C:\From\Folder"
'Destination Folder - Folder must exist.
DestFolder = "D:\To\Folder"
Set fso = CreateObject("Scripting.FileSystemObject")
DoFolder fso.GetFolder(HostFolder)
Sub DoFolder(Folder)
Dim SubFolder
If fso.folderexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder)) = False Then
fso.createfolder(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder))
End If
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
Dim FileName, shortcut
If (fso.fileexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk") = False) Then
FileName = Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk"
Set shortcut = CreateObject("WScript.Shell").CreateShortcut(FileName)
shortcut.Description = "Shortcut To " & File.Name
shortcut.TargetPath = fso.GetAbsolutePathName(Folder) & "\" & File.Name
shortcut.Save
End If
Next
End Sub
Function GetFN(FileName)
Dim Result, i
Result = FileName
i = InStrRev(FileName, ".")
If ( i > 0 ) Then
Result = Mid(FileName, 1, i - 1)
End If
GetFN = Result
End Function
Note: This script can run on an automated schedule, as it is built to auto update the shortcuts and folders if new files/folders are found.

Resources