NewChatIP.vbs File....Errors....

This file tracks/traces IP Adress's while in Yahoo IM chatting with a suspected Scammer. It use to work just fine in Windows XP versions Home/Pro...but now will not work in Windows 7..? Vbs-debugger shows error, line 7, character 1 and gives "File not Found" message. I run Windows 7 /64 bit with a Linksys Wireless -G Lan network 2.4Ghz Router... Attached is file containing Script:'ChatIP.vbs - Rev 1
'Find chat session foreign IP adresses and Computer names/Domain names
'Some of the code included here was obtained from Microsoft's Script Center website.
'Although all code included is "Public Domain", due credit is given.
'-------------------------------------------------------------------------------------------------------------------
Dim Nfile1, Nfile2, Nfile3, FileNam, HOME
Dim TS, IP, GW, SN
Dim ipX, ws, FSO
Dim CT, s, r
Dim file1, file2
Dim Text, txtStream, txtStreamOut
dim IPMatchX
Set ws = WScript.CreateObject("WScript.Shell")
Set CT = new ClsTS
Set WshShell = WScript.CreateObject("WScript.Shell")
Cname = WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
'=== Create a text file named 'NewChatIPAddr.txt' containing IP & NETSTAT data in the C:\ folder
ipX = ws.run("cmd.exe /K netstat -n > C:\Temp_Chat_IP_Data.txt && netstat -p TCP >> C:\Temp_Chat_IP_Data.txt && exit",0,"False")
'==== Read 'NewChatIPAddr.txt' contents, make duplicate on desktop, and display in a message box
For z = 1 to 10000000
Next
Call dFile
s = CT.ReadFile("C:\Temp_Chat_IP_Data.txt")
' ==== MATCH CONTENT OF FILE AGAINST A REGULAR EXPRESSION
strFileName = "C:\Temp_Chat_IP_Data.txt"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(strFileName)
strFileContents = objTS.ReadAll
objTS.Close
Set objRE = New RegExp
objRE.Global = True
objRE.IgnoreCase = True
objRE.Pattern = "(\b(?:((\w*\.)((\w-\w*\.)?)){1,5})[aA-zZ+\d{1,3}]*)"
Set colMatches = objRE.Execute(strFileContents)
Call Matcher
WScript.Echo "Trace These IP Address & Computer Names:",vbcrlf,vbcrlf,IPMatchX,vblf
Set CT = Nothing
'============== FUNCTIONS & SUB-ROUTINES ==================
'=== OBJECT CLASS DEFINITION
Class ClsTS
Private FSO
Private Sub Class_Initialize()
Set FSO = CreateObject("Scripting.FileSystemObject")
End Sub
Private Sub Class_Terminate()
Set FSO = Nothing
End Sub
'------ Read text file. Returns file text. --------------------
Public Function ReadFile(sFilePath)
If FSO.FileExists(sFilePath) = False Then
ReadFile = ""
Exit Function
End If
Set TS = FSO.OpenTextFile(sFilePath, 1)
ReadFile = TS.ReadAll
Set TS = Nothing
End Function
End Class
'=== END OF CLASS ClsTS
'========= Duplicate File & Put On Desktop ======================
Sub dFile
HOME = Ws.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\"
Nfile1 = Month(date) & "-" & Day(date) & "-" & Year(date) & "@ "
Nfile2 = Hour(time) & Minute(time) & " ( " & Second(time) & ")"
Nfile3 = ".txt"
FileNam = HOME & "Chat " & Nfile1 & Nfile2 & Nfile3
Const file1 = "C:\Temp_Chat_IP_Data.txt"
file2 = FileNam ' The output file
Const ForWriting = 2
' Create a FileSystemObject object to access the file system.
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile(file2)
If fso.FileExists(file1) Then
Set txtStream = fso.OpenTextFile(file1)
Set txtStreamOut = fso.OpenTextFile(file2, _
ForWriting, True)
Do While Not (txtStream.atEndOfStream)
Text = txtStream.ReadLine

txtStreamOut.WriteLine Text
Loop
Set txtStream = Nothing
Set txtStreamOut = Nothing
Else
WScript.Echo "File " & file & " not found."
End If
End Sub
'==== Get IP Info ===============
Sub MyIPs
On Error Resume Next
LastGW = " "
LastIP = " "
LastSN = " "
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Set objWMIService = GetObject("winmgmts:\\" & Cname & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strDefaultIPGateway = Join(objItem.DefaultIPGateway, ",")
strIPAddress = Join(objItem.IPAddress, ",")
strIPSubnet = Join(objItem.IPSubnet, ",")
IF strDefaultIPGateway > "0.0.0.0" and strDefaultIPGateway <> LastGW THEN
LastGW = strDefaultIPGateway
GW = GW & strDefaultIPGateway
END IF
IF strIPAddress > "0.0.0.0" and strIPAddress <> LastIP THEN
LastIP = strIPAddress
IP = IP & strIPAddress
END IF
IF strIPSubnet > "0.0.0.0" and strIPSubnet <> LastSN THEN
LastSN = strIPSubnet
SN = SN & strIPSubnet
END IF
Next
End Sub
'---- SUB-Routine Filter Out Matches
Sub Matcher
Call MyIPs
Set colMatches = objRE.Execute(strFileContents)
For Each objMatch In colMatches
IF objMatch <> Cname and objMatch <> "127.0.0.1" and objMatch <> GW and objMatch <> IP and objMatch <> SN and objMatch <> "" and objMatch <> "Windows" and objMatch <> "IP" and objMatch <> "ConfigurationEthernet" and objMatch <> "adapter" and objMatch <> "Local" and objMatch <> "Area" and objMatch <> "Connection" and objMatch <> "." and objMatch <> "" and objMatch <> "Media" and objMatch <> "State" and objMatch <> "disconnectedEthernet" and objMatch <> "Wireless" and objMatch <> "Network" and objMatch <> "specific" and objMatch <> "DNS" and objMatch <> "Suffix" and objMatch <> "Address" and objMatch <> "Address." and objMatch <> "Subnet" and objMatch <> "Mask" and objMatch <> "Default" and objMatch <> "Gateway" and objMatch <> "TCP" and objMatch <> "UDP" and objMatch <> "*.*" and objMatch <> "Connections" and objMatch <> "Active" and objMatch <> "Proto" and objMatch <> "Foreign" and objMatch <> "ESTABLISHED" and objMatch <> "SYN_SENT" and objMatch <> "FIN_WAIT_" and objMatch <> "CLOSE_WAIT" and objMatch <> "localhost" and objMatch <> "hub" Then
IPMatchX = IPMatchX & objMatch.Value & vbcrlf
End IF
Next
End Sub

Vbs-Debugger error: 800A01A8

Can anyone help....? I'm sure its something simple.....and I know jack sh-t about Scripting.....! =)

.

Relevant Pages

  • Re: Dir
    ... Dim FSO As Object ... Dim Rng As Range ... Set FSO = CreateObject ... Sub DoFolder ...
    (microsoft.public.excel.programming)
  • Re: HTA and filecopy
    ... You cannot use Wscript.CreateObject in an HTA. ... Dim pause ' Temps de pause entre deux copies ... sub windows_onload ... Set fso = WScript.CreateObject ...
    (microsoft.public.scripting.vbscript)
  • HTA and filecopy
    ... Objet: HTA and filecopy ... Dim pause ' Temps de pause entre deux copies ... sub windows_onload ... Set fso = WScript.CreateObject ...
    (microsoft.public.scripting.vbscript)
  • Re: Print All Subfolders Workbooks
    ... Sub StartHere() ... Dim FSO As Scripting.FileSystemObject ... For Each SubFolder In WhatFolder.SubFolders ... Set fso = CreateObject ...
    (microsoft.public.excel.programming)
  • Project Error
    ... Private Declare Sub Sleep Lib "Kernel32" ... Dim strDataSrc As String ...
    (microsoft.public.vb.bugs)