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
|
|
|
|
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: [ 678 ]
|
|
|