Simple Crawler v1.0

Simple Crawler V1.0

Son güncelleme 14 Ekim 2007 Pazar

Statik bir sitenin binlerce HTML sayfasını indirmek ve bu içerik ile veritabanı oluşturmak istiyoruz. Bu işlem için öncelikle HTML sayfaları indirecek bir araca ihtiyacımız var: Simpler Crawler!

Yapmanız gerekenler çok basit: Link listesi, Tarayıcı Modu, Dil Kodlaması, Tarayıcı Kimliği gibi seçenekleri düzenliyorsunuz ve "Başla" ya tıklıyorsunuz.

argelab_simple_crawler.zip (107K)

' Simple Crawler V1.0
' (c)2007 Serdar IRMAK - www.argelab.net

Imports System.Net
Imports System.Text
Imports System.IO
Imports System.Net.Sockets
Imports System.Globalization
Imports System.Collections
Imports System.Collections.Generic

Public Enum URLFileTypes
    Text
    Html
End Enum

Public Enum BrowserModes
    Net
    IE
End Enum

Public Class Crawler

Private Const CHAR_MAP As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_=[](){}!""'^+%&#.,;ışöüğçÇÖĞİÖÜ"

Public Encoding As String = "utf-8"
    Public Referrer As String = "www.argelab.net"
    Public Agent As String = "argelab.net simple bot"
    Public Proxy As String = ""
    Public URLFile As String = ""
    Public URLFileType As URLFileTypes = URLFileTypes.Text
    Public BrowserMode As BrowserModes = BrowserModes.Net
    Public LinkSaveCount As Integer = 5000

Private IEObj As SHDocVw.InternetExplorer = Nothing

Private _culture As CultureInfo = Nothing
    Private ReadOnly Property Culture() As CultureInfo
        Get
            If IsNothing(_culture) Then _culture = New System.Globalization.CultureInfo("en-US")
            Return _culture
        End Get
    End Property

Public Function LoadWebPageNet(ByVal url As String) As String
        Try
            Dim myHttpWebRequest As HttpWebRequest = WebRequest.Create(url.ToLower(Culture))
            myHttpWebRequest.UserAgent = Agent
            myHttpWebRequest.Referer = Referrer
            If (Not IsNothing(Proxy) AndAlso Proxy.Length > 0) Then
                Dim prx As New System.Net.WebProxy(New System.Uri(Proxy), False)
                myHttpWebRequest.Proxy = prx
            End If

Dim myHttpWebResponse As HttpWebResponse = myHttpWebRequest.GetResponse()

If myHttpWebRequest.HaveResponse Then
                Dim recvStream As Stream = myHttpWebResponse.GetResponseStream()

Dim encode As Encoding = System.Text.Encoding.GetEncoding(Encoding)
                Dim readStream As New StreamReader(recvStream, encode)
                Return readStream.ReadToEnd()
            Else
                Return "Hata" + vbCrLf + "myHttpWebRequest.HaveResponse false döndü !"
            End If
        Catch ex As Exception
            Return "Hata" + vbCrLf + ex.Message + vbCrLf + ex.StackTrace
        End Try
    End Function

Public Function LoadWebPageIE(ByVal url As String) As String

Dim retryCount As Integer = 3
        Try
L:          IEObj.Navigate2(url.ToLower(Culture))
            Application.DoEvents()
            Dim t As Date = Now
            While IEObj.Busy OrElse IEObj.ReadyState <> SHDocVw.tagREADYSTATE.READYSTATE_COMPLETE
                Threading.Thread.Sleep(50)
                Dim t2 As Date = Now
                If t2.Subtract(t).TotalSeconds > 180 Then
                    retryCount -= 1
                    If retryCount >= 0 Then
                        IEObj.Stop()
                        GoTo L
                    Else
                        Return "Hata, bekleme zamanını aştı !"
                    End If
                End If
            End While
            IEObj.Stop()
            Return "<html>" & IEObj.Document.documentElement.innerHTML & "</html>" 'ie.Document.body.innerHTML 
        Catch ex As Exception
            Return "Hata" + vbCrLf + ex.Message + vbCrLf + ex.StackTrace
        End Try
    End Function

' htmlden link toplar 
    Public Function LoadAndParseLinkList(ByVal fileName As String) As List(Of String)
        Dim lst As New List(Of String)
        Dim ltxt As String = LoadFile(fileName).ToLower(Culture).Replace(Chr(13), "").Replace(Chr(10), "").Replace(Chr(7), "")
        If ltxt <> "" Then
            Dim i As Integer = 0, j As Integer, k As Integer, f As String
            Do
                i = ltxt.IndexOf("<a ", i)
                If i < 0 Then Exit Do
                i += 3

j = ltxt.IndexOf("href ", i)
                k = ltxt.IndexOf("href=", i)
                If j < 0 OrElse (j >= 0 And k >= 0 And k < j) Then j = k
                If j < 0 Then Exit Do
                i = j + 4

i = ltxt.IndexOf("=", i)
                If i < 0 Then Exit Do
                i += 1

f = """"
                j = ltxt.IndexOf("""", i)
                k = ltxt.IndexOf("'", i)
                If j < 0 OrElse (j >= 0 And k >= 0 And k < j) Then j = k : f = "'"
                If j < 0 Then Exit Do
                i = j + 1

j = ltxt.IndexOf(f, i)
                If j < 0 Then Exit Do

f = ltxt.Substring(i, j - i)
                If f <> "" AndAlso ltxt.Substring(i, 11) <> "javascript:" Then lst.Add(f)

i = j + 1
            Loop
        End If
        Return lst
    End Function

Public Function LoadLinkList(ByVal fileName As String) As List(Of String)
        Dim lst As New List(Of String)
        Dim ltxt As String = LoadFile(fileName).ToLower(Culture).Replace(Chr(13), "").Replace(" ", "").Replace(Chr(7), "")
        If ltxt <> "" Then
            For Each s As String In ltxt.Split(Chr(10))
                If s <> "" Then lst.Add(s)
            Next
        End If
        Return lst
    End Function

Public Function LoadPages() As Boolean
        ' bağlantı listesini yükle
        Dim a As List(Of String)
        If URLFileType = URLFileTypes.Text Then
            a = LoadLinkList(URLFile)
        Else
            a = LoadAndParseLinkList(URLFile)
        End If
        If a.Count < 1 Then Return False

Dim destFolderName As String = Path.GetFileNameWithoutExtension(URLFile) & "\"
        If Not Directory.Exists(destFolderName) Then Directory.CreateDirectory(destFolderName)
        If Not File.Exists(URLFile & ".backup") Then File.Copy(URLFile, URLFile & ".backup")

IEObj = New SHDocVw.InternetExplorer
        IEObj.Visible = True

Dim loadCount As Integer = 0
        Dim urlListSaved As Boolean = False
        While a.Count > 0

Dim htm As String
            If BrowserMode = BrowserModes.Net Then
                htm = LoadWebPageNet(a(0))
            Else
                htm = LoadWebPageIE(a(0))
            End If
            SaveFile(destFolderName & URLToFileName(a(0)), htm)

a.RemoveAt(0)
            loadCount += 1
            urlListSaved = False
            If (loadCount >= LinkSaveCount) Then
                loadCount = 0
                SaveURLList(URLFile, a)
                urlListSaved = True
            End If
            Application.DoEvents()
        End While

If Not urlListSaved Then SaveURLList(URLFile, a)
        IEObj.Quit()
        Return True
    End Function

Public Sub SaveURLList(ByVal dest As String, ByVal a As List(Of String))
        Dim tempFile As String = Path.GetTempFileName()
        SaveFile(tempFile, String.Join(vbCrLf, a.ToArray()))

File.Delete(dest)
        File.Move(tempFile, dest)
    End Sub

Public Function URLToFileName(ByVal url As String) As String
        If url.EndsWith("\") OrElse url.EndsWith("/") Then url = url.Substring(url.Length - 1)
        Dim i1 As Integer = url.LastIndexOf("/")
        Dim i2 As Integer = url.LastIndexOf("\")
        If i2 > i1 Then i1 = i2
        If i1 > 0 Then url = url.Substring(i1 + 1)

Dim s As New StringBuilder, c As String
        For i As Integer = 0 To url.Length - 1
            c = url.Chars(i)
            If CHAR_MAP.IndexOf(c) < 0 Then c = "_"
            s.Append(c)
        Next
        Dim r As String = s.ToString().ToLower(Culture)
        Return IIf(r.EndsWith(".htm") OrElse r.EndsWith(".html"), r, r & ".html")
    End Function

Public Sub DeleteIfExist(ByVal fileName As String)
        Try
            If File.Exists(fileName) Then File.Delete(fileName)
        Catch
        End Try
    End Sub

Public Function SaveFile(ByVal fileName As String, ByRef txt As String) As Boolean
        Try
            DeleteIfExist(fileName)
            File.WriteAllText(fileName, txt)
            Return True
        Catch
            Return False
        End Try
    End Function

Public Function LoadFile(ByVal fileName As String) As String
        Try
            Return File.ReadAllText(fileName)
        Catch
            Return String.Empty
        End Try
    End Function

End Class

ArgeLab.net, bu sitenin eksiksiz ve hatasız olduğu
konusunda bir garanti veremez. Bu sitede yer alan bilgilerin ve
programların kullanımı sonucu oluşabilecek zararlardan
sorumlu tutulamaz.