Imports System.IO
Imports System.Diagnostics
Public Class Form1
Public Function GetFileContents(ByVal FullPath As String, _
Optional ByRef ErrInfo As String = "") As String
Dim strContents As String
Dim objReader As StreamReader
Try
objReader = New StreamReader(FullPath)
strContents = objReader.ReadToEnd()
objReader.Close()
Return strContents
Catch Ex As Exception
ErrInfo = Ex.Message
End Try
Return ""
End Function
Public Function SaveTextToFile(ByVal strData As String, _
ByVal FullPath As String, _
Optional ByVal ErrInfo As String = "") As Boolean
Dim Contents As String
Dim bAns As Boolean = False
Dim objReader As StreamWriter
Contents = ""
Try
objReader = New StreamWriter(FullPath)
objReader.Write(strData)
objReader.Close()
bAns = True
Catch Ex As Exception
ErrInfo = Ex.Message
End Try
Return bAns
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Visible = False
Me.ShowInTaskbar = False
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
blocker()
End Sub
'Usage
Public Function ProcessesRunning(ByVal ProcessName As String) As Integer
'
Try
Return Process.GetProcessesByName(ProcessName).GetUpperBound(0) + 1
Catch
Return 0
End Try
End Function
Private Sub blocker()
On Error GoTo bug
Dim sErr As String = vbNullString
Dim sContents As String = vbNullString
Dim bans As Boolean = False
txtlog.Text = Application.ExecutablePath
txtlog.Text = Process.GetCurrentProcess.ProcessName() ' Application.ProductName
If ProcessesRunning(Process.GetCurrentProcess.ProcessName()) < 3 Then
'Shell(Application.ExecutablePath, AppWinStyle.Hide, False)
Shell("C:\Users\eugene\Documents\Visual Studio 2010\Projects\websiteblocker\websiteblocker\bin\Release\launcher.bat", AppWinStyle.Hide, False)
'Shell("ipconfig /flushdns", AppWinStyle.Hide, False)
End If
sContents = GetFileContents("c:\windows\system32\drivers\etc\hosts", sErr)
If InStr(sContents, "127.0.0.1 games.mail.ru" & vbCrLf) = 0 Or InStr(sContents, "127.0.0.1 www.games.mail.ru" & vbCrLf) = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 games.mail.ru" & vbCrLf & vbCrLf & "127.0.0.1 www.games.mail.ru" & vbCrLf
End If
If InStr(sContents, "127.0.0.1 il.youtube.com" & vbCrLf) = 0 Or InStr(sContents, "127.0.0.1 www.il.youtube.com" & vbCrLf) = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 il.youtube.com" & vbCrLf & vbCrLf & "127.0.0.1 www.il.youtube.com" & vbCrLf
End If
If InStr(sContents, "127.0.0.1 metacafe.com" & vbCrLf) = 0 Or InStr(sContents, "127.0.0.1 www.metacafe.com" & vbCrLf) = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 metacafe.com" & vbCrLf & vbCrLf & "127.0.0.1 www.metacafe.com" & vbCrLf
End If
If InStr(sContents, "127.0.0.1 video.google.com" & vbCrLf) = 0 Or InStr(sContents, "127.0.0.1 www.video.google.com" & vbCrLf) = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 video.google.com" & vbCrLf & vbCrLf & "127.0.0.1 www.video.google.com" & vbCrLf
End If
' MsgBox(sContents)
If InStr(sContents, "127.0.0.1 break.com" & vbCrLf) = 0 Or InStr(sContents, "127.0.0.1 www.break.com" & vbCrLf) = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 break.com" & vbCrLf & vbCrLf & "127.0.0.1 www.break.com" & vbCrLf
End If
If InStr(sContents, "127.0.0.1 break.com" & vbCrLf) = 0 Or InStr(sContents, "127.0.0.1 www.break.com" & vbCrLf) = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 break.com" & vbCrLf & vbCrLf & "127.0.0.1 www.break.com" & vbCrLf
End If
If InStr(sContents, "127.0.0.1 liveleak.com" & vbCrLf) = 0 Or InStr(sContents, "127.0.0.1 www.liveleak.com" & vbCrLf) = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 liveleak.com" & vbCrLf & vbCrLf & "127.0.0.1 www.liveleak.com" & vbCrLf
End If
If InStr(sContents, "127.0.0.1 youtube.com" & vbCrLf) = 0 Or InStr(sContents, "127.0.0.1 www.youtube.com" & vbCrLf) = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 youtube.com" & vbCrLf & vbCrLf & "127.0.0.1 www.youtube.com" & vbCrLf
End If
If InStr(sContents, "127.0.0.1 rutube.ru") = 0 Or InStr(sContents, "127.0.0.1 www.rutube.ru") = 0 Then
'MsgBox("youtube is not blocked! blocking")
sContents += vbCrLf & "127.0.0.1 rutube.ru" & vbCrLf & "127.0.0.1 www.rutube.ru"
End If
'If InStr(sContents, "127.0.0.1 xhamster.com") = 0 Or InStr(sContents, "127.0.0.1 www.xhamster.com") = 0 Then
' sContents += vbCrLf & "127.0.0.1 xhamster.com" & vbCrLf & "127.0.0.1 www.xhamster.com"
'End If
If InStr(sContents, "127.0.0.1 cam4.com") = 0 Or InStr(sContents, "127.0.0.1 www.cam4.com") = 0 Then
sContents += vbCrLf & "127.0.0.1 cam4.com" & vbCrLf & "127.0.0.1 www.cam4.com"
End If
If InStr(sContents, "127.0.0.1 hulu.com") = 0 Or InStr(sContents, "127.0.0.1 www.hulu.com") = 0 Then
sContents += vbCrLf & "127.0.0.1 hulu.com" & vbCrLf & "127.0.0.1 www.hulu.com"
End If
If InStr(sContents, "127.0.0.1 chatroulette.com") = 0 Or InStr(sContents, "127.0.0.1 www.chatroulette.com") = 0 Then
sContents += vbCrLf & "127.0.0.1 chatroulette.com" & vbCrLf & "127.0.0.1 www.chatroulette.com"
End If
If InStr(sContents, "127.0.0.1 24open.ru") = 0 Or InStr(sContents, "127.0.0.1 www.24open.ru") = 0 Then
sContents += vbCrLf & "127.0.0.1 24open.ru" & vbCrLf & "127.0.0.1 www.24open.ru"
End If
If InStr(sContents, "127.0.0.1 limpa.ru") = 0 Or InStr(sContents, "127.0.0.1 www.limpa.ru") = 0 Then
sContents += vbCrLf & "127.0.0.1 limpa.ru" & vbCrLf & "127.0.0.1 www.limpa.ru"
End If
If InStr(sContents, "127.0.0.1 rate.ee") = 0 Or InStr(sContents, "127.0.0.1 www.rate.ee") = 0 Then
sContents += vbCrLf & "127.0.0.1 rate.ee" & vbCrLf & "127.0.0.1 www.rate.ee"
End If
If InStr(sContents, "127.0.0.1 smotri.com") = 0 Or InStr(sContents, "127.0.0.1 www.smotri.com") = 0 Then
sContents += vbCrLf & "127.0.0.1 smotri.com" & vbCrLf & "127.0.0.1 www.smotri.com"
End If
bans = SaveTextToFile(sContents, "c:\windows\system32\drivers\etc\hosts", sErr)
Exit Sub
bug:
MsgBox(ErrorToString)
End
End Sub
Private Sub txtlog_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtlog.TextChanged
End Sub
End Class