4

Tenho um sistema de controle e monitoramento de usuários e gostaria de bloquear um site usando Delphi ou até mesmo comandos MSDOS ou vbs, ou até mesmo usando Sockets(não sei se é possível)? O que eu tenho por enquanto é o seguinte:

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
6
  • Você quer criar um proxy, uma aplicação grande? Ou somente um "script"?
    – durtto
    Commented 28/12/2015 às 17:56
  • Um script apenas. É para um sistema de controle de usuários num PC. Commented 28/12/2015 às 17:58
  • 1
    Qual o problema com esse código que você postou?
    – durtto
    Commented 28/12/2015 às 18:20
  • O que realmente você precisa?
    – durtto
    Commented 28/12/2015 às 18:20
  • 1
    @Vaati dá acesso negado ao editar? Se for isto é porque você tem que executar o aplicativo como administrador
    – Syzoth
    Commented 28/12/2015 às 19:42

2 Respostas 2

2

Na linha:

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

Ou:

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

Ocorre o acesso negado por dois possíveis motivos:

  • Você não executou o seu aplicativo como Administrador
  • O antivirus está ativado

O arquivo hosts é bloqueado pra edição e apenas o "executar como administrador" (equivalente ao root dos sistema like-unix em Windows) pode editar.

Para executar Delphi sempre como Administrador você precisará configurar o UAC. Esta pergunta tem um exemplo de como fazer isto:

3
  • Exatamente isso que eu precisava. Sobre os comandos UAC. Pois eu não posso apenas "executar como administrador" toda vez que meu cliente for entrar. Se tiver algum conteúdo sobre UAC eu agradeço. eu fiz o uac.manifest e o uac.rs mas o arquivo uac.res não é criado mesmo depois de compilar com o brcc32 do delphi. se tiver um link direitinho d como fazer eu agradeço. Commented 29/12/2015 às 0:43
  • Achei: youtube.com/watch?v=1xPAJbevlrQ Commented 29/12/2015 às 1:10
  • Eu não entendi o -1, dentro do que foi perguntado eu respondi. Se a pergunta fosse como adicionar UAC eu entenderia o -1. De qualquer maneira irei adicionar um exemplo mais tarde ;)
    – Syzoth
    Commented 29/12/2015 às 18:56
-3

Solução em VBS. Faz uma cópia do 'hosts' e depois o substitui.

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
2
  • Não entendi, poderia explicar como isto resolve?
    – Syzoth
    Commented 28/12/2015 às 19:59
  • não fui eu quem negativou, mas seria legal se você explicasse como o código editar o Acesse negado ;)
    – Syzoth
    Commented 28/12/2015 às 21:08

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .