Public Sub Search()
Dim sr As IO.StreamReader
Dim fw As New StreamWriter(_textSearch, True)
Dim r As Regex
Dim searchWord As String
Dim m As MatchCollection
Dim myconn As New SqlConnection _
("server=" & _DBConnection & ";uid=" & _
_DBBenutzer & ";pwd=" & _
_DBPasswort & ";database=" & _DBName & ";")
For k = 0 To folderArray.Count - 1
For q = 0 To typeArray.Count - 1
Dim arr As New ArrayList()
GetFiles(folderArray.Item(k), typeArray.Item(q), arr)
Dim f As String
For Each f In arr
For i = 0 To protocolArray.Count - 1
Try
sr = New IO.StreamReader(f)
s = sr.ReadToEnd
sr.Close()
Dim url As String
url = "((" + protocolArray.Item(i) & _
")[^#'""][\w-\./#?=&%]+" + ")"
searchWord = "((<\s*a\s+[^>]*href\s*=\s*[""']?" + _
url + "[""' >])|" & _
"(window\.open\([""']" + url + "[""'])|" & _
"""(" & protocolArray.Item(i) & "[^""]*)"")"
r = New Regex(searchWord, _
RegexOptions.IgnoreCase Or _
RegexOptions.Compiled)
m = r.Matches(s)
For n = 0 To m.Count - 1
Dim lSource As Long
Dim lLinks As Long
Try
myconn.Open()
Dim mycomm As New SqlCommand("SELECT " & _
"CASE WHEN COUNT(SourceID)=0 THEN 'FALSE' " & _
"ELSE 'TRUE' END AS Existing " & _
"FROM SourceFiles WHERE Source LIKE '" & f & "'" & _
" GROUP BY SourceID", myconn)
If CType(mycomm.ExecuteScalar(), Boolean) = False Then
Dim mycommand As New SqlCommand _
("INSERT INTO SourceFiles" & _
"(Source, SearchDate)" & _
"VALUES (@Source,@SearchDate)", myconn)
myCommand.Parameters.Add _
("@Source", SqlDbType.NVarChar, _
255, "Source").Value = f
myCommand.Parameters.Add _
("@SearchDate", SqlDbType.DateTime, _
12, "SearchDate").Value = Now
myCommand.ExecuteNonQuery()
Dim cmd As New SqlCommand _
("SELECT @@identity", myconn)
lSource = cmd.ExecuteScalar()
End If
Catch ex As Exception
fw.WriteLine(vbNewLine & "error " & _
"when trying to write to SourceFiles: " & ex.Message)
fw.WriteLine()
Finally
myconn.Close()
End Try
Dim s As String
s = m(k).Value.ToString
s = Replace(s, """", "")
s = Replace(s, "'", "")
s = s.ToLower
s = Regex.Replace(s, "(<\s*a\s+[^>]*href\s*=\s*[a-z]*[""']?" _
& protocolArray.Item(i) & ")", protocolArray.Item(i))
Try
myconn.Open()
Dim mycomm As New SqlCommand("SELECT " & _
"CASE WHEN COUNT(LinkID)=0 THEN 'FALSE' ELSE " & _
"'TRUE' END AS Existing " & _
"FROM Links WHERE Url LIKE '" & s & "'" & _
" GROUP BY LinkID", myconn)
If CType(mycomm.ExecuteScalar(), Boolean) = False Then
hits = hits + 1
Dim mycommand As New SqlCommand _
("INSERT INTO Links(Url)" & _
"VALUES (@Url)", myconn)
mycommand.Parameters.Add("@Url", _
SqlDbType.NVarChar, 255, _
"Url").Value = s
mycommand.ExecuteNonQuery()
Dim MyCmd As New SqlCommand _
("SELECT @@identity", myconn)
lLinks = MyCmd.ExecuteScalar()
End If
Catch ex As Exception
fw.WriteLine(vbNewLine & "Error " & _
"when trying to write to Links: " & _
ex.Message & f & s)
fw.WriteLine()
Finally
myconn.Close()
End Try
Try
myconn.Open()
Dim mycomm As New SqlCommand("INSERT " & _
"INTO FilesLinks(LinkID, SourceID)" & _
" VALUES (@LinkID, @SourceID)", myconn)
myComm.Parameters.Add("@LinkID", _
SqlDbType.Int, 20, _
"LinkID").Value = lLinks
myComm.Parameters.Add("@SourceID", _
SqlDbType.Int, 20, _
"SourceID").Value = lSource
myComm.ExecuteNonQuery()
Catch ex As Exception
fw.WriteLine(vbNewLine & "error " & _
"when trying to write to FilesLinks: " & ex.Message)
fw.WriteLine()
Finally
myconn.Close()
End Try
Next
s = String.Empty
Catch ex As Exception
fw.WriteLine("Error when trying to read File " & _
f & ": " _
& ex.Message)
fw.WriteLine()
End Try
Next
Next
Next
Next
fw.WriteLine("Found URLs: " & hits)
fw.Close()
End Sub