I am trying to implement a recursive search script with following usecase:-
User can input string and directory to search for.
Script will list all the files with path that matches point 1 (maybe in separate file).
I tried it with batch script and tried to run from html page to pass parameters (string and directory). It failed as mentioned over stackoverflow (due to javascripts inability to access file system.)
My batch script is :- findstr /s /i /n /C:#name= *.* v > results.txt
Now I am wondering if my requirement can be fulfilled with batch file or I need to switch to vbscript. Please suggest.
I have no Idea of vbscript.
I can not install any third party tool on my windows workstation.
This is vbscript and won't trigger security dialogs if run from a local page.
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Dirname = InputBox("Enter Dir name")
Searchterm = Inputbox("Enter search term")
ProcessFolder DirName
Sub ProcessFolder(FolderPath)
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If Instr(contents.readall, searchterm) then wscript.echo thing.path
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
' wscript.echo thing.name
ProcessFolder thing.path
Next
End Sub
EDIT and EDIT2 (add browse for folder)
In an HTA (I had to start from scratch - I couldn't make your butchering of my script work).
<HTML>
<HEAD><TITLE>Simple Validation</TITLE>
<SCRIPT LANGUAGE="VBScript">
Dim Dirname
Dim Searchterm
Dim FSO
Dim objOutFile
Sub Browse
On Error Resume Next
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0, "Select the My Documents folder", 9)
If Err.number<>0 Then
MsgBox "Error Setting up Browse for Folder"
Else
A = bff.ParentFolder.ParseName(bff.Title).Path
If err.number=424 then err.clear
tb2.value = A
End If
End Sub
Sub Search
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set objOutFile = fso.CreateTextFile("results.txt",True)
Dirname = tb2.value
Searchterm = tb1.value
ProcessFolder DirName
End Sub
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Test = Instr(contents.readall, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine thing.path
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
</script>
</head>
<body>
<p><INPUT Name=tb1 TYPE=Text Value="Search">
<p><INPUT Name=tb2 TYPE=Text Value="Folder"> <INPUT NAME="Browse" TYPE="BUTTON" VALUE="Browse" OnClick=Browse>
<p><INPUT NAME="Search" TYPE="BUTTON" VALUE="Search" OnClick=Search>
</body>
</html>
Related
I am using some vbscript to search for string inside a directory. Now I need my script to search for multiple instance of string in each file and return line number or some other identifiable information. My current vbscript is :-
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Test = Instr(contents.readall, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine thing.path
demo.innerHtml = demo.innerHtml & thing.path & "<br>"
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
I need to iterate through lines of each file to get line numbers containing string.
Reads each line and searches each line. Also remembers the previous search and directory.
Two issues that you can fix.
It will now hits the 5 million statement timeout message esp if going through exe files.
It won't find Unicode text.
This is the third time I've written the program.
<HTML>
<HEAD><TITLE>Simple Validation</TITLE>
<SCRIPT LANGUAGE="VBScript">
Dim Dirname
Dim Searchterm
Dim FSO
Dim objOutFile
Sub Browse
On Error Resume Next
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0, "Select the My Documents folder", 9)
If Err.number<>0 Then
MsgBox "Error Setting up Browse for Folder"
Else
A = bff.ParentFolder.ParseName(bff.Title).Path
If err.number=424 then err.clear
tb2.value = A
End If
End Sub
Sub Search
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\StackOverflow\VBS\Searchterm", tb1.value
WshShell.RegWrite "HKCU\Software\StackOverflow\VBS\Directory", tb2.value
Set fso = CreateObject("Scripting.FileSystemObject")
Set objOutFile = fso.CreateTextFile("results.txt",True)
Dirname = tb2.value
Searchterm = tb1.value
ProcessFolder DirName
End Sub
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Linenum = 0
Do Until contents.AtEndOfStream
line = contents.readline
Linenum = Linenum + 1
Test = Instr(line, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine LineNum & " " & thing.path
Loop
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
Sub Init
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
tb1.value = WshShell.RegRead("HKCU\Software\StackOverflow\VBS\Searchterm")
tb2.value = WshShell.RegRead("HKCU\Software\StackOverflow\VBS\Directory")
End Sub
</script>
</head>
<body Onload=Init>
<p><INPUT Name=tb1 TYPE=Text Value="Search">
<p><INPUT Name=tb2 TYPE=Text Value="Folder"> <INPUT NAME="Browse" TYPE="BUTTON" VALUE="Browse" OnClick=Browse>
<p><INPUT NAME="Search" TYPE="BUTTON" VALUE="Search" OnClick=Search>
</body>
</html>
I need a quick script do two parts.
Run a windows executable
Delete files within a folder and subfolders (*.jpg, *.img).
The first part of the below script works (running the executable) but I am getting stuck on part 2. I get
Cannot use parentheses when calling a sub
The error is on the line with the RecursiveDelete call. I actually cut and pasted that code from another SO question. I have googled the error but still don't understand.
Can anybody know how to get this script working?
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\Users\acer\Desktop\CT\process.exe" & Chr(34), 0
Set WshShell = Nothing
Dim PicArray(2)
Dim p
PicArray(1) = "*.jpg"
PicArray(2) = "*.img"
For p = 1 To 2
RecursiveDelete ("D:\pictures", PicArray(p))
Next p
Private Sub RecursiveDelete(ByVal Path As String, ByVal Filter As String)
Dim s
For Each s In System.IO.Directory.GetDirectories(Path)
try
RecursiveDelete(s, Filter)
catch dirEx as exception
debug.writeline("Cannot Access " & s & " : " & dirEx.message
end try
Next
For Each s In System.IO.Directory.GetFiles(Path, Filter)
try
System.IO.File.Delete(s)
catch ex as exception
debug.writeline("Cannot delete " & s & " : " & ex.message)
end try
Next
End Sub
Update: Revised answer from Hackoo that works great.
Option Explicit
Dim fso,RootFolder, wshShell
set fso = CreateObject("Scripting.FileSystemObject")
RootFolder = "D:\pictures"
Set RootFolder = fso.GetFolder(RootFolder)
Call RecursiveDelete(RootFolder)
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\process.exe" & Chr(34), 0
Set WshShell = Nothing
'*****************************************************************************
Function RecursiveDelete(Folder)
Dim File,MyFile,Ext,i,SubFolder
Set Folder = fso.GetFolder(Folder)
For each File in Folder.Files
Set MyFile = fso.GetFile(File)
Ext = Array("iMG","JPG")
For i = LBound(Ext) To UBound(Ext)
If LCase(fso.GetExtensionName(File.name)) = LCase(Ext(i)) Then
MyFile.Delete()
Exit For
end if
Next
Next
For each SubFolder in Folder.SubFolders
Call RecursiveDelete(SubFolder)
Next
End Function
'*****************************************************************************
Try like this way :
Option Explicit
Dim fso,RootFolder
set fso = CreateObject("Scripting.FileSystemObject")
RootFolder = "D:\pictures"
Set RootFolder = fso.GetFolder(RootFolder)
Call RecursiveDelete(RootFolder)
Msgbox "Pictures Cleaned !",vbInformation,"Pictures Cleaned !"
'*****************************************************************************
Function RecursiveDelete(Folder)
Dim File,MyFile,Ext,i,SubFolder
Set Folder = fso.GetFolder(Folder)
For each File in Folder.Files
Set MyFile = fso.GetFile(File)
Ext = Array("jpg","img")
For i = LBound(Ext) To UBound(Ext)
If LCase(fso.GetExtensionName(File.name)) = LCase(Ext(i)) Then
MyFile.Delete()
Exit For
end if
Next
Next
For each SubFolder in Folder.SubFolders
Call RecursiveDelete(SubFolder)
Next
End Function
'*****************************************************************************
Instead of passing the array item into RecursiveDelete, obtain the contents of the array item into a variable within the loop, and pass that variable instead.
Code would be similar to this- did not have a chance to test syntax.
For p = 1 To 2
Dim PicItem
PicItem = PicArray(p)
RecursiveDelete ("D:\pictures", PicItem )
Next p
I currently have a script that takes a PC name and then outputs the IP Address and then another textbox with the Fully Qualified Domain Name. I have been using the InputBox instead of Msgbox as I need to be able to copy the results to the clipboard.
My question is: Is there a way to output both the IP and the FQDN in the same textbox and have a 'Copy to Clipboard' button next to each of those?
Here is what I've been using so far:
Sub Ping
Set objShell = CreateObject("WScript.Shell")
Dim tmp
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Message = "Enter the Computer Name you would like to convert to an IP address."
Host_Names=InputBox(message)
wmiQuery = "Select * From Win32_PingStatus Where " & _
"Address = '" & Host_Names & "'"
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objPing = objWMIService.ExecQuery(wmiQuery)
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
Msgbox Host_Names & " is Unreachable!"
Exit Sub
Else
tmp = InputBox("The IP Address is:",,objStatus.ProtocolAddress)
tmp = objStatus.ProtocolAddress
End If
Next
strIP = tmp
if strIP = "" then
Exit Sub
end if
Set objScriptExec = objShell.Exec("ping.exe -n 1 -a " & strIP)
strPingResult = objScriptExec.StdOut.ReadAll
Set objStdOut = objScriptExec.StdOut
strNoPing = "Request timed out."
arrayPingResult = split(strPingResult, vbcrlf)
strCheck = strComp(arrayPingResult(3), strNoPing, 1)
if strCheck = 1 then
Msgbox "PC not on the network. Quitting Program"
Exit Sub
else
arrayPCLine = split(arrayPingResult(1), " ")
tmp = InputBox("The fully qualified name is:",,arrayPCLine(1))
end if
End Sub
Thanks for any help you can give me.
The 'natural' GUI for VBScript is .HTA. As in:
<html>
<head>
<title>ClipBoard Demo</title>
<hta:application
id="demo"
></hta>
<script type="text/vbscript">
Option Explicit
Sub Window_OnLoad()
document.GetElementById("teIP").value = "1.2.3.4"
document.GetElementById("teNA").value = "HAL"
End Sub
Sub clpME(sTXT)
' MsgBox document.GetElementById(sTXT).value
window.clipboardData.setData "text", document.GetElementById(sTXT).value
End Sub
</script>
</head>
<body>
<form>
<input type="text" id="teIP">
<input type="button" onclick='clpME "teIP"' value="clp">
<br />
<input type="text" id="teNA">
<input type="button" onclick='clpME "teNA"' value="clp">
</form>
</body>
</html>
(More elaborate example, start here)
I'm not going to pretend this is pretty, but if you're looking for a quick and dirty solution, you can hijack the built-in buttons. I have seen this done before:
Dim msgboxResponse
msgboxResponse = MsgBox("Press: " & vbCrLf _
& "Yes to copy IP address" & vbCrLf _
& "No to copy FQDN" & vbCrLf _
& "Cancel to copy nothing", vbYesNoCancel)
Select Case msgboxResponse
Case vbYes: 'Code to copy IP to clipboard
Case vbNo: 'Code to copy FQDN
Case vbCancel: 'do nothing
Behold UX heaven:
End Select
While not evident, you can copy the content of any msgbox to clipboard just by pressing Ctrl-Ins, but the title and the buttons are also included.
You can just place the data in the clipboard using the clip.exe command line utility.
With WScript.CreateObject("WScript.Shell")
.Environment("PROCESS")("_toClip") = "Here, concatenate the variables to place in clipboard"
.Run "cmd /v /q /c ""echo(!_toClip!|clip""", 0, True
.Environment("PROCESS").Remove "_toClip"
End With
And, of course, instead of showing the two inputboxes, just concatenate the data and then show only one input box with all the required information.
I'm having an use where the <input type="file"> is locking the file for the ADODB.recordset.
If I hardcode the filepath the code runs without an issue however as soon as I browse using input type of file and select the hardcoded file it locks the file and I can no longer access it via the recordset.
I've tried just around everything I can think of without any success. I know its a result of the input browse function because if I select another file within the same directory or click the process button without browsing the code runs as it should.
Below is the relevant html and vbscript. Does anyone have any ideas on how to fix this?
<html>
<head>
<title>Employee Upload</title>
<HTA:APPLICATION
APPLICATIONNAME="Employee Upload"
ID="Employee Upload"
VERSION="1.0"/>
</head>
<body bgcolor="white">
<p id="heading" name="heading"><p>
<div id="container" name="container">
<span onClick="document.getElementById('myFile').click();" language="javascript" class="upload">
<button>Browse</button>
<input id="filename" type="text" disabled value="">
<input type="file" id="myFile" style="visibility:hidden;display:none;" onchange="document.getElementById('filename').value = this.value;document.getElementById('process').style.visibility = 'visible';" language="javascript">
</span>
<p>Click "Process File" once you have selected the file to upload the new hire data.</p>
<button id="process" name="process" onclick="loadFile()" style="/*visibility: hidden;*/">Process File</button>
</div>
<script language="vbscript">
Function loadFile()
On Error Resume Next
fileStr = document.all("filename").value
fileStr = "C:\Users\SeanW\Desktop\imports\NewHires.txt"
fileDir = Left(fileStr,InStrRev(fileStr,"\"))
filenameStr = Right(fileStr,Len(fileStr)-InStrRev(fileStr,"\"))
Set oConn = CreateObject("ADODB.Connection")
Set oRS = CreateObject("ADODB.Recordset")
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fileDir & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
oRS.Open "SELECT * FROM [" & filenameStr & "]", oConn, 3, 3, 1
If Err.Number <> 0 Then
MsgBox "Error Loading File: " & vbCrLf & vbCrLf & Err.Description,vbCritical,"File Load Error"
oConn.Close
oRS.Close
Set oConn = Nothing
Set oRs = Nothing
Err.Clear
Exit Function
else
Msgbox "File Loaded Successfully"
oConn.Close
oRS.Close
Set oConn = Nothing
Set oRs = Nothing
End If
End Function
</script>
</body>
</html>
I had exactly this problem today. I got around it by making a copy of the input file in a subfolder, then connecting to that with the ADODB.Connection
dim txtfile: txtfile = document.getElementById("filename").Value
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
dim tablename: tablename = fso.GetFileName(txtfile)
' we'll create the folder as a subfolder to the current one
dim currentfolder: currentfolder = fso.GetAbsolutePathName(".")
' create new paths until we have a new one
dim newpath: newpath = fso.BuildPath(currentfolder, fso.GetTempName())
do while fso.folderExists(newpath)
newpath = fso.BuildPath(currentfolder, fso.GetTempName())
loop
' create the folder & copy the input file
fso.createFolder newpath
fso.copyfile txtfile, fso.buildpath(newpath, tablename)
'connect and process
ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & newpath & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
ado.open
'... etc
' clear up the temp folder
fso.deleteFolder newpath, true
First off new here and programming in general. I am trying to build an hta that can load various vbs scripts from an outside folder to make it more modular. I am current getting stuck at trying to open the vbs from my dynamic list. How do I open the file in my dynamic list? And also how do I pass a variable to the file? This is what I currently have:
<html>
<head>
<title>My HTML application</title>
<HTA:APPLICATION
APPLICATIONNAME="My HTML application"
ID="MyHTMLapplication"
VERSION="1.0"/>
</head>
<script language="VBScript">
Sub Window_OnLoad
Dim FolderPath
'folder to be searched for files
Dim objFSO
Dim objFolder
Dim colFiles
Dim objFile
Dim objOption
FolderPath = "%PathToScripts%"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)
Set colFiles = objFolder.Files
For Each objFile in colFiles
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.Name
objOption.Value = objFile.Name
mylistbox.Add(objOption)
Next
End Sub
Sub RunProgram
Set objShell = CreateObject("Wscript.Shell")
objShell.Run objOption
End Sub
</script>
<body bgcolor="white">
<!--Add your controls here-->
<select name="mylistbox" size=10>
</select>
<input type="button" value="SingleSelect" onclick="RunProgram" name="RunScript">
<!--{{InsertControlsHere}}-Do not remove this line-->
</body>
</html>
Question 1: How do I open the file in my dynamic list?
First, you need to retrieve the selected value from your list. For single-selection lists, you can just query the Value property of the <select> element:
strFile = mylistbox.Value
Since nothing may be selected, it's always a good idea to test the result to make sure you got something:
If Len(strFile) > 0 Then
Also, it looks like you're just showing the file name in the list, not the file path, which is fine, but you'll need the full file path if you want to run the file later. So you have a couple of options, here. Option 1: Make FolderPath a global constant instead of a local variable so that you can access it from your RunProgram() routine. Option 2: Take advantage of the Value property of <option> elements to store the full path for each list item while still just displaying the file name. Here's how to do the latter:
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.Name
objOption.Value = objFile.Path ' Changed from objFile.Name to objFile.Path
mylistbox.Add(objOption)
Next
Now that you have the full path to your script, you can run it. This is what your RunProgram() routine could look like:
Sub RunProgram()
' Get the selected value. This will be a full file path.
strFile = mylistbox.Value
' Make sure something was selected.
If Len(strFile) > 0 Then
' Run the script file.
Set objShell = CreateObject("WScript.Shell")
objShell.Run Chr(34) & strFile & Chr(34)
End If
End Sub
Note: Chr(34) is used to add double quotes around the file name in case it contains spaces.
Question 2: How do I pass a variable to the file?
This is where things get a little trickier. Though you can run a VBScript directly using the Shell.Run command (as we did above), if you want to pass an argument to the script, you need to run it explicitly using one of the scripting engine executables.
objShell.Run "wscript.exe " & Chr(34) & strFile & Chr(34) & " " & Chr(34) & strParam & Chr(34)
Here, we're using wscript.exe (the "GUI" version of the Windows Scripting Host) to explicitly run our script file. We're surrounding our file with double quotes, as we did above. And, finally, we're adding a space to separate the "command" from the parameter. For completeness, we're also adding double quotes around the parameter in case it contains spaces as well.