How to block a site with Delphi, vbs or msdos?

Navigation
4

I have a system for monitoring and monitoring users and would like to block a site using Delphi or even MSDOS or VBS commands, or even using Sockets (I do not know if it's possible)? What I have for now is this:

Delphi 

var 
  dd: TextFile; 

begin 

if FileExists('\Windows\system32\drivers\etc\hosts') then 
begin 

  AssignFile(dd,'\Windows\system32\drivers\etc\hosts'); 
  ReSet(dd); 
  Append(dd); // aqui ocorre "File access denied" 

  if IOResult = 0 then 
  begin 
    WriteLn(dd,'127.0.0.1 www.meusite.com'); 

  CloseFile(dd); 
  end; 
end;

VBS 

dim Fso,f
Dim rep,label,titre,defaut,data
label="Escreva a URL que deseja bloquear"
defaut=""
titre="Bloquear Sites"
rep=InputBox(label,titre,defaut)
Set Fso = CreateObject("Scripting.FileSystemObject") ' aqui dá "Acesso negado"
sys32=Fso.GetSpecialFolder(1)
Set f = fso.OpenTextFile(sys32+"\DRIVERS\ETC\hosts", 8)
if rep="" then Cleanup
f.Write vbnewline
f.Write "127.0.0.1   "  &rep

Sub Cleanup()
  Set FSO = Nothing
  WScript.Quit
End Sub
    
asked by anonymous 28.12.2015 / 18:46

2 answers

2

On line: 

Append(dd); // aqui ocorre "File access denied"

Or: 

Set Fso = CreateObject("Scripting.FileSystemObject") ' aqui dá "Acesso negado"

Access Denied occurs for two possible reasons:

  • You have not run your application as an Administrator
  • Antivirus is enabled

The hosts file is locked for editing and only the "run as administrator" (root equivalent of the like-unix system in Windows) can be edited.

To run Delphi always as an Administrator you need to configure UAC . This question has an example of how to do this:

28.12.2015 / 20:48
-3

Solution in VBS. Make a copy of 'hosts' and then replace it. 

WebsitesToBlock = Array("twitter.com", "www.youtube.com", www.facebook.com")

If WScript.Arguments.length =0 Then
 Set objShell = CreateObject("Shell.Application")
    objShell.ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " RunAsAdministrator", "", "runas", 1
Else
 Const ForReading = 1, ForWriting = 2

 Set shell = CreateObject("WScript.Shell")    
    root = shell.ExpandEnvironmentStrings("%systemroot%")     
    hostFile = root & "\system32\drivers\etc\hosts"
    tempFile = hostFile & ".bak"

    blocked = 0
    towrite = false

 Set fso = CreateObject("Scripting.FileSystemObject")
 Set f1 = fso.OpenTextFile(hostFile, ForReading, True)
 Set f2 = fso.OpenTextFile(tempFile, ForWriting, True)

 Do Until f1.AtEndOfStream

        line = f1.Readline
        towrite = true

     For Each URL in WebsitesToBlock
         If instr(line, URL) Then
             If blocked = 0 Then 
                 If left(line, 1) = "#" Then blocked = 1 Else blocked = 2
             End If
            towrite = false
         End If
     Next    

     If towrite Then f2.WriteLine line
 Loop

 For Each URL in WebsitesToBlock
     If blocked <> 2 Then
            f2.WriteLine "127.0.0.1" & vbTab & vbTab & URL 
     End If
 Next

    fso.Copyfile tempFile, hostFile

    f1.Close
    f2.Close

 If blocked = 2 Then 
        WScript.echo "Time wasting websites have now been unblocked!" 
 Else
        WScript.echo "Time wasting websites are now blocked!" 
 End If

End If
    
28.12.2015 / 20:47
Sort a multidimensional array by one column, keeping the same array rows Set timeout for specific function