skea
Registered User.
- Local time
- Today, 22:20
- Joined
- Dec 21, 2004
- Messages
- 342
I got this code from some where to Shutdown a Network Machine Remotely.
Amazingly, its not working and I dont know whats wrong with it. has someone done this before!
I would like to know whats wrong with it.
Amazingly, its not working and I dont know whats wrong with it. has someone done this before!
I would like to know whats wrong with it.
Code:
Option Compare Database
Option Explicit
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const NERR_SUCCESS As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&
Private Const SV_TYPE_ALL As Long = &HFFFFFFFF
Private Const MAX_COMPUTERNAME As Long = 16
Private Type SERVER_INFO_100
sv100_platform_id As Long
sv100_name As Long
End Type
Private Declare Function NetServerEnum Lib "Netapi32" _
(ByVal servername As Long, _
ByVal level As Long, _
buf As Any, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
ByVal servertype As Long, _
ByVal domain As Long, _
resume_handle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" _
(ByVal Buffer As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pTo As Any, uFrom As Any, _
ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Declare Function InitiateSystemShutdown Lib "advapi32.dll" _
Alias "InitiateSystemShutdownA" _
(ByVal lpMachineName As String, _
ByVal lpMessage As String, _
ByVal dwTimeout As Long, _
ByVal bForceAppsClosed As Long, _
ByVal bRebootAfterShutdown As Long) As Long
Private Declare Function AbortSystemShutdown Lib "advapi32.dll" _
Alias "AbortSystemShutdownA" _
(ByVal lpMachineName As String) As Long
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Private Sub Form_Load()
Dim sLocalMachine As String
sLocalMachine = GetLocalComputerName()
Call GetServers(sLocalMachine, Combo1)
'invoke the check1 click event to set
'the initial control states
Me.Check1 = True
Me.Check1 = True
End Sub
Private Sub Command1_Click()
Dim sMachine As String
Dim sAlertMessage As String
Dim dwDelay As Long
Dim dwForce As Long
Dim dwReboot As Long
Dim dwSuccess As Long
'set up the parameters
sMachine = Me.Combo1
'alternate formats:
'sMachine = "192.168.1.101"
'sMachine = Combo1.List(Combo1.ListIndex)
Me.Text1.SetFocus
sAlertMessage = Me.Text1
dwForce = Abs(Check2 = True)
dwReboot = Abs(Check3 = True)
'cause you're bound to forget!
If Me.Combo2.Value > -1 Then
dwDelay = Val(Me.Combo2)
Else
dwDelay = 30
End If
'success will be non-zero if successful.
'Err.LastDllError will return the error
'code if a problem, eg 5 - access denied.
dwSuccess = InitiateSystemShutdown(sMachine, sAlertMessage, dwDelay, dwForce, dwReboot)
'prevent changing the machine name in case
'an abort is desired, and enable the abort button
Me.Combo1.Enabled = dwSuccess = 0
Me.Command1.Enabled = dwSuccess = 0
Me.Command2.Enabled = dwSuccess <> 0
End Sub
Private Sub Command2_Click()
Dim sMachine As String
sMachine = Me.Combo1
AbortSystemShutdown sMachine
Me.Combo1.Enabled = True
Me.Command1.Enabled = True
Me.Command2.Enabled = False
End Sub
Private Sub Check1_Click()
Me.Check2.Enabled = True
Me.Check3.Enabled = True
Me.Command1.Enabled = True
Me.Command2.Enabled = False
End Sub
Private Function GetServers(sLocalMachine As String, ctl As Control) As Long
'list all machines of the specified type
'that are visible in the domain/workgroup
Dim bufptr As Long
Dim dwEntriesread As Long
Dim dwTotalentries As Long
Dim dwResumehandle As Long
Dim se100 As SERVER_INFO_100
Dim success As Long
Dim nStructSize As Long
Dim cnt As Long
Dim tmp As String
nStructSize = LenB(se100)
'Call passing MAX_PREFERRED_LENGTH to have the
'API allocate required memory for the return values.
'The MSDN states servername must be NULL (0&).
success = NetServerEnum(0&, _
100, _
bufptr, _
MAX_PREFERRED_LENGTH, _
dwEntriesread, _
dwTotalentries, _
SV_TYPE_ALL, _
0&, _
dwResumehandle)
'if all goes well
If success = NERR_SUCCESS And _
success <> ERROR_MORE_DATA Then
'loop through the returned data, adding
'each machine to the list
For cnt = 0 To dwEntriesread - 1
'get one chunk of data and cast
'into an LOCALGROUP_INFO_1 type
'in order to add the name to a list
CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize
'if the machine is the local machine, don't bother
'adding it as you can't shut down your own machine
'using InitiateSystemShutdown
'' tmp = LCase$(GetPointerToByteStringW(se100.sv100_name))
''If tmp <> sLocalMachine Then
''ctl.AddItem tmp
''End If
Next
End If
'clean up, regardless of success
Call NetApiBufferFree(bufptr)
End Function
Private Function GetLocalComputerName() As String
Dim tmp As String
'return the name of the computer
tmp = Space$(MAX_COMPUTERNAME)
If GetComputerName(tmp, Len(tmp)) <> 0 Then
GetLocalComputerName = LCase$(TrimNull(tmp))
End If
End Function
Private Function GetPointerToByteStringW(ByVal dwData As Long) As String
Dim tmp() As Byte
Dim tmplen As Long
If dwData <> 0 Then
tmplen = lstrlenW(dwData) * 2
If tmplen <> 0 Then
ReDim tmp(0 To (tmplen - 1)) As Byte
CopyMemory tmp(0), ByVal dwData, tmplen
GetPointerToByteStringW = tmp
End If
End If
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function
Last edited:
