Improved logic and features and also added error handling.
I have tested it on three domain environments and yes it works well, except when you hit a machine on a slow link it slows right down.
I recon I could boost it's speed by examining directory listings from robocopy instead of FSO line by line. Maybe next witch hunt.
'Script by Tomriddle 2010
'WitchHunt.vbs
'Tested on XP.
'Script Scans "Recent Documents" folder on all workstations searching for a particular string. (partial or whole file name)
'Script returns output in a tab separated file.
'From this log you can see which user opened file, from what computer, the path to the file and the date it was accessed
'Which, What, Where, When - sorry can't do "why"
forceUseCScript
dim strTemp, strcheckFile
searchStr="secret.doc" '(not case sensitive)
checkFile="checked.txt" '(list of computers successfully scanned)
reportFile="output.txt" '(results saved to this log file)
'load list of pcs that have already been checked.
markedChecked " ", checkFile
set objFSO = CreateObject("Scripting.FileSystemObject")
set readfile = objFSO.OpenTextFile(checkFile, 1, false)
strcheckFile = readfile.ReadAll
readfile.close
'get current domain name
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain= objRootDSE.Get("defaultNamingContext")
reportFile=strDomain&reportFile
'Enumerate All Computer Accounts in Active Directory
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = "Select Name, DistinguishedName, Location from 'LDAP://"&strDomain&"' Where objectClass='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strComputer = objRecordSet.Fields("Name").Value
computerDN=objRecordSet.Fields("DistinguishedName").Value
objRecordSet.MoveNext
if instr(lcase(computerDN), "trash")=0 then
if checkChecked(strComputer) = false then
if reachable(strComputer) then
wscript.echo "online- "&strComputer
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "\\"&strComputer&"\c$\Documents and Settings\" '
on error resume next
SearchSubfolders objFSO.GetFolder(objStartFolder)
if err<>0 then
wscript.echo "error accessing "&strComputer
else
markedChecked strComputer, checkFile
end if
on error goto 0
if len(strTemp)>0 then
WriteLog strTemp, reportFile
strTemp=""
else
'wscript.echo "No File "&strComputer
end if
else
wscript.echo "Offline "&strComputer
end if
else
wscript.echo "Skipping "&strComputer
end if
end if
Loop
'-----------------------------------------------------------
function getLnkTarget(strLnkPath)
'read shortcut properties and return target path
'
http://www.tek-tips.com/viewthread.cfm?qid=850335 Set Shell = CreateObject("WScript.Shell")
Set link = Shell.CreateShortcut(strLnkPath)
getLnkTarget=link.TargetPath
set link=nothing
end function
'-----------------------------------------------------------
Sub SearchSubfolders(Folder)
'Return full path of lnk file found (shows computer and user) + target of lnk file
For Each Subfolder in Folder.SubFolders
if instr(lcase(subfolder),lcase("Recent"))<>0 then
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
if instr(lcase(objFile.Name), lcase(searchStr))>0 then
strTemp=strTemp & objFolder.Path&"\"&objFile.Name &vbtab& getLnkTarget(objFolder.Path&"\"&objFile.Name) &vbtab& modifiedTime(objFolder.Path&"\"&objFile.Name) &vbcrlf
end if
Next
end if
'speed up search by skipping irrelevant folders.
chkSlash=replace(lcase(subfolder), lcase(objStartFolder), "")
countSl=0
for a=1 to len(chkSlash)
if mid(chkSlash, a,1)="\" then countSl=countSL+1
next
if (countSl=1 and instr(lcase(subfolder),lcase("Recent"))>0) or countSl=0 then
if instr(lcase(subfolder),lcase("Recent"))>0 then
wscript.echo "Searching "&subfolder
end if
SearchSubfolders Subfolder
else
'wscript.echo "Skipping "&subfolder
end if
Next
End Sub
'-----------------------------------------------------------
function checkChecked(strComputer)
'check if this computer has already been checked so that it can be skipped
if instr(strcheckFile, strComputer)>0 then
checkChecked=true
else
checkChecked=false
end if
end function
'-----------------------------------------------------------
function markedChecked(strComputer, checkFile)
'write the computer name to the checked file so it can be skipped in future scans
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.OpenTextFile(checkFile, 8, True).WriteLine strComputer
end function
'-----------------------------------------------------------
function WriteLog(result, reportFile)
'same as markedChecked function
'write list of files found to output file
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.OpenTextFile(reportFile, 8, True).WriteLine result
end function
'-----------------------------------------------------------
function reachable(strComputer)
'Ping remote machine function for script robustness
on error resume next
Dim wmiQuery : wmiQuery = "Select * From Win32_PingStatus Where Address = '" & strComputer & "'"
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Dim objPing : Set objPing = objWMIService.ExecQuery(wmiQuery)
Dim objStatus
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
Reachable = false
Else
Reachable = true
End if
Next
if err<>0 then Reachable = false
end function
'-----------------------------------------------------------
Sub forceUseCScript()
'make script run in cscript mode so that you get see progress
Set oShell = CreateObject("Wscript.Shell")
If Not WScript.FullName = WScript.Path & "\cscript.exe" Then
oShell.Run "cmd.exe /k " & WScript.Path & "\cscript.exe //NOLOGO " & Chr(34) & WScript.scriptFullName & Chr(34),1,False
WScript.Quit 0
End If
End Sub
'-----------------------------------------------------------
Function modifiedTime(strPath)
'return the time the file was modified
'(this is when the recent doc was last accessed)
On Error Resume Next
Set objFSO2=CreateObject("Scripting.FileSystemObject")
Set objFile2=objFSO2.GetFile(strPath)
If Err<>0 Then
modifiedTime=Null
Else
modifiedTime=CDate(objFile2.DateLastModified)
End If
Set objFile2=Nothing
Set objFSO2=Nothing
On Error GoTo 0
End Function
'-----------------------------------------------------------
<message edited by TomRiddle on Tuesday, March 30, 2010 11:58 AM>