Vista - search all files for a pattern

I need to search the contents of all files (txt, xls, doc, pdf, etc)
on some large file shares for specific patterns (ssn, etc.). Is this
possible to do from vbscript? Anyone have any examples on how to do
this?

Thanks

"Dan Lewis" <waynelewis@xxxxxx> wrote in message
news:15793fa8-db0f-443d-829b-bc7c01eb4b5b@xxxxxxYou could use the script below. It will locate the specified text string
both in text and in binary files. It will also find strings that are stored
in unicode (rather than in ASCII), something that I have not been able
to do consistently with the inbuilt Windows search tool.

You may need to modify the output format to suit your specific
requirements.

If you're reluctant to remove the line numbers manually then you
can download the file from the link below for a short while:
http://www.hotlinkfiles.com/files/1685247_z38bi/ts.vbs

001. '--------------------
002. 'Text search utility
003. '16.2.2008 FNL
004. '--------------------
005. Option Explicit
006.
007. Const ScreenSize = 40
008. Const ForReading = 1
009. Const Unicode = -1
010. Const ASCII = 0
011. Const Locked = 0 'Indicates a file that cannot be opened
012. Const None = 1 'String not found in file
013. Const Some = 2 'Some strings found in file
014.
015. Dim objFile, objArgs, objFSO, ObjShell, objRegEx
016. Dim FileSpec, SearchString, Hit, TempFile
017. Dim CaseSensitive, Pause, SubDir, LineCount, StringsFound
018. Dim FileScanned, FileCount, HitCount
019.
020. Set objArgs = WScript.Arguments
021. Set objFSO = CreateObject("Scripting.FileSystemObject")
022. Set ObjShell = CreateObject("WScript.Shell")
023. Set objRegEx = CreateObject("VBScript.RegExp")
024.
025. objRegEx.Global = True
026. objRegEx.Pattern = "[" & Chr(0) & "-" & Chr(31) & "," & Chr(149) & "]"
027. TempFile = ObjShell.Environment("PROCESS")("Temp") & "\TSS.tmp"
028. LineCount = 0 'No. of screen lines
029. FileScanned = 0 'No. of matching files
030. HitCount = 0 'No. of strings found
031. FileCount = 0 'No. of files containing the string
032.
033. ProcessParms FileSpec, SearchString
034. ProcessFiles FileSpec
035. Summary
036.
037. '-------------------------------
038. 'Compile a list of files to scan
039. '-------------------------------
040. Sub ProcessFiles(FSpec)
041. Dim Switches, Folder, FileList, FileName, FileArray, objExec, Line
042. Dim F, i, p, q
043. Dim CRLF: CRLF = Chr(13) & Chr(10)
044. Dim DQ : DQ = """"
045.
046. Switches = "/a-d /b /On "
047. If SubDir Then
048. Switches = Switches & "/s "
049. Folder = ""
050. Else
051. p = InStrRev(FSpec, "\") 'The "dir" command does not return
052. q = InStrRev(FSpec, ":") 'the folder name unless the /s switch
053. if q > p then p = q 'is present.
054. Folder = Left(FSpec, p) 'Extract the folder name from the user's
file spec
055. End If
056.
057. 'Use the DIR command to compile a list of files to be scanned
058. 'Can't use the EXEC method - it won't process Unicode output properly.
059. 'Unicode is needed to process foreign-language file names.
060. ObjShell.Run "%ComSpec% /U /c dir " & Switches & DQ & FSpec & DQ _
061. & " > " & DQ & TempFile & DQ, 0, True
062.
063. If objFSO.GetFile(TempFile).Size = 0 Then
064. WScript.Echo "No matching files found"
065. WScript.quit
066. End If
067.
068. Set F = objFSO.OpenTextFile(TempFile, 1, False, True)
069. FileList = F.Read(objFSO.GetFile(TempFile).Size) 'Read the file list
into memory
070. F.Close
071. objFSO.DeleteFile TempFile, 1
072. FileArray = Split(FileList, CRLF)
073.
074. Hit = False 'Indicates that the string was found in the current
075. 'lot of screen output lines
076.
077. For i = 0 To UBound(FileArray)
078. if FileArray(i) <> "" then Scan Folder & FileArray(i)
079. Next
080. End Sub
081. '----------------------------------------
082. 'Invoke the ASCII and the Unicode scanner
083. '----------------------------------------
084. Sub Scan (FName)
085. Dim H
086.
087. ScreenWrite "Scanning ", FName, True
088. Set objFile = objFSO.GetFile(FName)
089. StringsFound = None
090. H = HitCount
091. If Show(FName, ASCII) <> Locked then Call Show(FName, Unicode)
092. if HitCount <> H then FileCount = FileCount + 1
093. FileScanned = FileScanned + 1
094. End Sub
095. '---------------------------------
096. 'Scan one file in ASCII or Unicode
097. '---------------------------------
098. Function Show (FName, mode)
099. Dim objData, Line, offset, LongString, M
100. Dim i, s, p, q, D
101. D = ": "
102. if mode = Unicode then D = "- "
103.
104. On Error Resume Next
105. Set objData = objFile.OpenAsTextStream(ForReading, mode)
106. If Err > 0 Then
107. WScript.Echo Err.Description
108. Show = Locked
109. Exit Function
110. End If
111. On Error Goto 0
112.
113. s = objFile.Size
114. if (s < 2) and (mode = unicode) then Exit Function 'Can't scan
single-byte files in Unicode mode!
115. if CaseSensitive then M = 0 Else M = 1
116. LongString = objData.Read(s) 'Read the whole file into LongString
117. p = InStr(1, LongString, SearchString, M) 'Search the string
118.
119. While p > 0
120. HitCount = HitCount + 1
121. Hit = True 'Indicates "string found" (used in screen output)
122. StringsFound = Some
123. q = p - 10
124. if q < 1 then q = 1
125. Line = D & Mid(LongString, q, 65) 'Take 65 chars, including 10
before
126. Line = objRegEx.Replace(Line, "·") 'Replace hex chars with dots
127. offset = p
128. if mode = Unicode then offset = 2 * p
129.
130. WScript.Echo Format(offset) & Line
131. ScreenWrite "Continuing with ", FName, False
132. p = InStr(p+1, LongString, SearchString, M)
133. Wend
134. Show = StringsFound
135. End Function
136. '------------------------------------
137. 'Pad the file offset to 12 characters
138. '------------------------------------
139. Function Format (n)
140. Format = Right(" " & FormatNumber(n, 0, 0, True), 12)
141. End Function
142. '-----------------------------------
143. 'Process the command line parameters
144. '-----------------------------------
145. Sub ProcessParms(FSpec, SString)
146. Dim Parm, i
147.
148. CaseSensitive = 0
149. Pause = True
150. SubDir = False
151.
152. if objArgs.Count < 2 then Help "Error: Insufficient number of
parameters"
153. FSpec = objArgs(0)
154.
155. For i = 1 To objArgs.Count - 1
156. Parm = objArgs(i)
157. if UCase(parm) = "/C" Then CaseSensitive = 1
158. if UCase(parm) = "/S" then SubDir = True
159. if (parm = "/?") or (parm = "-?") or (parm = "?") then Help ""
160. if left(parm,1) <> "/" then SString = Parm
161. Next
162. If Len(SString) > 50 Then Help "Error: The maximum length of the
search string is 50 characters."
163. If Len(SString) = 0 Then Help "Error: No search string specified"
164. End Sub
165. '----------------------------------
166. 'Keep track of the screen lines and
167. 'create a pause every 30 lines
168. '----------------------------------
169. Sub ScreenWrite(Action, FName, mode)
170. Dim Input
171.
172. if hit then LineCount = LineCount + 1
173. If (LineCount > ScreenSize) And Pause Then
174. WScript.Echo "Press Enter . . ."
175. Input = WScript.StdIn.ReadLine
176. LineCount = 1
177. mode = True
178. Hit = False
179. End If
180. If mode = True Then
181. If Len(Action & FName) <= 79 Then
182. WScript.Echo Action & FName
183. Else
184. WScript.Echo Action & "···" & Right(FName, 76 - Len(Action))
185. End If
186. End If
187. End Sub
188. '--------------------
189. 'Help
190. '--------------------
191. Sub Help (L)
192. WScript.Echo
193. WScript.Echo "File search tool"
194. WScript.Echo
195. WScript.Echo "Usage: TSS FileSpec SearchString [/S] [/C]"
196. WScript.Echo " (/S: process subdirectories)"
197. WScript.Echo " (/C: make search case sensitive)"
198. WScript.Echo
199. WScript.Echo "Output is formatted as follows:"
200. WScript.Echo "File offset: string found in file (colon indicates ASCII
string)"
201. WScript.Echo "File offset- string found in file (dash indicates
Unicode string)"
202. WScript.Echo
203. WScript.Echo "Non-ASCII characters are shown as dots (··)"
204. If L <> "" Then WScript.Echo : WScript.Echo L
205. WScript.Quit
206. End Sub
207. Sub Summary
208. Dim Line
209. Dim LF: LF = Chr(10)
210.
211. Line = LF & Plural(FileScanned, " file") & " scanned" & LF
212. If HitCount = 0 Then
213. Line = Line & "string """ & SearchString & """ not found."
214. Else
215. Line = Line & Plural(HitCount, " string") & " found in " _
216. & Plural(FileCount, " file") & "."
217. End If
218. WScript.Echo Line
219. End Sub
220. '------------------------------------
221. 'Form the plural for the final report
222. '------------------------------------
223. Function Plural(n, s)
224. Plural = n & s
225. if n <> 1 then Plural = n & s & "s"
226. End Function
227. Sub Display(Line)
228. Dim i, out
229. out = ""
230. For i = 1 To Len(line)
231. out = out & Asc(Mid(line, i, 1)) & " "
232. Next
233. WScript.Echo out
234. End Sub

Hello Pegasus,

This is the first time I used to news group so I clicked on the wrong
button and it send my question to your e-mail instead of posting here.
I'm sorry.
To repeat, I search this news group and found your script used to
search for a string in text or binary files. I just modified to make
it run in wscript by double click instead of command line.
I like to modified three things: prompt for file spec, prompt for a
string, and write the result to a text file with date as the filename.
With my beginner knowledge of scripting, I only could modify the first
two items. I could not find a way to make the script write the results
to a text file instead of poping up on the screen one by one.
I put the script that creates the text file before all of the subs or
functions and it created the file as expected.
However, I could not put the script that write the results where you
put the echo statements because it said the variables are not defined.
I hope you can help with your expertise.

Thanks,

Here is your script with the modifications I made:

'--------------------
'Text search utility
'16.2.2008 FNL
'--------------------
Option Explicit

Const ScreenSize = 40
Const ForReading = 1
Const Unicode = -1
Const ASCII = 0
Const Locked = 0 'Indicates a file that cannot be opened
Const None = 1 'String not found in file
Const Some = 2 'Some strings found in file

Dim objFile, objArgs, objFSO, ObjShell, objRegEx
Dim FileSpec, SearchString, Hit, TempFile
Dim CaseSensitive, Pause, SubDir, LineCount, StringsFound
Dim FileScanned, FileCount, HitCount
Dim dt, resultFileName, objFilew

Set objArgs = WScript.Arguments
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ObjShell = CreateObject("WScript.Shell")
Set objRegEx = CreateObject("VBScript.RegExp")

objRegEx.Global = True
objRegEx.Pattern = "[" & Chr(0) & "-" & Chr(31) & "," & Chr(149) &
"]"
TempFile = ObjShell.Environment("PROCESS")("Temp") & "\TSS.tmp"
LineCount = 0 'No. of screen lines
FileScanned = 0 'No. of matching files
HitCount = 0 'No. of strings found
FileCount = 0 'No. of files containing the string

'Start create text file with search results
dt = Replace(Date,"/","-")
resultFileName = "D:\Download\VBScripts\" & dt & "-search.txt"
Set objFilew = objFSO.CreateTextFile(resultFileName)

ProcessParms FileSpec, SearchString
ProcessFiles FileSpec
Summary

'-------------------------------
'Compile a list of files to scan
'-------------------------------
Sub ProcessFiles(FSpec)
Dim Switches, Folder, FileList, FileName, FileArray, objExec, Line
Dim F, i, p, q
Dim CRLF: CRLF = Chr(13) & Chr(10)
Dim DQ : DQ = """"

Switches = "/a-d /b /On "
If SubDir Then
Switches = Switches & "/s "
Folder = ""
Else
p = InStrRev(FSpec, "\") 'The "dir" command does not return
q = InStrRev(FSpec, ":") 'the folder name unless the /s switch
if q > p then p = q 'is present.
Folder = Left(FSpec, p) 'Extract the folder name from the user's
file spec
End If

'Use the DIR command to compile a list of files to be scanned
'Can't use the EXEC method - it won't process Unicode output
properly.
'Unicode is needed to process foreign-language file names.
ObjShell.Run "%ComSpec% /U /c dir " & Switches & DQ & FSpec & DQ _
& " > " & DQ & TempFile & DQ, 0, True

If objFSO.GetFile(TempFile).Size = 0 Then
WScript.Echo "No matching files found"
WScript.quit
End If

Set F = objFSO.OpenTextFile(TempFile, 1, False, True)
FileList = F.Read(objFSO.GetFile(TempFile).Size) 'Read the file list
into memory
F.Close
objFSO.DeleteFile TempFile, 1
FileArray = Split(FileList, CRLF)

Hit = False 'Indicates that the string was found in the current
'lot of screen output lines

For i = 0 To UBound(FileArray)
if FileArray(i) <> "" then Scan Folder & FileArray(i)
Next
End Sub
'----------------------------------------
'Invoke the ASCII and the Unicode scanner
'----------------------------------------
Sub Scan (FName)
Dim H

ScreenWrite "Scanning ", FName, True
Set objFile = objFSO.GetFile(FName)
StringsFound = None
H = HitCount
If Show(FName, ASCII) <> Locked then Call Show(FName, Unicode)
if HitCount <> H then FileCount = FileCount + 1
FileScanned = FileScanned + 1
End Sub
'---------------------------------
'Scan one file in ASCII or Unicode
'---------------------------------
Function Show (FName, mode)
Dim objData, Line, offset, LongString, M
Dim i, s, p, q, D
D = ": "
if mode = Unicode then D = "- "

On Error Resume Next
Set objData = objFile.OpenAsTextStream(ForReading, mode)
If Err > 0 Then
WScript.Echo Err.Description
Show = Locked
Exit Function
End If
On Error Goto 0

s = objFile.Size
if (s < 2) and (mode = unicode) then Exit Function 'Can't scan single-
byte files in Unicode mode!
if CaseSensitive then M = 0 Else M = 1
LongString = objData.Read(s) 'Read the whole file into
LongString
p = InStr(1, LongString, SearchString, M) 'Search the string

While p > 0
HitCount = HitCount + 1
Hit = True 'Indicates "string found" (used in screen output)
StringsFound = Some
q = p - 10
if q < 1 then q = 1
Line = D & Mid(LongString, q, 65) 'Take 65 chars, including 10
before
Line = objRegEx.Replace(Line, "·") 'Replace hex chars with dots
offset = p
if mode = Unicode then offset = 2 * p

WScript.Echo Format(offset) & Line
ScreenWrite "Continuing with ", FName, False
p = InStr(p+1, LongString, SearchString, M)
Wend
Show = StringsFound
End Function
'------------------------------------
'Pad the file offset to 12 characters
'------------------------------------
Function Format (n)
Format = Right(" " & FormatNumber(n, 0, 0, True), 12)
End Function
'-----------------------------------
'Process the command line parameters
'-----------------------------------
Sub ProcessParms(FSpec, SString)
Dim Parm, i

CaseSensitive = 0
Pause = True
SubDir = False

If objArgs.Count < 0 then Help "Error: Insufficient number of
parameters"
FSpec = InputBox ("Please enter the type of files to search, eg,
*.doc: ", "File type to search", "*.doc")'objArgs(0)
SString = InputBox ("Please enter the string to search, eg, Latitude:
", "String to search", "Latitude")
'For i = 1 To objArgs.Count - 1
'Parm = objArgs(i)
'If UCase(parm) = "/C" Then CaseSensitive = 1
'If UCase(parm) = "/S" then SubDir = True
'If (parm = "/?") or (parm = "-?") or (parm = "?") then Help ""
'If left(parm,1) <> "/" then SString = Parm
'Next
If Len(SString) > 50 Then Help "Error: The maximum length of the
search string is 50 characters."
If Len(SString) = 0 Then Help "Error: No search string specified"
End Sub
'----------------------------------
'Keep track of the screen lines and
'create a pause every 30 lines
'----------------------------------
Sub ScreenWrite(Action, FName, mode)
Dim Input

if hit then LineCount = LineCount + 1
If (LineCount > ScreenSize) And Pause Then
WScript.Echo "Press Enter . . ."
Input = WScript.StdIn.ReadLine
LineCount = 1
mode = True
Hit = False
End If
If mode = True Then
If Len(Action & FName) <= 79 Then
WScript.Echo Action & FName
Else
WScript.Echo Action & "···" & Right(FName, 76 - Len(Action))
End If
End If
End Sub
'--------------------
'Help
'--------------------
Sub Help (L)
WScript.Echo
WScript.Echo "File search tool"
WScript.Echo
WScript.Echo "Usage: TSS FileSpec SearchString [/S] [/C]"
WScript.Echo "eg. enter the following at the command line without
quotes TSS *.doc Summa"
WScript.Echo " (/S: process subdirectories)"
WScript.Echo " (/C: make search case sensitive)"
WScript.Echo
WScript.Echo "Output is formatted as follows:"
WScript.Echo "File offset: string found in file (colon indicates ASCII
string)"
WScript.Echo "File offset- string found in file (dash indicates
Unicode string)"
WScript.Echo
WScript.Echo "Non-ASCII characters are shown as dots (··)"
If L <> "" Then WScript.Echo : WScript.Echo L
WScript.Quit
End Sub
Sub Summary
Dim Line
Dim LF: LF = Chr(10)

Line = LF & Plural(FileScanned, " file") & " scanned" & LF
If HitCount = 0 Then
Line = Line & "string """ & SearchString & """ not found."
Else
Line = Line & Plural(HitCount, " string") & " found in " _
& Plural(FileCount, " file") & "."
End If
WScript.Echo Line
End Sub
'------------------------------------
'Form the plural for the final report
'------------------------------------
Function Plural(n, s)
Plural = n & s
if n <> 1 then Plural = n & s & "s"
End Function
Sub Display(Line)
Dim i, out
out = ""
For i = 1 To Len(line)
out = out & Asc(Mid(line, i, 1)) & " "
Next
WScript.Echo out
End Sub