Tuesday, 26. August 2008, 19:37:02
Que onda, el siguiente programa lo hice a necesidad de que en ocasiones tenia que estar físicamente al tanto de un equipo que se encuentra en producción y por consiguiente no podía realizar otras actividades, para solucionar las fallas que se presentarán la brevedad. Entonces se me ocurrió hacer una miniaplicación que mandará un mensaje a los encargados de sistemas cuando necesitarán ayuda con dicho equipo.
Para lograrlo me basé en el conocido NetSend y en Messenger Service. Acá les dejo el código con algunas explicaciones ... e igual si tienen dudas pues se las podemos resolver.
1. Primero abrimos VB6 y creamos un nuevo proyecto tipo ejecutable, damos doble click sobre nuestro Form1 y pegaremos las siguientes líneas de código justo arriba de nuestro evento load de la forma:
'===================================================
' By Sk0rpy0 (skorpyo.rules@gmail.com)
' Blogger, Geek & More (http://my.opera.com/Skorpyo)
'===================================================
Option Explicit
Const ERROR_SUCCESS = 0
Const ERROR_MORE_DATA = 234
Const SV_TYPE_SERVER = &H2
Const SIZE_SI_101 = 24
Private Type SERVER_INFO_101
dwPlatformId As Long
lpszServerName As Long
dwVersionMajor As Long
dwVersionMinor As Long
dwType As Long
lpszComment As Long
End Type
Private Declare Function NetServerEnum Lib "netapi32.dll" (ByVal servername As String, _
ByVal level As Long, buffer As Long, ByVal prefmaxlen As Long, entriesread As Long, _
totalentries As Long, ByVal servertype As Long, ByVal domain As String, resumehandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (BufPtr As Any) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function lstrcpyW Lib "kernel32" (ByVal lpszDest As String, ByVal lpszSrc As Long) As Long
Private Const NERR_Success As Long = 0&
Private Const NERR_BASE = 2100
Private Const NERR_NameNotFound = NERR_BASE + 173
Private Const NERR_NetworkError = NERR_BASE + 36
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_PARAMETER = 87
Private Const ERROR_NOT_SUPPORTED = 50
Private Declare Function NetMessageBufferSend Lib "netapi32.dll" (servername As Any, _
msgname As Byte, fromname As Any, buf As Byte, ByVal buflen As Long) As Long
Dim Machine As String
Explicación: Lo que hacemos en sí es importar todo lo necesario para que funcione la API de NetSend, y creamos una variable para guardar el nombre de la máquina que realiza la solicitud.
Una vez hecho lo anterior, en el evento Load de nuestra aplicación utilizaremos las siguientes líneas:
Private Sub Form_Load()
Dim nRet As Long
Dim sTo() As Byte
Dim sMsg() As Byte
GetMachineName 'Procedimiento para obtener el nombre de la máquina
Dim i As Integer
Dim IP As String
For i = 1 To 3
If i = 1 Then IP = "10.10.10.10"
If i = 2 Then IP = "10.10.10.11"
If i = 3 Then IP = "10.10.10.12"
sTo = IP & Chr(0)
sMsg = "Se ha presentado una falla en el equipo de: " & Machine & "." + vbCrLf _
+ "Por favor acuda a la brevedad para antender la solicitud." & Chr(0) 'txtMsg & Chr(0)
nRet = NetMessageBufferSend(ByVal 0, sTo(0), ByVal 0, sMsg(0), UBound(sMsg))
Next
Select Case nRet
Case NERR_Success: MsgBox Machine + ": Su solicitud de ayuda ha sido envíada al Departamento de Sistemas." + vbCrLf _
+ "En un momento una persona acudirá a asistirlo.", vbInformation, "Solicitud Enviada"
Case NERR_NameNotFound: MsgBox "No se pudo mandar la solicitud de ayuda, intentelo más tarde", vbCritical, "Solicitud Ayuda"
Case NERR_NetworkError: MsgBox "Se encontró una falla en la red, vuelva a intentarlo mas tarde", vbCritical, "Fallo en el envío de solicitud"
Case ERROR_ACCESS_DENIED: MsgBox "Acceso Denegado a ésta función, posiblemente tenga deshabilitado el servicio", vbCritical, "Acceso Denegado"
Case ERROR_INVALID_PARAMETER: MsgBox "Parámetro Inválido", vbCritical, "Error"
Case ERROR_NOT_SUPPORTED: MsgBox "El envío de mensajes no esta soportado por su equipo", vbCritical, "Error"
Case Else: MsgBox "Se ha encontrado un error inesperado", vbCritical, "Error"
End Select
Unload Me
End Sub
Explicación: * Despues de declarar las variables, vamos al procedimiento para obtener el nombre del equipo.
* A continuación realizo un ciclo para mandar el mensaje a los 3 encargados de sistemas que somos aquí (lo pueden adaptar a sus necesidades).
* Cada vuelta del ciclo mandamos el mismo mensaje cambiando el destinatario en la variable "IP"
* Creamos un Select Case para determinar que mensaje regresa la API de Net Send y especificando las acciones necesarias para cada uno.
* Por último descargamos la forma actual, con lo que se termina la aplicación.
Bien ahora solo queda ejemplificar la función para obtener el nombre de la máquina que la tenemos a continuación:
Sub GetMachineName()
Dim Obj, object As Object
Dim strComputer As String
strComputer = "."
Set Obj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2").ExecQuery("Select * FROM Win32_OperatingSystem")
For Each object In Obj
Machine = object.Description
Next
If Machine = "" Then Machine = InputBox("Introduzca su nombre o área de trabajo. Ésta información será enviada los encargados de sistemas" + vbCrLf _
+ "para agilizar la atención de su solicitud.", "Solicitud de Ayuda")
End Sub
Explicación:* Creamos dos variables tipo Object y una tipo string que guardará la descripción del equipo
* Asignamos las propiedades del sistema Obj
* Guardamos la propiedad Description a nuestra variable Machine y con esto tenemos el dato listo.
NOTA: Estoy obteniendo la Descripción del Equipo y NO el nombre de la máquina (ComputerName); ésto a razones empresariales. Si desean obtener específicamente el nombre en sí, pueden utilizar Environ(5) que nos trae el nombre de la máquina:
Dim Tarray() As String
Dim LongName As String
LongName = Environ(5)
Tarray() = Split(LongName, "=", -1, vbTextCompare)
Machine = Tarray(1) 'Trim(Mid(LongName, 14, (Len(LongName) - 13)))
Una vez hecho todo lo anterior generamos nuestro .exe y al ejecutarlo presentará el siguiente mensaje a los encargados de sistemas:
Y este a quien solicitó la ayuda.
Bien, hasta aquí llegamos con este programa, si les sirve ps k bien estimados
P.S. Como se requiere que este habilitado el servicio de Mensajería (Messenger Service), aquí les dejo las siguientes líneas para que lo activen sin tener que entrar a administrar MiPC. Abrimos notepad y pegamos:
@echo off
sc config messenger start= auto > nul
sc start messenger > nul
if errorlevel 0 (
echo El Servicio de Mensajeria esta habilitado
)
Guardamos como EnableMsnSrv.bat o .cmd y le damos doble click en los equipo que queremos que tengan esta comunicación. Slds.
... pero es bueno saber como hacer las cosas "a pie". Slds.
