今天写了个Web监控的玩具
原理就是获取URL的html代码后进行Hash MD5加密
过一段时间后再去重复 然后和原值比对
标题写明 这玩意只是个玩具。。
懒得写多线程 Timer运行时会造成UI卡死 那位童鞋有兴趣改成多线程委托下就好了
Imports System.Net
Imports System.IO
Imports System.Text
Imports System.Security.Cryptography
Public Class Form1
Public CheckUri As List(Of String) = New List(Of String)
Public SaveCheckResult As List(Of String) = New List(Of String)
Public SourceCheckResult As List(Of String) = New List(Of String)
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
StartFun()
Timer1.Interval = TextBox1.Text.Trim
Timer1.Enabled = True
End Sub
Public Function GetWebHtml(ByVal StrUri As String) As String
Dim getString As String = String.Empty
Try
Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(StrUri), HttpWebRequest)
myHttpWebRequest.Accept = "*/*"
myHttpWebRequest.Referer = String.Empty
myHttpWebRequest.UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 2.0.50727)"
myHttpWebRequest.Method = "GET"
Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse, HttpWebResponse)
Dim getStream As Stream = myHttpWebResponse.GetResponseStream
Dim myStreamReader As StreamReader = New StreamReader(getStream)
getString = myStreamReader.ReadToEnd
myStreamReader.Close()
getStream.Close()
Catch ex As Exception
RichTextBox1.AppendText(ex.Message.ToString & vbCrLf)
End Try
Return getString
End Function
Public Sub ReaderFile()
Dim sr As New StreamReader(Application.StartupPath & "\CheckUrl\Check.txt")
Do While sr.Peek > -1
CheckUri.Add(sr.ReadLine)
Loop
sr.Close()
End Sub
Public Function getHash(ByVal strSource As String, ByVal Code As Int16) As String
Dim dataToHash As Byte() = (New System.Text.ASCIIEncoding).GetBytes(strSource)
Dim hashvalue As Byte() = CType(System.Security.Cryptography.CryptoConfig.CreateFromName("MD5"), System.Security.Cryptography.HashAlgorithm).ComputeHash(dataToHash)
Dim StrHash As String = String.Empty
Dim i As Integer
Select Case Code
Case 16 '选择16位字符的加密结果
For i = 4 To 11
StrHash &= Hex(hashvalue(i)).PadLeft(2, "0").ToUpper
Next
Case 32 '选择32位字符的加密结果
For i = 0 To 15
StrHash &= Hex(hashvalue(i)).PadLeft(2, "0").ToUpper
Next
Case Else 'Code错误时,返回全部字符串,即32位字符
For i = 0 To 15
StrHash &= Hex(hashvalue(i)).PadLeft(2, "0").ToUpper
Next
End Select
Return StrHash
End Function
Public Sub StartFun()
ReaderFile()
If CheckUri.Count - 1 > 0 Then
For strUri As Integer = 0 To CheckUri.Count - 1
Dim HashTemp As String = getHash(GetWebHtml(CheckUri(strUri)), 16)
SaveCheckResult.Add(CheckUri(strUri) & "," & HashTemp)
RichTextBox1.AppendText(Date.Now & " " & CheckUri(strUri) & " 添加完毕 , 特征码:" & HashTemp & " , 监控中.." & vbCrLf)
Next
End If
End Sub
Public Sub TwoStartFun()
If CheckUri.Count - 1 > 0 Then
Dim TempHash As String = String.Empty
Dim Temp() As String = New String() {}
Dim saveTemp() As String = New String() {}
For Each strUri As String In CheckUri
TempHash = strUri & "," & getHash(GetWebHtml(strUri), 16)
Temp = TempHash.Split(",")
For Each saveCheck As String In SaveCheckResult
saveTemp = saveCheck.Split(",")
If saveTemp(0) = strUri Then
If saveTemp(1) <> Temp(1) Then
RichTextBox1.AppendText(Date.Now & " " & Temp(0) & " " & "网页变动请检查!源特征码:" & saveTemp(1) & "现特征码:" & Temp(1) & vbCrLf)
End If
End If
Next
Next
End If
End Sub
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
Timer1.Enabled = False
End Sub
Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
TwoStartFun()
End Sub
End Class
Comments