Monitor user activity - secretly! 3

moolie · Sep 28, 2004

I recieved an odd request from management to monitor an employees usage on his machine. They want to know what he is doing all day long... Is he working or surfing all day? Any suggestions on how to go about this?

2003 standard and enterprise network. No exchange server.
Basically need to monitor his web traffic, e-mail usage as well as application usage times etc.

markdmac · Sep 28, 2004

Do you have a proxy server or firewall that keeps a log? If so you could check there.

If not, then give this a try:

Save this code to a text file and call it IESPY.HTM. Then open it on the users machine for a most interesting report.

Code:

<HTML><HEAD><TITLE>IE Spy - by Vengy</TITLE></HEAD><pre>

<script language="VBScript" TYPE="text/vbscript">

' ======================== Let The Games Begin! ========================
' Contact Info
' ------------
' Author: Vengy
' Email : cyber_flash@hotmail.com

' How it works
' ------------
' INDEX.DAT files keep a list of websites you have visited, cookies received and files opened/downloaded.
' As a result anyone can find out what you have been doing on the Internet!
'
' This program scans all history index files looking for any HTTP:// or FILE:// entries.
' If found, they're stored in a file called C:\SPY.HTM along with the user.

' Aside: This program invokes a local windows program called FIND.EXE to
' parse the index.dat files. (I was too lazy to code it myself. ;)

' Have Fun! (-_-)


' ======================== The Banner ========================
document.writeln "INDEX.DAT files keep a list of websites you have visited, cookies received and files opened/downloaded."
document.writeln "As a result anyone can find out what you have been doing on the Internet!"+VBNewLine
document.writeln "This program scans all history index files looking for any HTTP:// or FILE:// entries."
document.writeln "If found, the User/URL's are stored in a file called C:\SPY.HTM."+VBNewLine


' ======================== ActiveX Warning ========================
MsgBox "NOTE: Please click 'Yes' if prompted with the following message:"+VBNewLine+VBNewLine+"An ActiveX control on this page might be unsafe to"+VBNewLine+"interact with other parts of the page. Do you want to"+VBNewLine+"allow this interaction?"+VBNewLine+VBNewLine+"Click OK to start Spy scan ...",vbOKOnly,"Welcome"


' ======================== Setup Objects ========================
Dim oFSO     : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim arrFiles : arrFiles=Array()
Dim oWShell  : Set oWShell = CreateObject("WScript.Shell")


' ======================== Locate Index.Dat Folder ========================
' ---> WINXP/2K
If oFSO.FolderExists("C:\Documents and Settings\") Then
  index_folder = "C:\Documents and Settings"
' ---> WIN9X
Elseif oFSO.FolderExists("C:\windows\") Then
  index_folder = "C:\windows"
' ---> Browse For Folder
Else
  index_folder = fnGetMyPathVB
End If


' ======================== Start Spy Scan ========================
If index_folder="None" Then
  MsgBox "No Specified Folder. Scan Aborted."
Else
  Set oStartDir = oFSO.GetFolder(index_folder)
  sFileRegExPattern = "\index.dat$"
  RecurseFilesAndFolders oStartDir, sFileRegExPattern
  DisplayResults
End If


' ======================== Find ALL Index.Dat Files ========================
Sub RecurseFilesAndFolders(oRoot, sFileEval)
    Dim oSubFolder, oFile, oRegExp
    Set oRegExp = New RegExp
    oRegExp.IgnoreCase = True

    window.status="Scanning: "+oRoot

    If Not (sFileEval = "") Then
      oRegExp.Pattern = sFileEval
      For Each oFile in oRoot.Files
        If (oRegExp.Test(oFile.Name)) Then
          If (InStr(oFile.Path,"History.IE")<>0) Then
            ReDim Preserve arrFiles(UBound(arrFiles) + 1)
            arrFiles(UBound(arrFiles)) = oFile.Path
          End If
        End If
      Next
    End If

    For Each oSubFolder In oRoot.SubFolders
      RecurseFilesAndFolders oSubFolder, sFileEval
    Next
End Sub


' ======================== Display Results ========================
Sub DisplayResults()

    Dim sReadLine, sArray, start, count,ub
    Const ForReading = 1

    Window.status="Scanning ..."

    Set oTextStream = oFSO.CreateTextFile("C:\spy.bat")
    oTextStream.Write "echo off"+VBNewLine

    count=0
    ub=UBound(arrFiles)
    For Each elem In arrFiles
      count=count+1
      document.writeln elem
      oTextStream.Write "echo Remaining Scans: "+CStr(ub+1-count)+VBNewLine
      oTextStream.Write "find "+chr(34)+"[URL unfurl="true"]http://"+chr(34)+"[/URL] "+chr(34)+elem+chr(34)+" >>c:\spy.txt"+VBNewLine
      oTextStream.Write "find "+chr(34)+"file://"+chr(34)+" "+chr(34)+elem+chr(34)+" >>c:\spy.txt"+VBNewLine
    Next

    oTextStream.Close

    If count=0 Then
      Window.status="Aborted."
      MsgBox "No Index.dat files found. Scan Aborted."
      Exit Sub
    End If

    oWShell.Run "c:\spy.bat", , True

    oFSO.DeleteFile "C:\spy.bat"

    If oFSO.FileExists("C:\spy.htm") Then
      oFSO.DeleteFile "C:\spy.htm"
    End If

    Set oTextStream = oFSO.CreateTextFile("C:\spy.htm")
    Set oFilein = oFSO.OpenTextFile("c:\spy.txt",ForReading)

    oTextStream.Writeline "<html><title>IE is spying on you!</title><body><b>Welcome</b><br><font size=2>"

    Do While Not oFilein.AtEndOfStream
      sReadLine = oFilein.ReadLine
      start = Instr(sReadLine,": ")
      If start <> 0 Then
        sReadLine = Mid(sReadLine,start+2)
        sArray = Split(sReadLine,"@")
        oTextStream.Write sArray(0)                                          ' User
        oTextStream.Writeline " <a href="+sArray(1)+">"+sArray(1)+"</a><br>" ' Visited URL
      End If
    loop

    oTextStream.Writeline "</font><b>End of Report</b></body></html>"

    oFilein.Close
    oTextStream.Close

    oFSO.DeleteFile "C:\spy.txt"

    Window.status="Done"
    document.writeln "<b>Scan Completed.</b>"
    MsgBox "Please check C:\SPY.HTM for details. Thanks!",0,"Spy Scan Completed."
    oWShell.Run "C:\PROGRA~1\INTERN~1\IEXPLORE.EXE C:\SPY.HTM"

End Sub


' ======================== Specify Custom Index.dat Folder ========================
function fnGetMyPathVB()
    dim oShell
    dim oFolder
    dim oFolderItem

    set oShell = CreateObject("Shell.Application")
    set oFolder = oShell.BrowseForFolder(0, "Choose a Folder", 0)

    If oFolder is nothing Then
      fnGetMyPathVB = "None"
    Else
      set oFolderItem = oFolder.Items.Item
      fnGetMyPathVB = oFolderItem.Path
    End If
end function


' ======================== End Of VBscript ========================
</script>

</pre></HTML>

I hope you find this post helpful. Please let me know if it was.

Regards,

Mark

moolie · Sep 29, 2004

Wow. That is very cool page! Works very very well. Shows IE history with lots of details.

moolie · Sep 29, 2004

I ran it again just now after I emptied the temp folders of history, cookies, files etc. and it stil found 20 page listings.

markdmac · Sep 29, 2004

Scary huh?

I hope you find this post helpful. Please let me know if it was.

Regards,

Mark

muddyjohn · Sep 29, 2004

Marc that is a way cool tool! thanks for this tool!!!

Hold on! This could Hurt! I ain't certified by Microsoft!

Thanks

tfg13 · Sep 29, 2004

Great code Mark!!!!Your star is on the way.

tfg13 · Sep 29, 2004

Here is the other side of the coin (removes all of the entries Mark's finds):

<code>
' +----------------------------------------------------------------------------+
' | Contact Info |
' +----------------------------------------------------------------------------+
' Author: Vengy
' Email : cyber_flash@hotmail.com
' Tested: win2K/XP

' +----------------------------------------------------------------------------+
' | Let The Games Begin! |
' +----------------------------------------------------------------------------+
' INDEX.DAT files keep a list of websites you have visited, cookies received and files opened/downloaded.
' As a result anyone can find out what you have been doing on the Internet!

' This program scans all History index files only (not cookies or temporary internet files)
' looking for any protocol :// entries. If found, they're stored in a file called c:\spy.htm.

' When the scan completes, you will have the option to remove specific IE history files!

' Aside: This program invokes a local windows program called FIND.EXE to
' parse the index.dat files. (I was too lazy to code it myself.

' Have Fun! (-_-)

' +----------------------------------------------------------------------------+
' | Ensure that all variable names are defined! |
' +----------------------------------------------------------------------------+
Option Explicit

' +----------------------------------------------------------------------------+
' | Setup constants |
' +----------------------------------------------------------------------------+
Const conBarSpeed=80
Const conForcedTimeOut=3600000 ' 1 hour

' +----------------------------------------------------------------------------+
' | Setup Objects and misc variables |
' +----------------------------------------------------------------------------+
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oWShell : Set oWShell = CreateObject("WScript.Shell")
Dim objNet : Set objNet = CreateObject("WScript.Network")
Dim Env : Set Env = oWShell.Environment("SYSTEM")
Dim arrFiles : arrFiles = Array()
Dim objIE
Dim objProgressBar
Dim objTextLine1
Dim objTextLine2
Dim objQuitFlag
Dim spyPath
Dim index

' +----------------------------------------------------------------------------+
' | Determine OS type. Must be Windows_NT (windows XP/2K/2K3) |
' +----------------------------------------------------------------------------+
If StrComp(Env("OS"),"Windows_NT",VBTextCompare) <> 0 Then
WScript.Echo "This script supports only Windows NT." & vbNewLine & "Exiting..."
CleanupQuit
End If

' +----------------------------------------------------------------------------+
' | Set file spy path = c:\spy.htm |
' +----------------------------------------------------------------------------+
spyPath="c:\spy.htm"

' +----------------------------------------------------------------------------+
' | Whose been a naughty surfer? Let's find out!

|
' +----------------------------------------------------------------------------+
StartSpyScan

' +----------------------------------------------------------------------------+
' | Outta here ... |
' +----------------------------------------------------------------------------+
CleanupQuit

' +----------------------------------------------------------------------------+
' | Cleanup and Quit |
' +----------------------------------------------------------------------------+
Sub CleanupQuit()
Set oFSO = Nothing
Set oWShell = Nothing
Set objNet = Nothing
WScript.Quit
End Sub

' +----------------------------------------------------------------------------+
' | Start Spy Scan |
' +----------------------------------------------------------------------------+
Sub StartSpyScan()
Dim index_folder, history_folder, oSubFolder, oStartDir, sFileRegExPattern, user

index_folder=LocateIndexFolder()

If index_folder="None" Then
MsgBox "No folder specified. Scan Aborted."
Else

StartIE "IE Spy"
SetLine1 "Locating history files:"

sFileRegExPattern = "\index.dat$"
Set oStartDir = oFSO.GetFolder(index_folder)

For Each oSubFolder In oStartDir.SubFolders
history_folder=oSubFolder.Path&"\Local Settings\History\History.IE5"
If oFSO.FolderExists(history_folder) Then

If IsQuit()=True Then
CloseIE
CleanupQuit
End If

user = split(history_folder,"\")
SetLine2 user(2)

Set oStartDir = oFSO.GetFolder(history_folder)
RecurseFilesAndFolders oStartDir, sFileRegExPattern
End If
Next

' Index flag to determine if at least one index.dat file exists.
If IsEmpty(index) Then
CloseIE
MsgBox "No Index.dat files found. Scan Aborted."
Else
CreateSpyTmpFile
CreateSpyHtmFile
CloseIE
RunSpyHtmFile
DeleteIndexFiles
End If

End If
End Sub

' +----------------------------------------------------------------------------+
' | Locate Index.Dat Folder |
' +----------------------------------------------------------------------------+
Function LocateIndexFolder()
' WINXP/2K
If oFSO.FolderExists("c:\Documents and Settings") Then
LocateIndexFolder = "c:\Documents and Settings"

' Browse For Folder
Else
LocateIndexFolder = fnGetMyPathVB
End If
End Function

' +----------------------------------------------------------------------------+
' | Specify Custom Index.dat Folder |
' +----------------------------------------------------------------------------+
Function fnGetMyPathVB()
Dim oShell, oFolder, oFolderItem

set oShell = CreateObject("Shell.Application")
set oFolder = oShell.BrowseForFolder(0, "Choose your 'Documents and Settings' Folder", 0)

If oFolder is nothing Then
fnGetMyPathVB = "None"
Else
set oFolderItem = oFolder.Items.Item
fnGetMyPathVB = oFolderItem.Path
End If
End Function

' +----------------------------------------------------------------------------+
' | Find ALL History Index.Dat Files |
' +----------------------------------------------------------------------------+
Sub RecurseFilesAndFolders(oRoot, sFileEval)
Dim oSubFolder, oFile, oRegExp

Set oRegExp = New RegExp
oRegExp.IgnoreCase = True

If Not (sFileEval = "") Then
oRegExp.Pattern = sFileEval
For Each oFile in oRoot.Files
If (oRegExp.Test(oFile.Name)) Then
ReDim Preserve arrFiles(UBound(arrFiles) + 1)
arrFiles(UBound(arrFiles)) = oFile.Path
index=1 ' Found at least one index.dat file!
End If
Next
End If

For Each oSubFolder In oRoot.SubFolders
RecurseFilesAndFolders oSubFolder, sFileEval
Next
End Sub

' +----------------------------------------------------------------------------+
' | Create Spy.tmp file |
' +----------------------------------------------------------------------------+
Sub CreateSpyTmpFile()
Dim sTempTmp, ub, count, elem, user

' Example: C:\Documents and Settings\<username>\Local Settings\Temp\spy.tmp
sTempTmp = oFSO.GetSpecialFolder(2)+"\spy.tmp"

' Cleanup old spy.tmp file ...
If oFSO.FileExists(sTempTmp) Then
oFSO.DeleteFile sTempTmp
End If

count = 0
ub = UBound(arrFiles)

For Each elem In arrFiles

If IsQuit()=True Then
CloseIE
CleanupQuit
End If

count = count+1
user = split(elem,"\")
SetLine1 "Scanning "+user(2)+" history files:"
SetLine2 CStr(ub+1-count)

oWShell.Run "cmd /c find "+chr(34)+"://"+chr(34)+" "+chr(34)+elem+chr(34)+" >>"+chr(34)+sTempTmp+chr(34),0,True
Next

' Check that spy.tmp exists.
If not oFSO.FileExists(sTempTmp) Then
MsgBox "For some odd reason, SPY.TMP does not exist:"+vbCRLF+vbCRLF+sTempTmp+vbCRLF+vbCRLF+"Unfortunately, no surfing history can be tracked. (cyber_flash@hotmail.com)", VBOKonly, "Exiting (code=0)"
CloseIE
CleanupQuit
End If

End Sub

' +----------------------------------------------------------------------------+
' | Create Spy.htm file |
' +----------------------------------------------------------------------------+
Sub CreateSpyHtmFile()
Dim sReadLine, sArray, start, visit_date, sTempTmp, oTextStream, oFilein, elem

' Cleanup old spy.htm file ...
If oFSO.FileExists(spyPath) Then
oFSO.DeleteFile spyPath
End If

Set oTextStream = oFSO.CreateTextFile(spyPath)

' Check that spy.htm was created.
If not oFSO.FileExists(spyPath) Then
MsgBox "For some odd reason, SPY.HTM does not exist:"+vbCRLF+vbCRLF+spyPath+vbCRLF+vbCRLF+"Unfortunately, no surfing history can be tracked. (cyber_flash@hotmail.com)", VBOKonly, "Exiting (code=1)"
CloseIE
CleanupQuit
End If

' Example: C:\Documents and Settings\<username>\Local Settings\Temp\spy.tmp
sTempTmp = oFSO.GetSpecialFolder(2)+"\spy.tmp"

Set oFilein = oFSO.OpenTextFile(sTempTmp,1)

oTextStream.WriteLine "<html><title>IE is spying on you!</title><body><b>Welcome "&objNet.UserName&"</b><br>"
oTextStream.WriteLine "<table border='0' width='100%'>"

Do While Not oFilein.AtEndOfStream
sReadLine = oFilein.ReadLine
start = Instr(sReadLine,": ")
If start <> 0 Then
visit_date=fnFormatDate(sReadLine)
sReadLine = Mid(sReadLine,start+2)
sArray = Split(sReadLine,"@")
'Visit Date + User + Visited URL
oTextStream.WriteLine "<tr><td nowrap><font color=red size=2>"+visit_date+"</font></td>"+"<td nowrap><font color=green size=2>"+sArray(0)+"</font></td>"+"<td nowrap><font size=2><a href="+sArray(1)+">"+sArray(1)+"</a></font></td></tr>"
End If
loop

oTextStream.WriteLine "</table>"

oTextStream.WriteLine "<br><b>Listing of Index.dat history files:</b><br>"
For Each elem In arrFiles
oTextStream.WriteLine elem+"<br>"
Next

oTextStream.WriteLine "<b>End of Report</b><p><a href=mailto:cyber_flash@hotmail.com?subject=ie_spy>Bugs or Comments?

</a></p></body></html>"

oFilein.Close
oTextStream.Close

' Cleanup temp file ...
If oFSO.FileExists(sTempTmp) Then
oFSO.DeleteFile sTempTmp
End If
End Sub

' +----------------------------------------------------------------------------+
' | Convert Date into readable format |
' +----------------------------------------------------------------------------+
function fnFormatDate(sReadLine)
Dim d, tArray

tArray = Split(sReadLine,": ")
d=Right(tArray(0),16)
If IsNumeric(d) Then
fnFormatDate = Left(d,4)+"/"+Mid(d,5,2)+"/"+Mid(d,7,2)+"-"+Mid(d,9,4)+"/"+Mid(d,13,2)+"/"+Mid(d,15,2)
Else
'Date not stored! Let's default something.

fnFormatDate = "0000/00/00-0000/00/00"
End If
End Function

' +----------------------------------------------------------------------------+
' | Run Spy.htm file |
' +----------------------------------------------------------------------------+
Sub RunSpyHtmFile()
' Check that spy.htm exists.
If not oFSO.FileExists(spyPath) Then
MsgBox "For some odd reason, SPY.HTM does not exist:"+vbCRLF+vbCRLF+spyPath+vbCRLF+vbCRLF+"Unfortunately, no surfing history can be tracked. (cyber_flash@hotmail.com)", VBOKonly, "Exiting (code=2)"
CleanupQuit
Else
oWShell.Run chr(34)+spyPath+chr(34)
End If
End Sub

' +----------------------------------------------------------------------------+
' | Delete Index.dat files |
' +----------------------------------------------------------------------------+
Sub DeleteIndexFiles()
Dim sTempExe, elem

If MsgBox ("Would you like to delete specific Index.dat files?", 65, "Notice")=1 Then

' Example: C:\Documents and Settings\<username>\Local Settings\Temp\deindex.exe
sTempExe = oFSO.GetSpecialFolder(2)+"\deindex.exe"

BuildDeIndexFile(sTempExe)

For Each elem In arrFiles
If MsgBox ("Delete file upon PC restart?"&vbcrlf&elem, 65, "Delete?")=1 Then
oWShell.Run sTempExe+" "+chr(34)+elem+chr(34)
End If
Next

MsgBox "Any pending file deletions are stored under this registry key:"&vbcrlf&vbcrlf&"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\PendingFileRenameOperations"&vbcrlf&vbcrlf&"If you want to undo the pending deletions, goto the above value and simply delete it! (use: regedit.exe)",0,"Notice"
End If
End Sub

' +----------------------------------------------------------------------------+
' | Build DeIndex.exe (see source code below) |
' +----------------------------------------------------------------------------+
Sub BuildDeIndexFile(sTempExe)
Dim t, i, deindex

If not oFSO.FileExists(sTempExe) Then
t=split("4D,5A,90,00,03,00,00,00,04,00,00,00,FF,FF,00,00,B8,00,00,00,00,00,00,00,40,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,B0,00,00,00,0E,1F,BA,0E,00,B4,09,CD,21,B8,01,4C,CD,21,54,68,69,73,20,70,72,6F,67,72,61,6D,20,63,61,6E,6E,6F,74,20,62,65,20,72,75,6E,20,69,6E,20,44,4F,53,20,6D,6F,64,65,2E,0D,0D,0A,24,00,00,00,00,00,00,00,D5,FA,31,DE,91,9B,5F,8D,91,9B,5F,8D,91,9B,5F,8D,1F,84,4C,8D,97,9B,5F,8D,6D,BB,4D,8D,93,9B,5F,8D,52,69,63,68,91,9B,5F,8D,00,00,00,00,00,00,00,00,50,45,00,00,4C,01,03,00,70,78,71,40,00,00,00,00,00,00,00,00,E0,00,0F,01,0B,01,05,0C,00,02,00,00,00,04,00,00,00,00,00,00,00,10,00,00,00,10,00,00,00,20,00,00,00,00,40,00,00,10,00,00,00,02,00,00,04,00,00,00,00,00,00,00,04,00,00,00,00,00,00,00,00,40,00,00,00,04,00,00,00,00,00,00,02,00,00,00,00,00,10,00,00,10,00,00,00,00,10,00,00,10,00,00,00,00,00,00,10,00,00,00,00,00,00,00,00,00,00,00,10,20,00,00,28,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,20,00,00,10,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,2E,74,65,78,74,00,00,00,48,01,00,00,00,10,00,00,00,02,00,00,00,04,00,00,00,00,00,00,00,00,00,00,00,00,00,00,20,00,00,60,2E,72,64,61,74,61,00,00,84,00,00,00,00,20,00,00,00,02,00,00,00,06,00,00,00,00,00,00,00,00,00,00,00,00,00,00,40,00,00,40,2E,64,61,74,61,00,00,00,04,01,00,00,00,30,00,00,00,02,00,00,00,08,00,00,00,00,00,00,00,00,00,00,00,00,00,00,40,00,00,C0,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,68,00,30,40,00,6A,01,E8,24,00,00,00,6A,04,6A,00,68,00,30,40,00,E8,0E,00,00,00,6A,00,E8,01,00,00,00,CC,FF,25,08,20,40,00,FF,25,00,20,40,00,CC,CC,55,8B,EC,81,C4,7C,FE,FF,FF,56,57,E8,02,01,00,00,89,45,FC,33,C9,8B,75,FC,AC,3C,00,74,07,3C,22,75,F7,41,EB,F4,51,D1,E9,D1,E1,58,3B,C1,74,0B,5F,5E,B8,03,00,00,00,C9,C2,08,00,8B,75,FC,8D,BD,3C,FF,FF,FF,AC,3C,00,74,09,3C,09,75,02,B0,20,AA,EB,F2,AA,8D,85,3C,FF,FF,FF,8B,F0,8B,F8,AC,3C,00,75,02,EB,1B,3C,22,75,03,AA,EB,03,AA,EB,EF,AC,3C,20,75,02,B0,FE,3C,22,75,03,AA,EB,E1,AA,EB,EF,AA,8D,85,3C,FF,FF,FF,8B,F0,8D,BD,7C,FE,FF,FF,B9,00,00,00,00,AC,3C,20,74,FB,3B,4D,08,74,15,AC,3C,00,74,1D,3C,20,75,0A,AC,3C,20,74,FB,41,3C,00,74,0F,EB,E6,AA,AC,3C,20,74,07,3C,00,74,03,AA,EB,F4,B0,00,AA,3B,4D,08,73,11,8B,7D,0C,B0,00,AA,B8,02,00,00,00,5F,5E,C9,C2,08,00,8D,85,7C,FE,FF,FF,8B,F0,8B,7D,0C,AC,3C,00,74,0D,3C,22,74,F7,3C,FE,75,02,B0,20,AA,EB,EE,AA,8B,75,0C,AC,3C,00,75,0B,5F,5E,B8,04,00,00,00,C9,C2,08,00,B8,01,00,00,00,5F,5E,C9,C2,08,00,FF,25,04,20,40,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,56,20,00,00,72,20,00,00,48,20,00,00,00,00,00,00,38,20,00,00,00,00,00,00,00,00,00,00,64,20,00,00,00,20,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,56,20,00,00,72,20,00,00,48,20,00,00,00,00,00,00,80,00,45,78,69,74,50,72,6F,63,65,73,73,00,C1,01,4D,6F,76,65,46,69,6C,65,45,78,41,00,6B,65,72,6E,65,6C,33,32,2E,64,6C,6C,00,00,C8,00,47,65,74,43,6F,6D,6D,61,6E,64,4C,69,6E,65,41,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00",",")

Set deindex=oFSO.CreateTextFile(sTempExe,2)

' Check that deindex.exe was created.
If not oFSO.FileExists(sTempExe) Then
MsgBox "For some odd reason, DEINDEX.EXE does not exist:"+vbCRLF+vbCRLF+sTempExe+vbCRLF+vbCRLF+"Unfortunately, no surfing history can be deleted. (cyber_flash@hotmail.com)", VBOKonly, "Exiting (code=3)"
CleanupQuit
End If

For i=0 To UBound(t)
deindex.Write chr(Int("&H"&t(i)))
Next

deindex.Close
End If

End Sub

' +----------------------------------------------------------------------------+
' | Source code for DeIndex.exe |
' +----------------------------------------------------------------------------+
' ;Title: Delete Index.dat files!
' ;Author: Vengy! (-_-)
' ;Date: 2004 and beyond ...
' ;Tested: Win2K/XP ...
' ;Compiled: MASM32
' ;Comments: cyber_flash@hotmail.com
'
' ;This program takes the index.dat file path as a commandline argument,
' ;then invokes the MoveFileEx API which deletes the specified file upon RESTART.
'
' ;The Pending file renames are stored under this registry key:
' ;HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\PendingFileRenameOperations
'
' ;Please visit the link below for more details. Thanks!
' ;

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/base/movefileex.asp

'
'
' .486p
' .MODEL flat, stdcall
' option casemap:none
'
' include \masm32\include\windows.inc
' include \masm32\include\kernel32.inc
' include \masm32\include\masm32.inc
' includelib \masm32\lib\kernel32.lib
' includelib \masm32\lib\masm32.lib
'
' .DATA
' szSrcFile db MAX_PATH dup(0)
'
' .CODE
' Main:
' invoke GetCL, 1, addr szSrcFile
' invoke MoveFileEx, addr szSrcFile, NULL, MOVEFILE_DELAY_UNTIL_REBOOT
' invoke ExitProcess, 0
' End Main
' +----------------------------------------------------------------------------+
' | End of DeIndex.exe source code |
' +----------------------------------------------------------------------------+

' +----------------------------------------------------------------------------+
' | Launch IE Dialog Box and Progress bar |
' +----------------------------------------------------------------------------+
' Shamelessly copied from:

http://cwashington.netreach.net/depo/view.asp?Index=796&ScriptType=vbscript

Private Sub StartIE(strTitel)

Dim objDocument
Dim objWshShell

Set objIE = CreateObject("InternetExplorer.Application")

objIE.height = 160
objIE.width = 400

objIE.menubar = False
objIE.toolbar = false
objIE.statusbar = false
objIE.addressbar = false
objIE.resizable = False

objIE.navigate ("about:blank")

While (objIE.busy)
wend

set objDocument = objIE.document

WriteHtmlToDialog objDocument, strTitel

set objTextLine1 = objIE.document.all("txtMilestone")
set objTextLine2 = objIE.document.all("txtRemarks")
Set objProgressBar = objIE.document.all("pbText")
set objQuitFlag = objIE.document.Secret.pubFlag

objTextLine1.innerTEXT = ""
objTextLine2.innerTEXT = ""

' objIE.document.body.innerHTML = "Building Document..." + "<br>load time= " + n
objIE.visible = True

Set objWSHShell = WScript.CreateObject("WScript.Shell")
objWshShell.AppActivate("Microsoft Internet Explorer")
End Sub

Private Function CloseIE()
On Error Resume Next
objIE.quit
End Function

Private sub SetLine1(sNewText)
On Error Resume Next
objTextLine1.innerTEXT = sNewText
End Sub

Private sub SetLine2(sNewText)
On Error Resume Next
objTextLine2.innerTEXT = sNewText
End Sub

Private function IsQuit()
On Error Resume Next
IsQuit=True
If objQuitFlag.Value<>"quit" Then
IsQuit=False
End If
End function

Private Sub WriteHtmlToDialog(objDocument, strTitel)
objDocument.Open
objDocument.Writeln "<title>" & strTitel & "</title> "
objDocument.Writeln "<style>"
objDocument.Writeln " BODY {background: #CCCCFF} BODY { overflow:hidden }"

objDocument.Writeln " P.txtStyle {color: Navy; font-family: Verdana; " _
& " font-size: 10pt; font-weight: bold; margin-left: 10px } "

objDocument.Writeln " input.pbStyle {color: Navy; font-family: Wingdings; " _
& " font-size: 10pt; background: Silver; height: 20px; " _
& " width: 340px } "

objDocument.Writeln "</style>"
objDocument.Writeln "<div id=""objProgress"" class=""Outer""></div>"

objDocument.Writeln "<CENTER>"
objDocument.Writeln "<b><SPAN id=txtMilestone class='txtStyle' style='margin-left: 10px'></SPAN>"
objDocument.Writeln "<font color=green><SPAN id=txtRemarks class='txtStyle' style='margin-left: 10px'></SPAN></font><b>"
objDocument.Writeln "<br><br>" ' space down a little

objDocument.Writeln "<input type='text' id='pbText' class='pbStyle' value='' >"
objDocument.Writeln "<br><br>" ' space down a little

objDocument.Writeln "<input type='button' value='Cancel' " _
& " onclick='SetReturnFlag(""quit"")' >"
objDocument.Writeln "</CENTER>"

objDocument.Writeln "<form name='secret' >" _
& " <input type='hidden' name='pubFlag' value='run' >" _
& "</form>"

objDocument.Writeln "<SCRIPT LANGUAGE='VBScript' >"

objDocument.Writeln "Sub SetReturnFlag(sFlag)"
objDocument.Writeln " secret.pubFlag.Value = sFlag"
objDocument.Writeln " txtMileStone.style.color = ""Red"" "
objDocument.Writeln " txtRemarks.style.color = ""Red"" "
objDocument.Writeln "End Sub"

objDocument.Writeln "Function PctComplete(nPct)"
objDocument.Writeln "pbText.Value = String(nPct,"" "") & String(4,""n"")"
objDocument.Writeln "End Function"

objDocument.Writeln "Sub UpdateProgress()"
objDocument.Writeln "Dim intStep"
objDocument.Writeln "Dim intDirection"

objDocument.Writeln "If (IsNull(objProgress.getAttribute(""Step"")) = True) Then"
objDocument.Writeln "intStep = 0"
objDocument.Writeln "Else"
objDocument.Writeln "intStep = objProgress.Step"
objDocument.Writeln "End If"

objDocument.Writeln "if (IsNull(objProgress.GetAttribute(""Direction""))=True) Then"
objDocument.Writeln "intDirection = 0"
objDocument.Writeln "Else"
objDocument.Writeln "intDirection = objProgress.Direction"
objDocument.Writeln "End If"

objDocument.Writeln "if intDirection=0 then"
objDocument.Writeln "intStep = intStep + 1"
objDocument.Writeln "else"
objDocument.Writeln "intStep = intStep - 1"
objDocument.Writeln "end if"

objDocument.Writeln "Call PctComplete(intStep)"

objDocument.Writeln "if intStep>=23 then"
objDocument.Writeln "intDirection=1"
objDocument.Writeln "end if"
objDocument.Writeln "if intStep<=0 then"
objDocument.Writeln "intDirection=0"
objDocument.Writeln "end if"

objDocument.Writeln "objProgress.SetAttribute ""Step"", intStep"
objDocument.Writeln "objProgress.SetAttribute ""Direction"", intDirection"

objDocument.Writeln "Window.setTimeout GetRef(""UpdateProgress""), " & conBarSpeed
objDocument.Writeln "End Sub"

objDocument.Writeln "Sub DialogHardTimeout()"
objDocument.Writeln "SetReturnFlag(""quit"")"
objDocument.Writeln "End sub"

objDocument.Writeln "Sub Window_OnLoad()"
objDocument.Writeln "theleft = (screen.availWidth - document.body.clientWidth) / 2"
objDocument.Writeln "thetop = (screen.availHeight - document.body.clientHeight) / 2"
objDocument.Writeln "window.moveTo theleft,thetop"
objDocument.Writeln "Window.setTimeout GetRef(""UpdateProgress""), " & conBarSpeed
objDocument.Writeln "Window.setTimeout GetRef(""DialogHardTimeout""), " & conForcedTimeOut
objDocument.Writeln "End Sub"

objDocument.Writeln "</SCRIPT>"

objDocument.Close

End Sub

' +----------------------------------------------------------------------------+
' | All good things come to an end. |
' +----------------------------------------------------------------------------+

</code>

markdmac · Sep 29, 2004

I can't take the credit for that one, as shown in the code it is not my own. Happy to share it though.

I hope you find this post helpful. Please let me know if it was.

Regards,

Mark

tfg13 · Sep 29, 2004

For some reason, my <code> didn't work. Sorry!!!!

markdmac · Sep 29, 2004

tfg, you used <> instead of [] which is why your code command did not work. Thanks for posting the removal script. I had someone ask about that recently.

I hope you find this post helpful. Please let me know if it was.

Regards,

Mark

tfg13 · Sep 29, 2004

DOH!!!!! Figures....By the way, I referenced you on my previous because you posted it. As I'm sure someone may reference my post. Whoever this "Vengy" guy is rocks! Kicks my butt at scripting (I'm still a novice).

moolie · Sep 29, 2004

Having trouble getting this removal code to run.

Getting error on line 559

objDocument.Writeln "<form name='secret' >" _
& " <input type='hidden' name='pubFlag' value='run' >" _
& "</form>"

objDocument.Writeln "<SCRIPT LANGUAGE='VBScript' >"

unterminaled string constant?

markdmac · Sep 29, 2004

Probably a problem from your copy & paste. Try this:

Replace:
objDocument.Writeln "<form name='secret' >" _
& " <input type='hidden' name='pubFlag' value='run' >" _
& "</form>"

With this:
objDocument.Writeln "<form name='secret'><input type='hidden' name='pubFlag' value='run' ></form>"

I hope you find this post helpful. Please let me know if it was.

Regards,

Mark

rye8261 · Sep 29, 2004

This code will run from your computer and place the html file on your c drive so you dont have to run it from their comptuer. It has to be saved as an vbs file.

Code:

' +----------------------------------------------------------------------------+
' | Contact Info                                                               |
' +----------------------------------------------------------------------------+
' Author: Vengy
' Email : cyber_flash@hotmail.com
' Tested: win2K/XP
' IMPORTANT: Accessing a networked PC using: "\\Machine\C$" requires Administrator privilege. 



' +----------------------------------------------------------------------------+
' | Let The Games Begin!                                                       |
' +----------------------------------------------------------------------------+
' INDEX.DAT files keep a list of websites you have visited, cookies received and files opened/downloaded.
' As a result anyone can find out what you have been doing on the Internet!

' This program scans all History index files only (not cookies or temporary internet files)
' looking for any protocol :// entries. If found, they're stored in a file called C:\Machine-MM-DD-YYYY.htm.

' When the scan completes, you will have the option to remove specific IE history files!

' Aside: This program invokes a local windows program called FIND.EXE to
' parse the index.dat files. (I was too lazy to code it myself. ;)

' Have Fun! (-_-)



' +----------------------------------------------------------------------------+
' | Ensure that all variable names are defined!                                |
' +----------------------------------------------------------------------------+
Option Explicit



' +----------------------------------------------------------------------------+
' | Setup constants                                                            |
' +----------------------------------------------------------------------------+
Const conBarSpeed=80
Const conForcedTimeOut=3600000 ' 1 hour



' +----------------------------------------------------------------------------+
' | Setup Objects and misc variables                                           |
' +----------------------------------------------------------------------------+
Dim oFSO        : Set oFSO    = CreateObject("Scripting.FileSystemObject")
Dim oWShell     : Set oWShell = CreateObject("WScript.Shell")
Dim objNet      : Set objNet  = CreateObject("WScript.Network")
Dim Env         : Set Env     = oWShell.Environment("SYSTEM")
Dim arrFiles    : arrFiles    = Array()
Dim arrUsers    : arrUsers    = Array()
Dim HistoryPath : HistoryPath = Array()
Dim objIE
Dim objProgressBar
Dim objTextLine1
Dim objTextLine2
Dim objQuitFlag
Dim spyPath
Dim index
Dim Machine



' +----------------------------------------------------------------------------+
' | Determine OS type. Must be Windows_NT (windows XP/2K/2K3)                  |
' +----------------------------------------------------------------------------+
If StrComp(Env("OS"),"Windows_NT",VBTextCompare) <> 0 Then
   WScript.Echo "This script supports only Windows XP/2K/2K3/NT." & vbNewLine & "Exiting..."
   CleanupQuit
End If



' +----------------------------------------------------------------------------+
' | Whose been a naughty surfer? Let's find out! ;)                            |
' +----------------------------------------------------------------------------+
Machine = UCASE(InputBox("Please enter a network machine:","Remote IE Spy",objNet.UserName))

If Machine <> "" Then
  If Not oFSO.FolderExists("\\" & Machine & "\C$") Then
    MsgBox "Unable to access "&"\\" & Machine & "\C$" & VBCRLF & VBCRLF & "You may need Admin privileges to access that share!",0,"Scan Aborted"
  Else
  
' +----------------------------------------------------------------------------+
' | Set file spy path = C:\Machine-MM-DD-YYYY.htm                              |
' +----------------------------------------------------------------------------+
    spyPath="C:\" & Machine & "-" & Replace(FormatDateTime(Date()),"/","-") & ".htm"
    
    StartSpyScan
  End If
End if



' +----------------------------------------------------------------------------+
' | Outta here ...                                                             |
' +----------------------------------------------------------------------------+
CleanupQuit



' +----------------------------------------------------------------------------+
' | Cleanup and Quit                                                           |
' +----------------------------------------------------------------------------+
Sub CleanupQuit()
    Set oFSO    = Nothing
    Set oWShell = Nothing
    Set objNet  = Nothing
    WScript.Quit
End Sub



' +----------------------------------------------------------------------------+
' | Start Spy Scan                                                             |
' +----------------------------------------------------------------------------+
Sub StartSpyScan()
    Dim index_folder, history_folder, oSubFolder, oStartDir, sFileRegExPattern, user

    LocateHistoryFolder
    
    index_folder="\\" & Machine & "\C$\" & HistoryPath(1)

    If Not oFSO.FolderExists(index_folder) Then
      MsgBox "No history folder exists. Scan Aborted."
    Else

      StartIE  "Remote IE Spy"   
      SetLine1 "Locating history files:"

      sFileRegExPattern = "\index.dat$"
      Set oStartDir = oFSO.GetFolder(index_folder)

      For Each oSubFolder In oStartDir.SubFolders
        history_folder=oSubFolder.Path&"\"&HistoryPath(3)&"\"&HistoryPath(4)&"\"&"History.IE5"
        If oFSO.FolderExists(history_folder) Then

          If IsQuit()=True Then
	    CloseIE    
	    CleanupQuit
          End If

          user = split(history_folder,"\")
          SetLine2 user(5)
          
          ReDim Preserve arrUsers(UBound(arrUsers) + 1)
          arrUsers(UBound(arrUsers)) = user(5)          

          Set oStartDir = oFSO.GetFolder(history_folder)
          RecurseFilesAndFolders oStartDir, sFileRegExPattern
        End If
      Next

      ' Index flag to determine if at least one index.dat file exists.
      If IsEmpty(index) Then
        CloseIE
        MsgBox "No Index.dat files found. Scan Aborted."
      Else
        CreateSpyTmpFile
        CreateSpyHtmFile
        CloseIE
        RunSpyHtmFile
        DeleteIndexFiles
      End If

   End If
End Sub



' +----------------------------------------------------------------------------+
' | Locate History Folder                                                      |
' +----------------------------------------------------------------------------+
Sub LocateHistoryFolder()   
    ' Example: C:\Documents and Settings\<username>\Local Settings\History
    ' HistoryPath(0) = C:
    ' HistoryPath(1) = Documents and Settings
    ' HistoryPath(2) = <username>
    ' HistoryPath(3) = Local Settings
    ' HistoryPath(4) = History    
    HistoryPath=split(oWShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\History"),"\")
End Sub



' +----------------------------------------------------------------------------+
' | Find ALL History Index.Dat Files                                           |
' +----------------------------------------------------------------------------+
Sub RecurseFilesAndFolders(oRoot, sFileEval)
    Dim oSubFolder, oFile, oRegExp

    Set oRegExp = New RegExp
    oRegExp.IgnoreCase = True

    If Not (sFileEval = "") Then
      oRegExp.Pattern = sFileEval
      For Each oFile in oRoot.Files
        If (oRegExp.Test(oFile.Name)) Then
          ReDim Preserve arrFiles(UBound(arrFiles) + 1)
          arrFiles(UBound(arrFiles)) = oFile.Path
          index=1 ' Found at least one index.dat file!
        End If
      Next
    End If

    For Each oSubFolder In oRoot.SubFolders
      RecurseFilesAndFolders oSubFolder, sFileEval
    Next
End Sub



' +----------------------------------------------------------------------------+
' | Create Spy.tmp file                                                        |
' +----------------------------------------------------------------------------+
Sub CreateSpyTmpFile()
    Dim sTempTmp, ub, count, elem, user
    
    ' Example: C:\Documents and Settings\<username>\Local Settings\Temp\spy.tmp
    sTempTmp = oFSO.GetSpecialFolder(2)+"\spy.tmp"
    
    ' Cleanup old spy.tmp file ...
    If oFSO.FileExists(sTempTmp) Then
      oFSO.DeleteFile sTempTmp
    End If  
    
    count = 0
    ub = UBound(arrFiles)
  
    For Each elem In arrFiles

        If IsQuit()=True Then
          CloseIE    
          CleanupQuit
        End If

        count = count+1            
        user = split(elem,"\")
        SetLine1 "Scanning "+user(2)+" history files:"
        SetLine2 CStr(ub+1-count)

        oWShell.Run "cmd /c find "+chr(34)+"://"+chr(34)+" "+chr(34)+elem+chr(34)+" >>"+chr(34)+sTempTmp+chr(34),0,True
    Next 

    ' Check that spy.tmp exists.   
    If not oFSO.FileExists(sTempTmp) Then
      MsgBox "For some odd reason, SPY.TMP does not exist:"+vbCRLF+vbCRLF+sTempTmp+vbCRLF+vbCRLF+"Unfortunately, no surfing history can be tracked. (cyber_flash@hotmail.com)", VBOKonly, "Exiting (code=0)"
      CloseIE    
      CleanupQuit
    End If

End Sub



' +----------------------------------------------------------------------------+
' | Create Spy.htm file                                                        |
' +----------------------------------------------------------------------------+
Sub CreateSpyHtmFile()
    Dim sReadLine, sArray, start, visit_date, sTempTmp, oTextStream, oFilein, elem

    ' Cleanup old spy.htm file ...
    If oFSO.FileExists(spyPath) Then
      oFSO.DeleteFile spyPath
    End If
       
    Set oTextStream = oFSO.CreateTextFile(spyPath)
    
    ' Check that spy.htm was created.   
    If not oFSO.FileExists(spyPath) Then
      MsgBox "For some odd reason, SPY.HTM does not exist:"+vbCRLF+vbCRLF+spyPath+vbCRLF+vbCRLF+"Unfortunately, no surfing history can be tracked. (cyber_flash@hotmail.com)", VBOKonly, "Exiting (code=1)"
      CloseIE    
      CleanupQuit
    End If
    
    ' Example: C:\Documents and Settings\<username>\Local Settings\Temp\spy.tmp
    sTempTmp = oFSO.GetSpecialFolder(2)+"\spy.tmp"
    
    Set oFilein = oFSO.OpenTextFile(sTempTmp,1)

    oTextStream.WriteLine "<html><title>IE is spying on you!</title><body bgcolor=#CCCCFF><font size=2><b>Welcome <font color=green>"&objNet.UserName&"</font></b><br><br>"
        
    oTextStream.WriteLine "<b>"+CStr(UBound(arrUsers)+1)+" users surfed on " + Machine + "'s PC:</b><br>"    
    For Each elem In arrUsers
       oTextStream.WriteLine "<font color=green>"+elem+"</font><br>"      
    Next   
    
    oTextStream.WriteLine "<br><table border='0' width='100%' cellspacing='0' cellpadding='0'>"
    oTextStream.WriteLine "<tr><td nowrap><b>Date:</b></td><td nowrap><b>&nbsp; User:</b></td><td nowrap><b>&nbsp; Link:</b></td></tr>"
    
    Do While Not oFilein.AtEndOfStream
      sReadLine = oFilein.ReadLine
      start = Instr(sReadLine,": ")
      If start <> 0 Then
        visit_date=fnFormatDate(sReadLine)
        sReadLine = Mid(sReadLine,start+2)
        sArray = Split(sReadLine,"@")
        'Visit Date + User + Visited URL    
        oTextStream.WriteLine "<tr><td nowrap><font color=red size=2>"+visit_date+"</font></td>"+"<td nowrap><font color=green size=2>&nbsp; "+sArray(0)+"</font></td>"+"<td nowrap><font size=2>&nbsp; <a href="+sArray(1)+">"+sArray(1)+"</a></font></td></tr>"
      End If
    loop
    
    oTextStream.WriteLine "</table>"
    
    oTextStream.WriteLine "<br><b>Listing of history files:</b><br>"    
    For Each elem In arrFiles
      oTextStream.WriteLine elem+"<br>"      
    Next    
    
    oTextStream.WriteLine "<b>Total Worldwide Spy Scans so far:</b><iframe width=50% height=50 frameborder=0 scrolling=no src='[URL unfurl="true"]https://home.comcast.net/~vengy/ctr.htm'></iframe><br>This[/URL] log counter is incremented each time any IE spy results are generated.<br>The purpose is to monitor basic spy script activity.<br>No personal information is collected or sent by this script!<br><p><a href=mailto:cyber_flash@hotmail.com?subject=ie_spy>Bugs or Comments?</a></p></font><br><br><b>End of Report</b></body></html>"

    oFilein.Close
    oTextStream.Close
    
    ' Cleanup temp file ...    
    If oFSO.FileExists(sTempTmp) Then
      oFSO.DeleteFile sTempTmp
    End If    
End Sub



' +----------------------------------------------------------------------------+
' | Convert Date into readable format                                          |
' +----------------------------------------------------------------------------+
function fnFormatDate(sReadLine)
    Dim d, tArray

    tArray = Split(sReadLine,": ")
    d=Right(tArray(0),16)
    If IsNumeric(d) Then
      fnFormatDate = FormatDateTime(Left(d,4)+"/"+Mid(d,5,2)+"/"+Mid(d,7,2),2)&"-"&FormatDateTime(Mid(d,9,4)+"/"+Mid(d,13,2)+"/"+Mid(d,15,2),2)
    Else
      'Date not stored! Let's default something. ;)
      fnFormatDate = "Not Recorded."
    End If
End Function



' +----------------------------------------------------------------------------+
' | Run Spy.htm file                                                           |
' +----------------------------------------------------------------------------+
Sub RunSpyHtmFile()
    ' Check that spy.htm exists.   
    If not oFSO.FileExists(spyPath) Then
      MsgBox "For some odd reason, the spy file does not exist:"+vbCRLF+vbCRLF+spyPath+vbCRLF+vbCRLF+"Unfortunately, no surfing history can be tracked. (cyber_flash@hotmail.com)", VBOKonly, "Exiting (code=2)"
      CleanupQuit
    Else
      oWShell.Run chr(34)+spyPath+chr(34)
    End If
End Sub



' +----------------------------------------------------------------------------+
' | Delete Index.dat files                                                     |
' +----------------------------------------------------------------------------+
Sub DeleteIndexFiles()
    Dim elem
      
    If MsgBox ("Would you like to delete specific Index.dat files?", 65, "Notice")=1 Then     
      For Each elem In arrFiles
        If MsgBox ("Delete file?"&vbcrlf&vbcrlf&elem, 65, "Delete?")=1 Then
          On Error Resume Next
          oFSO.DeleteFile elem
          If Err.Number <> 0 Then      
            MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description
            Err.Clear
          End If
          If oFSO.FileExists(elem) Then
            MsgBox "Most likely the file is in use by " & Machine & ":"+vbCRLF+vbCRLF+elem,VBOKonly,"File not deleted!"
          End If
        End If
      Next
    End If
End Sub



' +----------------------------------------------------------------------------+
' | Launch IE Dialog Box and Progress bar                                      |
' +----------------------------------------------------------------------------+
' Shamelessly copied from: [URL unfurl="true"]http://cwashington.netreach.net/depo/view.asp?Index=796&ScriptType=vbscript[/URL]
Private Sub StartIE(strTitel)

    Dim objDocument
    Dim objWshShell

    Set objIE = CreateObject("InternetExplorer.Application")

    objIE.height = 160
    objIE.width = 400

    objIE.menubar = False
    objIE.toolbar = false
    objIE.statusbar = false
    objIE.addressbar = false
    objIE.resizable = False

    objIE.navigate ("about:blank")

    While (objIE.busy)
    wend

    set objDocument = objIE.document 
    
    WriteHtmlToDialog objDocument, strTitel
    
    set objTextLine1 = objIE.document.all("txtMilestone")
    set objTextLine2 = objIE.document.all("txtRemarks")
    Set objProgressBar = objIE.document.all("pbText")
    set objQuitFlag = objIE.document.Secret.pubFlag

    objTextLine1.innerTEXT = ""
    objTextLine2.innerTEXT = ""

    ' objIE.document.body.innerHTML = "Building Document..." + "<br>load time= " + n
    objIE.visible = True

    Set objWSHShell = WScript.CreateObject("WScript.Shell")
    objWshShell.AppActivate("Microsoft Internet Explorer")
End Sub



Private Function CloseIE()
        On Error Resume Next
        objIE.quit
End Function 



Private sub SetLine1(sNewText)
        On Error Resume Next
        objTextLine1.innerTEXT = sNewText
End Sub



Private sub SetLine2(sNewText)
        On Error Resume Next
        objTextLine2.innerTEXT = sNewText
End Sub



Private function IsQuit()
        On Error Resume Next
        IsQuit=True
        If objQuitFlag.Value<>"quit" Then
          IsQuit=False
        End If
End function



Private Sub WriteHtmlToDialog(objDocument, strTitel)
    objDocument.Open
    objDocument.Writeln "<title>" & strTitel & "</title> "
    objDocument.Writeln "<style>"
    objDocument.Writeln " BODY {background: #CCCCFF} BODY { overflow:hidden }"
    
    objDocument.Writeln " P.txtStyle {color: Navy; font-family: Verdana; " _
        & " font-size: 10pt; font-weight: bold; margin-left: 10px } "
        
    objDocument.Writeln " input.pbStyle {color: Navy; font-family: Wingdings; " _ 
         & " font-size: 10pt; background: Silver; height: 20px; " _
         & " width: 340px } "
         
    objDocument.Writeln "</style>"
    objDocument.Writeln "<div id=""objProgress"" class=""Outer""></div>"

    objDocument.Writeln "<CENTER>"
    objDocument.Writeln "<b><SPAN id=txtMilestone class='txtStyle' style='margin-left: 10px'></SPAN>"
    objDocument.Writeln "<font color=green><SPAN id=txtRemarks class='txtStyle' style='margin-left: 10px'></SPAN></font><b>"
    objDocument.Writeln "<br><br>" ' space down a little

    objDocument.Writeln "<input type='text' id='pbText' class='pbStyle' value='' >" 
    objDocument.Writeln "<br><br>" ' space down a little

    objDocument.Writeln "<input type='button' value='Cancel' " _
                & " onclick='SetReturnFlag(""quit"")' >"
    objDocument.Writeln "</CENTER>" 

    objDocument.Writeln "<form name='secret' >" _
                & " <input type='hidden' name='pubFlag' value='run' >" _
                & "</form>" 

    objDocument.Writeln "<SCRIPT LANGUAGE='VBScript' >" 

    objDocument.Writeln "Sub SetReturnFlag(sFlag)"
    objDocument.Writeln " secret.pubFlag.Value = sFlag"
    objDocument.Writeln " txtMileStone.style.color = ""Red"" "
    objDocument.Writeln " txtRemarks.style.color = ""Red"" "
    objDocument.Writeln "End Sub" 

    objDocument.Writeln "Function PctComplete(nPct)"
    objDocument.Writeln "pbText.Value = String(nPct,"" "") & String(4,""n"")"
    objDocument.Writeln "End Function"

    objDocument.Writeln "Sub UpdateProgress()"
    objDocument.Writeln "Dim intStep"
    objDocument.Writeln "Dim intDirection"
    
    objDocument.Writeln "If (IsNull(objProgress.getAttribute(""Step"")) = True) Then"
    objDocument.Writeln "intStep = 0"
    objDocument.Writeln "Else"
    objDocument.Writeln "intStep = objProgress.Step"
    objDocument.Writeln "End If"
    
    objDocument.Writeln "if (IsNull(objProgress.GetAttribute(""Direction""))=True) Then"
    objDocument.Writeln "intDirection = 0"
    objDocument.Writeln "Else"
    objDocument.Writeln "intDirection = objProgress.Direction"
    objDocument.Writeln "End If"
    
    objDocument.Writeln "if intDirection=0 then"
    objDocument.Writeln "intStep = intStep + 1"
    objDocument.Writeln "else"
    objDocument.Writeln "intStep = intStep - 1"
    objDocument.Writeln "end if"
    
    objDocument.Writeln "Call PctComplete(intStep)"
    
    objDocument.Writeln "if intStep>=23 then"
    objDocument.Writeln "intDirection=1"
    objDocument.Writeln "end if"
    objDocument.Writeln "if intStep<=0 then"
    objDocument.Writeln "intDirection=0"
    objDocument.Writeln "end if"
    
    objDocument.Writeln "objProgress.SetAttribute ""Step"", intStep"
    objDocument.Writeln "objProgress.SetAttribute ""Direction"", intDirection"
    
    objDocument.Writeln "Window.setTimeout GetRef(""UpdateProgress""), " & conBarSpeed
    objDocument.Writeln "End Sub"

    objDocument.Writeln "Sub DialogHardTimeout()"
    objDocument.Writeln "SetReturnFlag(""quit"")"
    objDocument.Writeln "End sub"
    
    objDocument.Writeln "Sub Window_OnLoad()"
    objDocument.Writeln "theleft = (screen.availWidth - document.body.clientWidth) / 2"
    objDocument.Writeln "thetop = (screen.availHeight - document.body.clientHeight) / 2"
    objDocument.Writeln "window.moveTo theleft,thetop"
    objDocument.Writeln "Window.setTimeout GetRef(""UpdateProgress""), " & conBarSpeed
    objDocument.Writeln "Window.setTimeout GetRef(""DialogHardTimeout""), " & conForcedTimeOut
    objDocument.Writeln "End Sub"
    
    objDocument.Writeln "</SCRIPT>"
     
    objDocument.Close 

End Sub



' +----------------------------------------------------------------------------+
' | All good things come to an end.                                            |
' +----------------------------------------------------------------------------+

---------------------------------------

http://www.ryesworld.com

http://www.northernohiohouses.com

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Monitor user activity - secretly! 3

moolie

Programmer

markdmac

MIS

moolie

Programmer

moolie

Programmer

markdmac

MIS

muddyjohn

IS-IT--Management

tfg13

MIS

tfg13

MIS

markdmac

MIS

tfg13

MIS

markdmac

MIS

tfg13

MIS

moolie

Programmer

markdmac

MIS

rye8261

Technical User

Similar threads

Part and Inventory Search

Sponsor