Hola, Albertomi.
Muchas gracias por tu explicación. No tenía idea de lo que comentaste.
Mi aplicación, en condiciones normales y antes de intentar ponerla como servicio, se ejecutaba al iniciar sesión en Windows, de manera invisible (Form.Visible = False) pero con un ícono en la barra de tareas. Entonces, al hacer doble clic sobre el ícono se maximizaba el formulario principal y se ponía visible.
Esto mismo quise hacer pero poniendo la aplicación como servicio de Windows, pero, como comenté, no está funcionando. La aplicación carga y hace lo que tiene que hacer pero no puedo verla.
Te comento, en primer lugar, cómo creo el servicio.
En una pantalla de "DOS" ejecuto lo siguiente:
sc create NombreServicio binpath= "C:\Program Files\Windows Resource Kits\Tools\srvany.exe"
Luego voy al registro de Windows: local machine/system/currentcontrolset/services. Busco el servicio NombreServicio (el que creé) y le agrego una carpeta donde indico la ruta del archivo que quiero que ejecute y otra donde le pongo la ruta + el nombre del archivo que quiero que ejecute.
Finalmente, voy a los servicios de Windows y pongo que este se inicie automáticamente.
También probé tildando la opción "permitir que los servicios interactúen con el escritorio de Windows" pero obtuve casi el mismo resultado. La primera vez que se ejecuta el servicio aparece una ventana donde dice que un servicio incompatible quiere mostrar un mensaje. Cuando le doy al botón "mostrar mensaje" abre el formulario de mi aplicación, pero me obliga a hacer clic en "volver" (de la misma ventana que había aparecido) y a partir de ahí no se puede ver más el form de mi aplicación. Incluso, ejecutando el servicio de nuevo o reiniciando la computadora.
Luego probé con el módulo de clase clsDDE de Leandro, que contiene el siguiente código:
Option Explicit
'Autor: Leandro Ascierto
'Web: www.leandroascierto.com
'Refer: DDE from Cobein(http://www.advancevb.com.ar/)
' SubClass: http://www.activevb.de/tutorials/tut_subclass_asm/tut_subclass_asm.html
' VarType: Oleg Gdalevich http://www.vbip.com/winsock-api/csocket-class/csocket-class-01.asp
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByRef lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32.dll" (ByRef lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function IsWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32.dll" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Const GWL_WNDPROC As Long = -4
Private Const MEM_COMMIT As Long = &H1000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Const MEM_RELEASE As Long = &H8000&
Private Const WM_DESTROY As Long = &H2
Private Const WM_COPYDATA As Long = &H4A
Private Const ENUM_PROPS As Long = &H2222
Private Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Private Type tProp
lpString As String
hData As Long
End Type
Public Event Connected(ByVal hwnd As Long)
Public Event ConnectionRequest(ByVal hwnd As Long)
Public Event ConnectionClose(ByVal hwnd As Long)
Public Event DataArrival(ByVal hwnd As Long, ByVal vData As Variant)
Private WM_CONNECTION_ACEPT As Long
Private WM_CONNECTION_REQUEST As Long
Private WM_CONNECTION_CLOSE As Long
Private pASMWrapper As Long
Private PrevWndProc As Long
Private hWin As Long
Private bConnected As Boolean
Private hServer As Long
Private cConnections As Collection
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Select Case uMsg
Case WM_CONNECTION_REQUEST
RaiseEvent ConnectionRequest(wParam)
Case WM_CONNECTION_CLOSE
Dim i As Long
For i = 1 To cConnections.Count
If cConnections(i) = wParam Then
cConnections.Remove i
Exit For
End If
Next
RaiseEvent ConnectionClose(wParam)
Case WM_CONNECTION_ACEPT
RaiseEvent Connected(wParam)
hServer = wParam
bConnected = True
Case WM_COPYDATA
Dim CDS As COPYDATASTRUCT
Dim arrBuffer() As Byte
Dim varData As Variant
Call CopyMemory(CDS, ByVal lParam, Len(CDS))
ReDim arrBuffer(CDS.cbData - 1)
Call CopyMemory(arrBuffer(0), ByVal CDS.lpData, CDS.cbData)
Select Case CDS.dwData
Case vbArray + vbByte
varData = arrBuffer()
Case vbBoolean
Dim blnData As Boolean
CopyMemory blnData, arrBuffer(0), LenB(blnData)
varData = blnData
Case vbByte
Dim bytData As Byte
CopyMemory bytData, arrBuffer(0), LenB(bytData)
varData = bytData
Case vbCurrency
Dim curData As Currency
CopyMemory curData, arrBuffer(0), LenB(curData)
varData = curData
Case vbDate
Dim datData As Date
CopyMemory datData, arrBuffer(0), LenB(datData)
varData = datData
Case vbDouble
Dim dblData As Double
CopyMemory dblData, arrBuffer(0), LenB(dblData)
varData = dblData
Case vbInteger
Dim intData As Integer
CopyMemory intData, arrBuffer(0), LenB(intData)
varData = intData
Case vbLong
Dim lngData As Long
CopyMemory lngData, arrBuffer(0), LenB(lngData)
varData = lngData
Case vbSingle
Dim sngData As Single
CopyMemory sngData, arrBuffer(0), LenB(sngData)
varData = sngData
Case vbString
Dim strData As String
strData = StrConv(arrBuffer(), vbUnicode)
varData = strData
End Select
RaiseEvent DataArrival(wParam, varData)
Case WM_DESTROY
Call StopListen
End Select
WindowProc = CallWindowProc(PrevWndProc, hwnd, uMsg, wParam, lParam)
End Function
Public Function StartListen(ByVal sKey As String) As Boolean
If FindWindow("Static", sKey) <> 0 Then: Exit Function
If PrevWndProc = 0 And pASMWrapper <> 0 Then
hWin = CreateWindowEx(0, "Static", sKey, 0, 0, 0, 0, 0, 0, 0, App.hInstance, 0&)
PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, pASMWrapper)
StartListen = PrevWndProc <> 0
End If
End Function
Public Sub StopListen()
If PrevWndProc <> 0 Then
Call RemoveAllClient
If IsWindow(hServer) Then
Call SendMessage(hServer, WM_CONNECTION_CLOSE, Me.hwnd, ByVal 0&)
hServer = 0
End If
Call SetWindowLong(hWin, GWL_WNDPROC, PrevWndProc): PrevWndProc = 0
Call DestroyWindow(hWin): hWin = 0
End If
End Sub
Public Sub Disconnect()
If bConnected Then
Call SendMessage(hServer, WM_CONNECTION_CLOSE, Me.hwnd, ByVal 0&)
StopListen
bConnected = False
hServer = 0
End If
End Sub
Public Function AddClient(ByVal hwnd As Long) As Boolean
' If IsWindow(hwnd) And Me.hwnd <> 0 Then
If Me.hwnd <> 0 Then
If SendMessage(hwnd, WM_CONNECTION_ACEPT, Me.hwnd, ByVal 0&) = 0 Then
cConnections.Add hwnd
AddClient = True
End If
End If
End Function
Public Function RemoveClient(ByVal hwnd As Long) As Boolean
Dim i As Long
For i = 1 To cConnections.Count
If cConnections(i) = hwnd Then
cConnections.Remove i
If IsWindow(hwnd) Then
Call SendMessage(hwnd, WM_CONNECTION_CLOSE, Me.hwnd, ByVal 0&)
End If
RemoveClient = True
Exit For
End If
Next
End Function
Public Sub RemoveAllClient()
Dim i As Long
If cConnections.Count > 0 Then
For i = cConnections.Count To 1 Step -1
If IsWindow(cConnections(i)) Then
Call SendMessage(cConnections(i), WM_CONNECTION_CLOSE, Me.hwnd, ByVal 0&)
End If
cConnections.Remove i
Next
End If
End Sub
Public Property Get ClientCount() As Long
ClientCount = cConnections.Count
End Property
Public Property Get GetClient(Index As Long) As Long
GetClient = cConnections.Item(Index)
End Property
Public Property Get hwnd() As Long
hwnd = hWin
End Property
Public Property Get hwndSever() As Long
hwndSever = hServer
End Property
Public Function Join(ByVal DestWindow As Variant) As Long
Dim hwnd As Long
If IsNumeric(DestWindow) Then
hwnd = DestWindow
Else
hwnd = FindWindow("Static", DestWindow)
End If
If IsWindow(hwnd) And bConnected = False Then
If StartListen(App.ThreadID) Then
Join = SendMessage(hwnd, WM_CONNECTION_REQUEST, hWin, ByVal 0&) = 0
End If
End If
End Function
Public Sub BroadcastData(ByVal varData As Variant)
Dim i As Long
For i = 1 To cConnections.Count
Call SendData(cConnections(i), varData)
Next
End Sub
Public Function SendData(ByVal DestWindow As Variant, ByVal varData As Variant) As Boolean
Dim CDS As COPYDATASTRUCT
Dim hwnd As Long
Dim arrData() As Byte
If IsNumeric(DestWindow) Then
hwnd = DestWindow
Else
hwnd = FindWindow("Static", DestWindow)
End If
If IsWindow(hwnd) Then
Select Case VarType(varData)
Case vbArray + vbByte
arrData() = varData
Case vbBoolean
Dim blnData As Boolean
blnData = CBool(varData)
ReDim arrData(LenB(blnData) - 1)
CopyMemory arrData(0), blnData, LenB(blnData)
Case vbByte
Dim bytData As Byte
bytData = CByte(varData)
ReDim arrData(LenB(bytData) - 1)
CopyMemory arrData(0), bytData, LenB(bytData)
Case vbCurrency
Dim curData As Currency
curData = CCur(varData)
ReDim arrData(LenB(curData) - 1)
CopyMemory arrData(0), curData, LenB(curData)
Case vbDate
Dim datData As Date
datData = CDate(varData)
ReDim arrData(LenB(datData) - 1)
CopyMemory arrData(0), datData, LenB(datData)
Case vbDouble
Dim dblData As Double
dblData = CDbl(varData)
ReDim arrData(LenB(dblData) - 1)
CopyMemory arrData(0), dblData, LenB(dblData)
Case vbInteger
Dim intData As Integer
intData = CInt(varData)
ReDim arrData(LenB(intData) - 1)
CopyMemory arrData(0), intData, LenB(intData)
Case vbLong
Dim lngData As Long
lngData = CLng(varData)
ReDim arrData(LenB(lngData) - 1)
CopyMemory arrData(0), lngData, LenB(lngData)
Case vbSingle
Dim sngData As Single
sngData = CSng(varData)
ReDim arrData(LenB(sngData) - 1)
CopyMemory arrData(0), sngData, LenB(sngData)
Case vbString
Dim strData As String
strData = CStr(varData)
ReDim arrData(Len(strData) - 1)
arrData() = StrConv(strData, vbFromUnicode)
End Select
With CDS
.dwData = VarType(varData)
.cbData = UBound(arrData) + 1
.lpData = VarPtr(arrData(0))
End With
SendData = SendMessage(hwnd, WM_COPYDATA, hWin, CDS) = 0
End If
End Function
Private Sub Class_Initialize()
Dim ASM(0 To 103) As Byte
Dim pVar As Long
Dim ThisClass As Long
Dim CallbackFunction As Long
Dim pVirtualFree
Dim i As Long
Dim sCode As String
pASMWrapper = VirtualAlloc(ByVal 0&, 104, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
If pASMWrapper <> 0 Then
ThisClass = ObjPtr(Me)
Call CopyMemory(pVar, ByVal ThisClass, 4)
Call CopyMemory(CallbackFunction, ByVal (pVar + 28), 4)
pVirtualFree = GetProcAddress(GetModuleHandle("kernel32.dll"), "VirtualFree")
sCode = "90FF05000000006A0054FF742418FF742418FF742418FF7424186800000000B800000000FFD0FF0D00000000A10000000085C075" & _
"0458C21000A10000000085C0740458C2100058595858585868008000006A00680000000051B800000000FFE00000000000000000"
For i = 0 To Len(sCode) - 1 Step 2
ASM(i / 2) = CByte("&h" & Mid$(sCode, i + 1, 2))
Next
Call CopyMemory(ASM(3), pASMWrapper + 96, 4)
Call CopyMemory(ASM(40), pASMWrapper + 96, 4)
Call CopyMemory(ASM(58), pASMWrapper + 96, 4)
Call CopyMemory(ASM(45), pASMWrapper + 100, 4)
Call CopyMemory(ASM(84), pASMWrapper, 4)
Call CopyMemory(ASM(27), ThisClass, 4)
Call CopyMemory(ASM(32), CallbackFunction, 4)
Call CopyMemory(ASM(90), pVirtualFree, 4)
Call CopyMemory(ByVal pASMWrapper, ASM(0), 104)
WM_CONNECTION_REQUEST = RegisterWindowMessage("WM_CONNECTION_REQUEST")
WM_CONNECTION_CLOSE = RegisterWindowMessage("WM_CONNECTION_CLOSE")
WM_CONNECTION_ACEPT = RegisterWindowMessage("WM_CONNECTION_ACEPT")
Set cConnections = New Collection
End If
End Sub
Private Sub Class_Terminate()
Dim Counter As Long
If pASMWrapper <> 0 Then
Call StopListen
Call CopyMemory(Counter, ByVal (pASMWrapper + 104), 4)
If Counter = 0 Then
Call VirtualFree(ByVal pASMWrapper, 0, MEM_RELEASE)
Else
Call CopyMemory(ByVal (pASMWrapper + 108), 1, 4)
End If
End If
End Sub
Desde un aplicativo le pasaba el parámetro "maximizar" y la aplicación en cuestión lo recibía, ejecutaba el código para maximizarse y visibilizarse, pero no pasaba nada (no se veía). Me daba cuenta porque a cada paso le puse instrucciones para que escriba un log para ver dónde se detenía y llegaba a ejecutar todo, pero seguía sin mostrarse.
En Windows XP funciona perfectamente, pero en Windows 2008 Server Einterprise no.
Espero haber sido claro. Si necesitás alguna otra información, por favor decime y la brindo.
Muchas gracias por tu tiempo.
Jerónimo
