Tipp 0541 Wake On Lan
Autor/Einsender:
Datum:
  Lothar Kriegerow
08.04. / 30.08.2008
Entwicklungsumgebung:   VB 6
Dieser Tipp zeigt, wie WakeOnLan-fähige Rechner in einem LAN- Netz aufgeweckt werden können. Zur Vorbereitung des eigentlichen Weckvorgangs kann ein IP-Bereich automatisch nach Rechnern im Netz gescannt werden. Das Erkennen einer belegten IP-Adresse geht recht zügig, wobei das Scannen des gesamten IP-Bereichs u.U. sehr lange dauern kann.
Ist hingegen kein Rechner einer IP zugeordnet, sendet das Programm einige Anfragen ins Netz und wartet auf Antwort. Wird ein Bereich gescannt und das Ergebnis in die Liste aufgenommen und später ein weiterer Bereich gescannt, wird das Ergebnis zur bestehenden Liste hinzugefügt.
Es ist auch möglich, unter "Bemerkung" den Rechnernamen o.ä. zu vergeben. Somit wird ein Aufruf zu einem späteren Zeitpunkt erleichtert.
Um einen Rechner aufzuwecken, muss das 1. Mal ein Eintrag aus der Liste gewählt werden. Der Button: "WakeUP" wird nun aktiv und der ausgewählte Rechner kann erweckt werden. In einem 2. Fenster wird das Netz solange kontrolliert, bis der Rechner antwortet. Dieser Vorgang kann zu jeder Zeit abgebrochen werden.
Beim Beenden des Beispiels werden die letzten Einstellungen gespeichert, so dass nach erneutem Starten die letzten Daten sofort wieder zur Verfügung stehen.
Der Code im Download-Projekt ist teilweise kommentiert.
Update:
- Schnelleres Scannen eines IP-Bereichs mit Anzeige der Geräte auch ohne MAC-Adresse.
- Absolute Funktion nun auch im Active Directory mit X Domains.
- Bessere Anzeige, das der Client geweckt wurde.
Code im Codebereich des Moduls modNetBios
 
Option Explicit

Public IPNr As String

Private Declare Function Netbios Lib "netapi32.dll" _
        (pncb As NCB) As Byte

Private Declare Sub CopyMemory Lib "kernel32" Alias _
        "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource _
        As Long, ByVal cbCopy As Long)

Private Declare Sub CopyMemory_ByRef Lib "kernel32" Alias _
        "RtlMoveMemory" (hpvDest As Any, hpvSource _
        As Any, ByVal cbCopy As Long)

Private Const NCBENUM As Byte = &H37
Private Const NCBFINDNAME As Byte = &H78
Private Const NCBDELNAME As Byte = &H31
Private Const NCBADDGRNAME As Byte = &H36
Private Const NCBADDNAME As Byte = &H30
Private Const NCBASTAT As Byte = &H33
Private Const NCBNAMSZ As Byte = 16
Private Const NCBRESET As Byte = &H32

Public Const NRC_ACTSES As Long = &HF&
Public Const NRC_BADDR As Long = &H7
Public Const NRC_BRIDGE As Long = &H23
Public Const NRC_BUFLEN As Long = &H1
Public Const NRC_CANCEL As Long = &H26
Public Const NRC_CANOCCR As Long = &H24
Public Const NRC_CMDCAN As Long = &HB
Public Const NRC_CMDTMO As Long = &H5
Public Const NRC_DUPENV As Long = &H30
Public Const NRC_DUPNAME As Long = &HD
Public Const NRC_ENVNOTDEF As Long = &H34
Public Const NRC_GOODRET As Long = &H0
Public Const NRC_IFBUSY As Long = &H21
Public Const NRC_ILLCMD As Long = &H3
Public Const NRC_ILLNN As Long = &H13
Public Const NRC_INCOMP As Long = &H6
Public Const NRC_INUSE As Long = &H16
Public Const NRC_INVADDRESS As Long = &H39
Public Const NRC_INVDDID As Long = &H3B
Public Const NRC_LOCKFAIL As Long = &H3C
Public Const NRC_LOCTFUL As Long = &H11
Public Const NRC_MAXAPPS As Long = &H36
Public Const NRC_NAMCONF As Long = &H19
Public Const NRC_NAMERR As Long = &H17
Public Const NRC_NAMTFUL As Long = &HE
Public Const NRC_NOCALL As Long = &H14
Public Const NRC_NORES As Long = &H9
Public Const NRC_NORESOURCES As Long = &H38
Public Const NRC_NOSAPS As Long = &H37
Public Const NRC_NOWILD As Long = &H15
Public Const NRC_OPENERR As Long = &H3F
Public Const NRC_OSRESNOTAV As Long = &H35
Public Const NRC_PENDING As Long = &HFF&
Public Const NRC_REMTFUL As Long = &H12
Public Const NRC_SABORT As Long = &H18
Public Const NRC_SCLOSED As Long = &HA
Public Const NRC_SNUMOUT As Long = &H8
Public Const NRC_SYSTEM As Long = &H40
Public Const NRC_TOOMANY As Long = &H22

Private Type NCB
  ncb_Command As Byte
  ncb_RetCode As Byte
  ncb_LSN As Byte
  ncb_Num As Byte
  ncb_pBuffer As Long
  ncb_Length As Integer
  ncb_CallName As String * NCBNAMSZ
  ncb_Name As String * NCBNAMSZ
  ncb_RTO As Byte
  ncb_STO As Byte
  ncb_Post As Long
  ncb_Lana_Num As Byte
  ncb_Cmd_Cplt As Byte
  ncb_Reserve(9) As Byte
  ncb_Event As Long
End Type

Private Type ADAPTER_STATUS
  adapter_address(5) As Byte
  rev_major As Byte
  reserved0 As Byte
  adapter_type As Byte
  rev_minor As Byte
  duration As Integer
  frmr_recv As Integer
  frmr_xmit As Integer
  iframe_recv_err As Integer
  xmit_aborts As Integer
  xmit_success As Long
  recv_success As Long
  iframe_xmit_err As Integer
  recv_buff_unavail As Integer
  t1_timeouts As Integer
  ti_timeouts As Integer
  Reserved1 As Long
  free_ncbs As Integer
  max_cfg_ncbs As Integer
  max_ncbs As Integer
  xmit_buf_unavail As Integer
  max_dgram_size As Integer
  pending_sess As Integer
  max_cfg_sess As Integer
  max_sess As Integer
  max_sess_pkt_size As Integer
  name_count As Integer
End Type

Private Type NAME_BUFFER
  Name As String * NCBNAMSZ
  name_num As Integer
  name_flags As Integer
End Type

Private Type ASTAT
  adapt As ADAPTER_STATUS
  NameBuff(30) As NAME_BUFFER
End Type

Private Type ENUM_LANA
  bCount As Byte
  bLana(300) As Byte
End Type

Public Type MacAdressen
  KZ As Integer
  IP As String * 19
  Bemerkung As String * 30
  MAC As String * 26
  fREI As String * 100 ' Für evtl. Erweiterungen
End Type

Private Declare Function IcmpCreateFile Lib "icmp.dll" () _
        As Long

Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal _
        IcmpHandle As Long) As Long

Private Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal _
        IcmpHandle As Long, ByVal DestinationAddress As Long, _
        ByVal RequestData As String, ByVal RequestSize As _
        Integer, ByVal RequestOptions As Long, ReplyBuffer As _
        ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal _
        TimeOut As Long) As Long

Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal _
        wVersionRequired As Long, lpWSAData As WSAData) As Long

Private Declare Function WSACleanup Lib "wsock32.dll" _
        () As Long
Private Declare Function gethostbyname Lib "wsock32.dll" _
        (ByVal szHost As String) As Long

Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp _
        As String) As Long

Private Type ICMP_OPTIONS
  Ttl As Byte
  Tos As Byte
  Flags As Byte
  OptionsSize As Byte
  OptionsData As Long
End Type

Public Type ICMP_ECHO_REPLY
  Address As Long
  Status As Long
  RoundTripTime As Long
  DataSize As Integer
  Reserved As Integer
  DataPointer As Long
  Options As ICMP_OPTIONS
  Data As String * 250
End Type

Private Type hostent
  hName As Long
  hAliases As Long
  hAddrType As Integer
  hLen As Integer
  hAddrList As Long
End Type

Private Const MAX_WSADescription As Long = 256&
Private Const MAX_WSASYSStatus As Long = 128&
Private Type WSAData
  wVersion As Integer
  wHighVersion As Integer
  szDescription(0 To MAX_WSADescription) As Byte
  szSystemStatus(0 To MAX_WSASYSStatus) As Byte
  wMaxSockets As Integer
  wMaxUDPDG As Integer
  dwVendorInfo As Long
End Type

Private Const PING_TIMEOUT As Long = 200&
Private Const WS_VERSION_REQD As Long = &H101&
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const hostent_size As Long = 16&

Public Function Ping(szAddress As String, ECHO As _
       ICMP_ECHO_REPLY) As Long
  Dim hPort As Long
  Dim dwAddress As Long
  Dim sDataToSend As String
  Dim iOpt As Long
  Dim a As String

  sDataToSend = "x"
  dwAddress = GetHost(szAddress)

  hPort = IcmpCreateFile()

  If IcmpSendEcho(hPort, dwAddress, sDataToSend, _
     Len(sDataToSend), 0, ECHO, Len(ECHO), PING_TIMEOUT) Then

    Ping = ECHO.RoundTripTime
  Else
    Ping = ECHO.Status * -1
  End If

  Call IcmpCloseHandle(hPort)
  a = SocketsCleanup
End Function

Private Function SocketsCleanup() As Boolean
  Dim X As Long

  X = WSACleanup()
  If X <> 0 Then
    Call MsgBox("Windows Sockets error " & Trim$(Str$(X)) & _
         " occurred in Cleanup.", vbExclamation)
    SocketsCleanup = False
  Else
    SocketsCleanup = True
  End If
End Function

Public Function GetHost(ByVal Host As String) As Long
  Dim ListAddress As Long
  Dim ListAddr As Long
  Dim LH As Long, phe As Long
  Dim Start As Boolean
  Dim heDestHost As hostent
  Dim addrList As Long, repIP As Long

  Start = SocketsInitialize
  If Start = False Then
    GetHost = 0
    MsgBox ("Fehler bei der SocketInitialisierung!")
    Exit Function
  End If

  LH = inet_addr(Host)
  repIP = LH
  If LH = INADDR_NONE Then
    phe = gethostbyname(Host)
    If phe <> 0 Then
      CopyMemory heDestHost, ByVal phe, hostent_size
      CopyMemory addrList, ByVal heDestHost.hAddrList, 4
      CopyMemory repIP, ByVal addrList, heDestHost.hLen
    Else
      Call MsgBox("GetHostByName lieferte ungültiges Ergebnis!")
      GetHost = INADDR_NONE
      Exit Function
    End If
  End If

  GetHost = repIP
End Function

Private Function SocketsInitialize() As Boolean
  Dim WSAD As WSAData
  Dim X As Integer
  Dim szLoByte As String, szHiByte As String, szBuf As String

  X = WSAStartup(WS_VERSION_REQD, WSAD)
  If X <> 0 Then
    Call MsgBox("Windows Sockets for 32 bit Windows " & _
         "environments is not successfully responding.")

    SocketsInitialize = False
    Exit Function
  End If

  SocketsInitialize = True
End Function

Public Function KlarIP(IP)
  Dim SP
  SP = Split(IP, ".")
  KlarIP = Val(SP(0)) & "." & Val(SP(1)) & "." & Val(SP(2)) & _
           "." & Val(SP(3))
End Function

Private Function IPBoardCast(ByVal I As String) As String
  Dim SP
  SP = Split(I, ".")
  IPBoardCast = Val(SP(0)) & "." & Val(SP(1)) & "." & Val(SP(2)) _
    & ".255"
End Function

Public Function SendWakeUp(MacAddr, BCastAddr, flr As Boolean)
  Dim objSocket
  On Error GoTo PFehler
  Set objSocket = CreateObject("MSWinsock.Winsock")
  objSocket.Protocol = 1   'UDP
  objSocket.RemoteHost = IPBoardCast(BCastAddr)
  objSocket.SendData CreatePacket(MacAddr, flr)
  objSocket.Close

  On Error GoTo 0
  Exit Function

PFehler:
  MsgBox Error(Err) & " in Zeile " & Str$(Erl)
  flr = True
  Resume Next
End Function

Public Function CreatePacket(ByVal MacAddr As String, flr As _
       Boolean)
  Dim Item
  Dim strTemp As String
  Dim strData
  Dim I As Integer
  Dim arMacAddr

  MacAddr = Replace(MacAddr, ":", "-")
  arMacAddr = Split(MacAddr, "-")

  If UBound(arMacAddr) = 5 Then
    flr = False
    For Each Item In arMacAddr
      Item = "&H" & Item
      strTemp = strTemp & Chr(Item)
    Next

    For I = 1 To 16
      strData = strData & strTemp
    Next

    CreatePacket = String(6, &HFF) & strData
  Else
    flr = True
  End If
End Function

Public Function NB_EnumLanAdapter(bLanArray() As Byte) As Long
  Dim myNcb As NCB
  Dim bRetEnum As ENUM_LANA

   'NetBios Command Enum setzen
  myNcb.ncb_Command = NCBENUM

   'Bufferpointer eintragen
  myNcb.ncb_pBuffer = VarPtr(bRetEnum)

   'Größe des Buffers angeben
  myNcb.ncb_Length = Len(bRetEnum)

   'Alle aktiven Netzwerkkarten enumerieren
  If Netbios(myNcb) = NRC_GOODRET Then

      'Anzahl der aktiven Netzwerkkarten auslesen
    If bRetEnum.bCount Then
      NB_EnumLanAdapter = CLng(bRetEnum.bCount)

      'Nur auslesen, wenn mindestens 1 Netzwerkkarte gefunden wurde
      'Return Array anpassen
      ReDim bLanArray(1 To bRetEnum.bCount)

      'Daten ins Array kopieren
      CopyMemory_ByRef bLanArray(1), bRetEnum.bLana(0), _
          bRetEnum.bCount
    End If
  End If
End Function

Public Function NB_ResetAdapter(lLanNumber As Byte, lSessions _
       As Long, lMaxNames As Long) As Long
  Dim myNcb As NCB

   'Welche Netzwerkkarte soll resetet werden
  myNcb.ncb_Lana_Num = lLanNumber

   'NetBios Command setzen
  myNcb.ncb_Command = NCBRESET
  myNcb.ncb_LSN = 0

   'Maximale Anzahl an Sessions seztzen
  Mid$(myNcb.ncb_CallName, 1, 1) = Chr$(lSessions)

   'Maximale Anzahl an Namen setzen
  Mid$(myNcb.ncb_CallName, 3, 1) = Chr$(lMaxNames)

   'Netzwerkkarte reseten
  If Netbios(myNcb) = NRC_GOODRET Then NB_ResetAdapter = 1
End Function

Public Function NB_GetMACAdresse(lLanNumber As Byte, _
       Optional Server As String = "*") As String
  Dim myNcb As NCB
  Dim bRet As Byte
  Dim myASTAT As ASTAT

   'NetBios Command setzen
  myNcb.ncb_Command = NCBASTAT
  myNcb.ncb_Lana_Num = lLanNumber

   'Server setzen.
  myNcb.ncb_CallName = Server

   'Größe des Speichers setzen
  myNcb.ncb_Length = Len(myASTAT)

   'Buffer eintragen
  myNcb.ncb_pBuffer = VarPtr(myASTAT) 'pASTAT

   'Karte auslesen
  If Netbios(myNcb) = NRC_GOODRET Then

    'Daten in die neue
    NB_GetMACAdresse = _
    HexEx(myASTAT.adapt.adapter_address(0)) & "-" & _
    HexEx(myASTAT.adapt.adapter_address(1)) & "-" & _
    HexEx(myASTAT.adapt.adapter_address(2)) & "-" & _
    HexEx(myASTAT.adapt.adapter_address(3)) & "-" & _
    HexEx(myASTAT.adapt.adapter_address(4)) & "-" & _
    HexEx(myASTAT.adapt.adapter_address(5))
  End If
  DoEvents
End Function

Private Function HexEx(ByVal lNumber As Long) As String
  HexEx = Hex(lNumber)
  If Len(HexEx) = 1 Then HexEx = "0" & HexEx
End Function
 
Code im Codebereich der Form WonL
 
Option Explicit
Dim strVersion As String

Sub Gotfokus(t As TextBox)
  With t
    .SelStart = 0
    .SelLength = Len(.Text)
    .Tag = .Text
  End With
End Sub

Sub Liste()
  With lViewIP
    .ColumnHeaders.Add , , "Bemerkung", 2400
    .ColumnHeaders.Add , , "IP-Nummer", 1400
    .ColumnHeaders.Add , , "MAC-Adresse", 1800
    .View = lvwReport
    .FullRowSelect = True
  End With
End Sub

Sub ListeLadenSpeichern(z, Optional MACDEl As String)
  Dim FNr As Integer
  Dim I As Integer
  Dim j As Integer
  Dim Jj As Integer
  Dim DS As Long
  Dim MAC As MacAdressen
  Dim MACAdresse As String
  Dim Find As Boolean
  Dim SP
  Find = False

  FNr = FreeFile
  Open App.Path & "\Liste.lst" For Random As #FNr Len = Len(MAC)
  DS = LOF(FNr) / Len(MAC)

  With lViewIP
    Select Case z
      Case 0
        .ListItems.Clear
        For j = 1 To DS
          Get #FNr, j, MAC
          SP = Split(MAC.IP, ".")
          If SP(0) & "." & SP(1) & "." & SP(2) = txtIP.Text And _
             MAC.KZ = 1 Then
            Jj = Jj + 1
            .ListItems.Add , , Trim$(MAC.Bemerkung)
            .ListItems(Jj).SubItems(1) = Trim$(MAC.IP)
            .ListItems(Jj).SubItems(2) = Trim$(MAC.MAC)
          End If
        Next
      Case 1
        For I = 1 To lViewIP.ListItems.Count
          Find = False
          MACAdresse = .ListItems(I).SubItems(2)
          For j = 1 To DS
            Get #FNr, j, MAC
            If Trim$(MAC.MAC) = MACAdresse And MAC.KZ = 1 Then
              MAC.Bemerkung = .ListItems(j)
              Put #FNr, j, MAC
              Find = True
              Exit For
            End If
          Next
          If Find = False Then
            MAC.Bemerkung = .SelectedItem.Text
            MAC.IP = .ListItems(I).SubItems(1)
            MAC.MAC = .ListItems(I).SubItems(2)
            MAC.KZ = 1
            DS = DS + 1
            Put #FNr, DS, MAC
          End If
        Next
      Case 2
        For I = 1 To DS
          Get #FNr, I, MAC
          If MACDEl = Trim$(MAC.MAC) And MAC.KZ = 1 Then
            MAC.KZ = 0
            Put #FNr, I, MAC
            Exit For
          End If
        Next
    End Select
  End With
  Close #FNr
End Sub

Sub Setup(z)
  Dim a As String
  Dim F As Integer

  On Error Resume Next

  F = FreeFile

  Select Case z
    Case 0
      Open App.Path & "\Setup.stp" For Input As #F

      Input #F, a
      If a = "" Then txtIP.Text = "192.168.2" Else txtIP().Text = a

      Input #F, a
      If a = "" Then txtIPBereich(0).Text = "1" Else _
         txtIPBereich(0).Text = a

      Input #F, a
      If a = "" Then txtIPBereich(1).Text = "1" Else _
         txtIPBereich(1).Text = a

      Input #F, a
      If a <> "" Then lblIP.Caption = a

      Input #F, a
      If a <> "" Then txtMAC.Text = a

    Case 1
      Open App.Path & "\Setup.stp" For Output As #F
      Print #F, txtIP.Text
      Print #F, txtIPBereich(0).Text
      Print #F, txtIPBereich(1).Text
      Print #F, lblIP.Caption
      Print #F, txtMAC.Text
  End Select

  Close #F
  On Error GoTo 0
End Sub

Private Sub cmdIPMAC_Click()
  Dim bLanAdapter() As Byte
  Dim IP As String
  Dim I As Long
  Dim t As String
  Dim X As Integer
  Dim eIP As Integer
  Dim numAdapter As Long
  Dim MACAdresse As String
  Dim ECHO As ICMP_ECHO_REPLY

  If txtIP.Text = "" Then Exit Sub

  If Val(txtIPBereich(0).Text) > Val(txtIPBereich(1).Text) Then
    t = txtIPBereich(0).Text
    txtIPBereich(0).Text = txtIPBereich(1).Text
    txtIPBereich(1).Text = t
  End If

  cmdIPMAC.Enabled = False
  lViewIP.ListItems.Clear
  Me.MousePointer = vbHourglass

  For eIP = Val(txtIPBereich(0).Text) To Val(txtIPBereich(1).Text)
    IP = txtIP.Text & "." & eIP
    lblIP.Caption = "Scanne " & IP
    DoEvents

    ECHO.Data = ""
    Call Ping(KlarIP(IP), ECHO)

    If Left$(ECHO.Data, 1) = "x" Then
      numAdapter = modNetBios.NB_EnumLanAdapter(bLanAdapter)
       'wurde mindestens ein aktiver Adapter gefunden
      If numAdapter > 0 Then
        Call modNetBios.NB_ResetAdapter(bLanAdapter(1), 20, 30)
        MACAdresse = modNetBios.NB_GetMACAdresse(bLanAdapter(1), _
           IP)
        DoEvents

        I = I + 1
        With lViewIP
          .ListItems.Add , , "(keine)"
          .ListItems(I).SubItems(1) = IP
          .ListItems(I).SubItems(2) = MACAdresse
        End With
      End If
    DoEvents
    End If
  Next

  cmdIPMAC.Enabled = True
  Me.MousePointer = vbDefault
End Sub

Private Sub cmdListeSpeichern_Click()
  Call ListeLadenSpeichern(1)
End Sub

Private Sub cmdListeLaden_Click()
  Call ListeLadenSpeichern(0)
End Sub

Private Sub cmdWakeUp_Click()
  Dim flr As Boolean

  lblIP.Caption = Replace$(lblIP.Caption, "Scanne ", "")
  IPNr = IP(lblIP.Caption)
  Call SendWakeUp(txtMAC.Text, lblIP.Caption, flr)

  If flr = False Then
    frmAnswer.Show 1
  Else
    MsgBox "Fehler in der MAC-Adresse oder fehlerhafte" & _
       "Installation!"
  End If
End Sub

Private Sub Form_Load()
  strVersion = "1.08.03"
  Call Liste
  Call Setup(0)
  Call ListeLadenSpeichern(0)
  lblIP.BorderStyle = 0
End Sub

Private Function IP(ByVal I As String) As String
  Dim SP
  SP = Split(I, ".")
  IP = Val(SP(0)) & "." & Val(SP(1)) & "." & Val(SP(2)) & "." _
       & Val(SP(3))
End Function
Private Sub Form_Unload(Cancel As Integer)
  Call Setup(1)
End Sub

Private Sub lViewIP_Click()
  If lViewIP.ListItems.Count > 0 Then
    txtMAC.Text = lViewIP.SelectedItem.SubItems(2)
    lblIP.Caption = lViewIP.SelectedItem.SubItems(1)
  End If
End Sub

Private Sub PD_Komplett_Click()
  Dim X As Integer

  X = MsgBox("Soll die komplette IP/MAC-Liste gelöscht werden?", _
      4 + 32 + 256, "Frage?")
  If X = 7 Then Exit Sub

  If Dir$(App.Path & "\Liste.lst", 0) = "Liste.lst" Then Kill
     App.Path & "\Liste.lst"
  lViewIP.ListItems.Clear
End Sub

Private Sub PD_Liste_Click()
  If lViewIP.ListItems.Count > 0 Then
    PD_Loeschen.Enabled = True
  Else
    PD_Loeschen.Enabled = False
  End If

  If Dir$(App.Path & "\Liste.lst", 0) = "Liste.lst" Then
    PD_Komplett.Enabled = True
  Else
    PD_Komplett.Enabled = False
  End If
End Sub

Private Sub PD_Loeschen_Click()
  Dim X As Integer
  Dim MAC As String

  MAC = lViewIP.SelectedItem.SubItems(2)
  X = MsgBox("Soll der Eintrag mit der MAC-Adresse " & MAC & _
      " gelöscht werden?", 4 + 32 + 256, "Frage?")
  If X = 7 Then Exit Sub
  Call ListeLadenSpeichern(2, MAC)
  Call ListeLadenSpeichern(0)
End Sub

Private Sub pd_Ueber_Click()
  MsgBox "Wake on Lan" & vbNewLine & "Autor Lothar Kriegerow " _
     & vbNewLine & "Version " & strVersion
End Sub

Private Sub txtIP_GotFocus()
  Gotfokus txtIP
End Sub

Private Sub txtIP_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = 27 Or KeyCode = 38 Then SendKeys "+" & vbTab
  If KeyCode = 13 Or KeyCode = 40 Then SendKeys vbTab
End Sub

Private Sub txtIP_KeyPress(KeyAscii As Integer)
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And _
     KeyAscii <> 46 Then KeyAscii = 0
  If KeyAscii = 13 Or KeyAscii = 27 Then KeyAscii = 0
End Sub

Private Sub txtIP_LostFocus()
  Dim SP
  Dim t As String
  Dim flr As Boolean

  ' Routine zur Ermittlung der korrekten IP-Schreibweise
  t = txtIP.Text
  If t = "" Then Exit Sub

  If InStr(t, ".") = 0 Then
    flr = True
  Else
    SP = Split(t, ".")
    If UBound(SP, 1) < 2 Then
      flr = True
    Else
      txtIP.Text = Val(SP(0)) & "." & Val(SP(1)) & "." & Val(SP(2))
    End If
  End If

  If flr = True Then MsgBox "Geben Sie bitte die ersten drei" _
     & "Stellen der IP ein!": txtIP.SetFocus
  If txtIP.Text <> txtIP.Tag Then lViewIP.ListItems.Clear
End Sub

Private Sub txtIPBereich_GotFocus(Index As Integer)
  Gotfokus txtIPBereich(Index)
End Sub

Private Sub txtIPBereich_KeyDown(Index As Integer, KeyCode _
     As Integer, Shift As Integer)
  If KeyCode = 27 Or KeyCode = 38 Then SendKeys "+" & vbTab
  If KeyCode = 13 Or KeyCode = 40 Then SendKeys vbTab
End Sub

Private Sub txtIPBereich_KeyPress(Index As Integer, KeyAscii _
     As Integer)
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And _
     KeyAscii <> 46 Then KeyAscii = 0
  If KeyAscii = 13 Or KeyAscii = 27 Then KeyAscii = 0
End Sub

Private Sub txtIPBereich_LostFocus(Index As Integer)
  txtIPBereich(Index).Text = Val(txtIPBereich(Index).Text)
  If Val(txtIPBereich(0).Text) > 255 Then _
     txtIPBereich(0).Text = "255"
  If Val(txtIPBereich(1).Text) > 255 Then _
     txtIPBereich(1).Text = "255"
  If Val(txtIPBereich(0).Text) < 1 Then txtIPBereich(0).Text = "1"
  If Val(txtIPBereich(1).Text) < 1 Then txtIPBereich(1).Text = "1"
End Sub

Private Sub txtMAC_Change()
  If txtMAC.Text = "" Then
    cmdWakeUp.Enabled = False
  Else
    cmdWakeUp.Enabled = True
  End If
End Sub
 
Wichtiger Hinweis
Der aufzuweckenden Rechner muss ein ATX-Netzteil besitzen, und im Bios muss der Menüpunkt "Wake On Lan" enabled sein.  Befindet sich die Netzwerkkarte auf dem Board, sind keine weiteren Maßnahmen nötig. Besitzt der Rechner eine gesteckte Netzwerkkarte, muss diese mit dem mitgelieferten WOL-Kabel ans Board angeschlossen werden.

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (14,5 kB) Downloads bisher: [ 627 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 27. August 2011