Respuesta (Equipos en Red)
Publicado por vampy (87 intervenciones) el 26/03/2001 15:35:24
Ya un amigo publicó este algoritmo, mas sin embargo no es el más óptimo:
Este es el código mejorado:
'*****************
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Sub Command1_Click()
On Error Resume Next
Ruta_txt = "d:\equipos.txt"
ejecute = "d:\windows\net view >d:\equipos.txt"
hShell = Shell(Environ$("Comspec") & " /c " & ejecute, vbMinimizedNoFocus)
hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
Do
GetExitCodeProcess hProc, codExit
DoEvents
Loop While codExit = STILL_ACTIVE
Numeroarchivo = FreeFile
Open Ruta_txt For Binary As #Numeroarchivo
While Not EOF(Numeroarchivo)
Line Input #Numeroarchivo, cdna$
Pos = InStr(1, cdna$, "\")
If Pos > 0 Then
Equipos = Equipos & Trim(Mid(cdna$, 1, 17))
If Not Encontrado Then Encontrado = True
End If
Wend
Close #Numeroarchivo
If Encontrado Then
Nombre_Equipos = Split(Equipos, "\\", , vbTextCompare)
For j = 1 To UBound(Nombre_Equipos)
MsgBox Nombre_Equipos(j), vbExclamation
Next
End If
End Sub
'*****************
Este es el código mejorado:
'*****************
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Sub Command1_Click()
On Error Resume Next
Ruta_txt = "d:\equipos.txt"
ejecute = "d:\windows\net view >d:\equipos.txt"
hShell = Shell(Environ$("Comspec") & " /c " & ejecute, vbMinimizedNoFocus)
hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
Do
GetExitCodeProcess hProc, codExit
DoEvents
Loop While codExit = STILL_ACTIVE
Numeroarchivo = FreeFile
Open Ruta_txt For Binary As #Numeroarchivo
While Not EOF(Numeroarchivo)
Line Input #Numeroarchivo, cdna$
Pos = InStr(1, cdna$, "\")
If Pos > 0 Then
Equipos = Equipos & Trim(Mid(cdna$, 1, 17))
If Not Encontrado Then Encontrado = True
End If
Wend
Close #Numeroarchivo
If Encontrado Then
Nombre_Equipos = Split(Equipos, "\\", , vbTextCompare)
For j = 1 To UBound(Nombre_Equipos)
MsgBox Nombre_Equipos(j), vbExclamation
Next
End If
End Sub
'*****************
Valora esta pregunta


0