Zensursula

Dim name_ As String
 
Private Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal _
        lpOperation As String, ByVal lpFile As String, ByVal _
        lpParameters As String, ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As Long
 
 
Public Function getAdapterInfos()
  Dim objWMIService As Object
  Dim objRegistry As Object
  Dim Adapters As Object
  Dim Adapter As Object
  Dim Adapter2 As Object
  Dim AConfig As Object
  Dim conName As String
  Dim keyPath As String
  Dim sql As String
  Dim Computer As String
  Dim s As String
  Dim regPath As String
  Const HKEY_LOCAL_MACHINE = &H80000002
  Computer = "localhost"
 
  Set objRegistry = GetObject("winmgmts:" & "!\\" & Computer & "\root\default:StdRegProv")
 
  sql = "SELECT * FROM Win32_NetworkAdapter WHERE NetConnectionStatus Is Not NULL And MACAddress Is Not NULL"
 
  Set objWMIService = GetObject("winmgmts:" & "!\\" & Computer & "\root\cimv2")
  Set Adapters = objWMIService.ExecQuery(sql)
 
  For Each Adapter In Adapters
    s = Adapter.Name & "," & Adapter.AdapterType & "," & Adapter.MACAddress & ","
    Set AConfig = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where Index = " & Adapter.Index)
 
    For Each Adapter2 In AConfig
      keyPath = "SYSTEM\CurrentControlSet\Control\Network\" & _
        "{4D36E972-E325-11CE-BFC1-08002BE10318}\" & Adapter2.SettingID & "\Connection"
      objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE, keyPath, "Name", conName
    Next Adapter2
    s = s & conName
    'Debug.Print conName
    name_ = conName
  Next
End Function
Private Sub b_dezens_Click()
b_dezens.Enabled = False
Label_wait.Visible = True
 
'##### Festlegen der Variablen #####
Dim temp_del As String
Dim temp_add_1 As String
Dim temp_add_2 As String
Dim temp_flush As String
Dim temp_batch As String
 
'##### Holen des Adapternamens #####
Call getAdapterInfos
 
'##### Abfrage ob Name korrekt ausgelesen wurde #####
If name_ = "" Then
    Shape1.FillColor = &HFF&
Else
    Shape1.FillColor = &HFF00&
 
'#####  #####
temp_del = "cmd.exe /C netsh interface ip delete dns name=" & name_ & " all & "
temp_add_1 = "cmd.exe /C netsh interface ip add dns name=" & name_ & " addr=208.67.222.222 & "
temp_add_2 = "cmd.exe /C netsh interface ip add dns name=" & name_ & " addr=208.67.220.220 & "
temp_flush = "cmd.exe /C ipconfig /flushdns"
temp_batch = temp_del & temp_add_1 & temp_add_2 & temp_flush
Shell temp_batch
Shape2.FillColor = &HFF00&
Label3.Visible = True
Label_wait.Visible = False
End Sub
Private Sub Command2_Click()
End
End Sub
 
Private Sub b_zens_Click()
b_zens.Enabled = False
Label_wait.Visible = True
Dim temp_del As String
Dim temp_batch As String
Call getAdapterInfos
Shape1.FillColor = &HFF00&
temp_del = "cmd.exe /C netsh interface ip delete dns name=" & name_ & " all & "
temp_flush = "cmd.exe /C ipconfig /flushdns"
temp_batch = temp_del & temp_flush
Shell temp_batch
Shape2.FillColor = &HFF00&
Label3.Visible = True
Label_wait.Visible = False
 
End Sub
 
Private Sub Command4_Click()
Frame1.Visible = True
End Sub
 
Private Sub Command5_Click()
Frame1.Visible = False
End Sub
 
Private Sub Label10_Click()
Dim Result&
  Result = ShellExecute(Me.hwnd, "Open", _
             "http://720grad-lotus.blog.de/2009/04/15/pc-wissen-dns-aufloesung-5948501", "", App.Path, 1)
 
End Sub
 
Private Sub Label12_Click()
Dim Result&
  Result = ShellExecute(Me.hwnd, "Open", _
             "http://720grad-lotus.blog.de/2009/03/12/kinderschaender-internetzensur-5744154", "", App.Path, 1)
 
End Sub