今天写了个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
Write a Comment