Avatar billede jesper2003 Nybegynder
14. marts 2008 - 16:46 Der er 1 løsning

lave denne kode om til VB

Hej folkens er ved at lave en windows service men kan ikke rigtig få det til at virke skal ha lavet denne kode om til VB så den kan komme ind i denne kode

Public Class AuthorLog



    Protected Overrides Sub OnStart(ByVal args() As String)
        ' Add code here to start your service. This method should set things
        ' in motion so your service can do its work.
    End Sub

    Protected Overrides Sub OnStop()
        ' Add code here to perform any tear-down necessary to stop your service.
    End Sub

End Class



Const HKEY_LOCAL_MACHINE = &H80000002
Set objShell = CreateObject("WScript.Shell")

Set objWMIService_wmi = GetObject("winmgmts:\\.\root\wmi")
Set colMonitoredEvents = objWMIService_wmi.ExecNotificationQuery("Select * from MSNdis_StatusMediaConnect")
Do While True
    Set strLatestEvent = colMonitoredEvents.NextEvent
    Wscript.Echo "A network connection has been disconnected: " & strLatestEvent.InstanceName
    nicdesc = strLatestEvent.InstanceName
  Set objWMIService_cimv2 = GetObject("winmgmts:\\.\root\cimv2")
  Set colNics = objWMIService_cimv2.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where ipEnabled = True")

  'Determine nic which trggered the event
  For Each objItem in colNics
      If objItem.description = nicdesc & " - Packet Scheduler Miniport" then
        trig_macaddress = objItem.MacAddress
          trig_nicguid = objItem.SettingID
        trig_strKeyPath = "HKLM\SYSTEM\ControlSet001\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\" & trig_nicguid & "\Connection\MediaSubType"
        trig_subtype = objShell.RegRead(trig_strKeyPath)
        Exit For
      End If
  Next
   
  'If the nic was wired then find wireless nics and disable them
  If trig_subtype = 1 then
      For Each objItem in colNics
        nicguid = objItem.SettingID
        strKeyPath = "HKLM\SYSTEM\ControlSet001\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\" & nicguid & "\Connection\MediaSubType"
        subtype = ""
        on error resume next
        subtype = objShell.RegRead(strKeyPath)
        If err.number <> 0 then
            subtype = 0
            err.clear
            on error goto 0
        End If
        If (subtype = 2) then
            wireless_macaddress = objItem.MacAddress
            set colAdapters = objWMIService_cimv2.Execquery("Select * from Win32_NetworkAdapter where macaddress ='" & wireless_macaddress & "'")
            For Each Adapter in colAdapters
              constatus = Adapter.NetConnectionStatus
              If constatus <> "" then
                  wscript.echo SetConnState(Adapter.NetConnectionID,0)
                End If
            Next
        End If
      Next
  End If
Loop


Function SetConnState(strConn,constate)
Const CONTROL_PANEL = &H3&
Set objShell = CreateObject("Shell.Application")
Set objCP = objShell.Namespace(CONTROL_PANEL)

If connstate = 0 then connAction = "Disa&ble"
If connstate = 1 then connAction = "En&able"

Set colNetwork = Nothing
For Each clsConn in objCP.Items
  If clsConn.Name = "Network Connections" Then
      Set colNetwork = clsConn.getfolder
      Exit For
  End If
Next

If colNetwork is Nothing Then
  WScript.Echo "Network folder not found"
  SetConnState = False
  Exit Function
End If

Set clsLANConn = Nothing
For Each clsConn in colNetwork.Items
  If Instr(LCase(clsConn.name),LCase(strConn)) Then
      Set clsLANConn = clsConn
      Exit For
  End If
Next

If clsLANConn is Nothing Then
  WScript.Echo "Network Connection not found"
  SetConnState = False
  Exit Function
End If


bEnabled = True
Set objEnable = Nothing
Set objDisable = Nothing
For Each clsVerb in clsLANConn.verbs
  If clsVerb.name = connAction Then
      Set objAction = clsVerb
  End If
Next

wscript.echo REPLACE(connAction,"&","") & " " & strConn & "..."
objAction.DoIt
End Function


Håbere virkelig der er en der kan hjælpe
Avatar billede jesper2003 Nybegynder
28. april 2008 - 21:12 #1
lukker
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester



Seneste spørgsmål Seneste aktivitet
I dag 06:10 Excel åbner fil i kæmpe format Af Aske i Excel
I går 22:00 Datafordeler Af Lsk i PHP
I går 12:37 Summere beløb pr. dato Af TTA i Excel
31/1022:44 Tilslutte chassic fans Af viking69 i PC
31/1020:28 LED lysstofrør Af ErikHg i Fri debat