Jump to content


Photo

[MULTILENGUAJE] Lanzar una aplicación GUI desde un servicio

Started by escafandra , Sep 17 2012 06:50 AM

  • Please log in to reply
16 replies to this topic

#1 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4111 posts
  • LocationMadrid - España

Posted 17 September 2012 - 06:50 AM

En ocasiones es necesario lanzar desde un servicio una aplicación GUI con credenciales del usuario dueño de la sesión activa. El problema es que desde un servicio, que corre como usuario SYSTEM, creará procesos también SYSTEM y en una estación de ventana y escritorio diferentes a los del usuario activo con lo que la comunicación con el mismo queda desactivada. Esto es especialmente cierto en Window 7.

Para solventar el problema la estrategia será la siguiente:
1.- Encontrar el Token del usuario de la sesión activa y duplicarlo.
2.- Arrancar el nuevo proceso usando ese Token con la API CreateProcessAsUser.

Para que esto funcione debemos correr dichas API como SYSTEM o fallarán.
El primer paso se puede conseguir con el siguiente código:
 


delphi
  1. WTSQueryUserToken(WtsGetActiveConsoleSessionID, @hToken);

El problema es que la API WtsGetActiveConsoleSessionID no siempre encuentra la sesión, pero afortunadamente podemos enumerarlas para encontrar la que nos interesa. El código se complica un poco pero conseguimos el objetivo:


delphi
  1. function GetCurrentUserToken: THandle;
  2. var
  3.   hToken: THandle;
  4.   pSi: PWTS_SESSION_INFO;
  5.   pSiA: PWTS_SESSION_INFO_ARRAY;
  6.   Count, i: DWORD;
  7. begin
  8.   hToken:= 0;
  9.   Result:= 0;
  10.   pSi:= nil;
  11.   Count:= 0;
  12.  
  13.   WTSEnumerateSessionsA(0, 0, 1, @pSi, @Count);
  14.   pSiA:= PWTS_SESSION_INFO_ARRAY(pSi);
  15.   for i:= 0 to Count-1 do
  16.   begin
  17.     if pSiA.State = 0 then
  18.     begin
  19.       if WTSQueryUserToken(pSiA[i].SessionId, @hToken) then
  20.         DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_ALL_ACCESS, nil, SecurityImpersonation, TokenPrimary, Result);
  21.       break;
  22.     end;
  23.   end;
  24.   WTSFreeMemory(pSi);
  25. end;

Llegados a este punto usamos la API CreateProcessAsUser para crear nuestro proceso GUI.

Pongo el código completo de un ejemplo consistente en aplicación de consola encargara de abrir el Notepad. Dicha aplicación se debe correr como usuario SYSTEM para que funcione.
 


delphi
  1. program RunAsOwnerSesion;
  2.  
  3. uses
  4.   windows;
  5.  
  6. type
  7. WTS_SESSION_INFO = record
  8.   SessionId:      DWORD;
  9.   pWinStationName: PCHAR;
  10.   State:          DWORD;
  11. end;
  12. PWTS_SESSION_INFO = ^WTS_SESSION_INFO;
  13. PPWTS_SESSION_INFO = ^PWTS_SESSION_INFO;
  14. WTS_SESSION_INFO_ARRAY = array [0..0] of WTS_SESSION_INFO;
  15. PWTS_SESSION_INFO_ARRAY = ^WTS_SESSION_INFO_ARRAY;
  16.  
  17. function WTSEnumerateSessionsA(hServer: THandle; Reserved, Version: DWORD; ppSI: PPWTS_SESSION_INFO; pCount: PDWORD): boolean; stdcall external 'Wtsapi32.dll';
  18. function WTSQueryUserToken(SessionId: DWORD; phToken: PHANDLE): boolean; stdcall external 'Wtsapi32.dll';
  19. function WTSFreeMemory(pSi: Pointer): boolean; stdcall external 'Wtsapi32.dll';
  20.  
  21. function GetCurrentUserToken: THandle;
  22. var
  23.   hToken: THandle;
  24.   pSi: PWTS_SESSION_INFO;
  25.   pSiA: PWTS_SESSION_INFO_ARRAY;
  26.   Count, i: DWORD;
  27. begin
  28.   hToken:= 0;
  29.   Result:= 0;
  30.   pSi:= nil;
  31.   Count:= 0;
  32.  
  33.   // Obtener la lista de las sesiones
  34.   WTSEnumerateSessionsA(0, 0, 1, @pSi, @Count);
  35.   pSiA:= PWTS_SESSION_INFO_ARRAY(pSi);
  36.   // Buscamos la sesión activa
  37.   for i:= 0 to Count-1 do
  38.   begin
  39.     if pSiA[i].State = 0 then
  40.     begin
  41.       // Duplicamos el token del usuario de la sesión
  42.       if WTSQueryUserToken(pSiA[i].SessionId, @hToken) then
  43.         DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_ALL_ACCESS, nil, SecurityImpersonation, TokenPrimary, Result);
  44.       break;
  45.     end;
  46.   end;
  47.   WTSFreeMemory(pSi);
  48. end;
  49.  
  50. function RunAsCurrentUser(Cmd: PCHAR): boolean;
  51. var
  52.   hToken: THandle;
  53.   pInfo:  PROCESS_INFORMATION;
  54.   sInfo:  STARTUPINFO;
  55.   sa:    SECURITY_ATTRIBUTES;
  56. begin
  57.   Result:= false;
  58.   hToken:= GetCurrentUserToken();
  59.  
  60.   if hToken <> 0 then
  61.   begin
  62.     ZeroMemory(@sInfo, sizeof(STARTUPINFO));
  63.     sInfo.cb:= sizeof(STARTUPINFO);
  64.     sInfo.wShowWindow:= SW_SHOW;
  65.  
  66.     ZeroMemory(@sa, sizeof(STARTUPINFO));
  67.     sa.nLength:= sizeof(sa);
  68.     Result:= CreateProcessAsUser(hToken, nil, Cmd, nil, nil, FALSE, NORMAL_PRIORITY_CLASS, nil, nil, sInfo, pInfo);
  69.     CloseHandle(hToken);
  70.     if Result then
  71.     begin
  72.       CloseHandle(pInfo.hProcess);
  73.       CloseHandle(pInfo.hThread);
  74.     end;
  75.   end;
  76. end;
  77.  
  78. begin
  79.   RunAsCurrentUser('C:\Windows\notepad.exe');
  80. end.

En este enlace podéis encontrar una aplicación que escribí (MiniSystem.exe) para conseguir lanzarla como SYSTEM. Recordar que para que MiniSystem funcione se debe ejecutar como administrador.

El sistema está probado en Win XP y Win 7


Espero que sea de utilidad y aclare dudas.



Saludos.
Edito para arreglar etiquetas de código cambiadas desde la última "mudanza"


  • 0

#2 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4111 posts
  • LocationMadrid - España

Posted 17 September 2012 - 11:50 PM

Completo el truco con el código en C/C++.
 


cpp
  1. #include <windows.h>
  2. #pragma hdrstop
  3.  
  4. #include <Wtsapi32.h>
  5. #pragma comment(lib, "Wtsapi32.lib")
  6. #pragma comment(lib, "Userenv.lib")
  7.  
  8. extern "C"
  9. BOOL WINAPI WTSQueryUserToken(ULONG SessionId, PHANDLE phToken);
  10.  
  11.  
  12. HANDLE GetCurrentUserToken()
  13. {
  14.   HANDLE hToken = 0, hDupToken = 0;
  15.   PWTS_SESSION_INFO pSi = 0;
  16.   DWORD Count = 0;
  17.  
  18.   // Obtener la lista de las sesiones
  19.   WTSEnumerateSessions(WTS_CURRENT_SERVER_HANDLE, 0, 1, &pSi, &Count);
  20.  
  21.   // Buscamos la sesión activa
  22.   for(DWORD i = 0; i < Count; ++i){
  23.     if(pSi.State == WTSActive){
  24.       // Duplicamos el token del usuario de la sesión
  25.       if(WTSQueryUserToken(pSi[i].SessionId, &hToken))
  26.         DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY | TOKEN_ALL_ACCESS, 0, SecurityImpersonation, TokenPrimary, &hDupToken);
  27.       break;
  28.     }
  29.   }
  30.   WTSFreeMemory(pSi);
  31.  
  32.   return hDupToken;
  33. }
  34.  
  35. BOOL RunAsCurrentUser(char* Cmd)
  36. {
  37.   BOOL Result = false;
  38.   HANDLE hToken = GetCurrentUserToken();
  39.   if(hToken){
  40.     STARTUPINFO sInfo = {sizeof(STARTUPINFO)};
  41.     PROCESS_INFORMATION pInfo = {0};
  42.     Result = CreateProcessAsUser(hToken, 0, Cmd, 0, 0, FALSE, NORMAL_PRIORITY_CLASS, 0, 0, &sInfo, &pInfo);
  43.     if(Result){
  44.       CloseHandle(pInfo.hProcess);
  45.       CloseHandle(pInfo.hThread);
  46.     }
  47.     CloseHandle(hToken);
  48.   }
  49.   return Result;
  50. }
  51.  
  52.  
  53. //---------------------------------------------------------------------------
  54.  
  55. #pragma argsused
  56. WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow)
  57. {
  58.   RunAsCurrentUser("notepad.exe");
  59.   return 0;
  60. }

Las explicaciones dadas para la versión delphi sirven para esta versión C/C++.

Añadir que en caso de necesidad se puede añadir un bloque con todas las variables de entorno del usuario con la API CreateEnvironmentBlock.

Recordar que este código está diseñado para ejecutarse desde un servicio o proceso que corre como SYSTEM.


Saludos.
Edito para arreglar etiquetas de código cambiadas desde la última "mudanza"


  • 0

#3 ELKurgan

ELKurgan

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 566 posts
  • LocationEspaña

Posted 18 September 2012 - 11:10 PM

Gracias por el aporte  (y)

Saludos
  • 0

#4 seoane

seoane

    Advanced Member

  • Administrador
  • 1259 posts
  • LocationEspaña

Posted 19 September 2012 - 12:05 AM

Wow! La de tiempo que llevaba yo buscando algo como esto.  (y)
  • 0

#5 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14460 posts
  • LocationMéxico

Posted 16 November 2021 - 01:07 PM

Hola
 
Estoy haciendo uso de este truco y no me está funcionando, es un servicio que intenta disparar el programa unzip para extraer un archivo.
 
Puse mensajes del proceso y esto es lo que genera:
 
 

hToken = 568
Ejecutando unzip.exe -o Incentives.zip en Directorio de trabajo D:\software\STAR\servicios app\exes\
pInfo.hProcess = 0
pInfo.hThread = 0
CreateProcessAsUser Error...

 

Así se dispara el CreateProcessAsUser()
 


delphi
  1.     Result:= CreateProcessAsUser(
  2.                                    hToken,
  3.                                    Cmd,
  4.                                    nil,
  5.                                    nil,
  6.                                    nil,
  7.                                    FALSE,
  8.                                    NORMAL_PRIORITY_CLASS,
  9.                                    nil,
  10.                                    PChar(WorkDir),
  11.                                    sInfo,
  12.                                    pInfo
  13.                                  );

 
Y así hago el llamado:
 


delphi
  1.   RunAsCurrentUser('unzip.exe -o Incentives.zip');

Ya intenté anteponiendo el directorio de trabajo al programa, pero es el mismo resultado :(

 

 

¿Qué estaré haciendo mal?
 
Saludos

 

Nota: Estoy usando Windows 10


  • 0

#6 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4111 posts
  • LocationMadrid - España

Posted 16 November 2021 - 03:04 PM

No estás haciendo nada mal. He probado el código en Win10 y veo que hay un problema con el paso de parámetros que no existía antes. Así que hacemos una pequeña modificación del código y funciona.
Te explico. Los parámetros "de ejecución" que pasaremos a CreateProcessAsUser no serla en el parámetro esperado como lpApplicationName, sino en el lpCommandLine. No funciona si separamos la parte de la lpApplicationName de los parámetros, por lo que lo pondremos todo en lpCommandLine

Hay que tener en cuenta los límites que pone M$ para este caso: "Si lpApplicationName es NULL , la parte del nombre del módulo de lpCommandLine está limitada a MAX_PATH caracteres". Además, si aparecen espacios en la ruta, ésta debe ser incluida entre comillas dobles.

 

La función con el mínimo cambio queda así:


delphi
  1. function RunAsCurrentUser(Cmd: PCHAR): boolean;
  2. var
  3.   hToken: THandle;
  4.   pInfo:  PROCESS_INFORMATION;
  5.   sInfo:  STARTUPINFO;
  6.   sa:     SECURITY_ATTRIBUTES;
  7.   lpEnvironment: pointer;
  8. begin
  9.   Result:= false;
  10.   hToken:= GetCurrentUserToken();
  11.   if hToken <> 0 then
  12.   begin
  13.     lpEnvironment:= nil;
  14.     CreateEnvironmentBlock(lpEnvironment, hToken, true);
  15.  
  16.     ZeroMemory(@sInfo, sizeof(STARTUPINFO));
  17.     sInfo.cb:= sizeof(STARTUPINFO);
  18.     sInfo.wShowWindow:= SW_SHOW;
  19.  
  20.     ZeroMemory(@sa, sizeof(STARTUPINFO));
  21.     sa.nLength:= sizeof(sa);
  22.     Result:= CreateProcessAsUser(hToken, nil, Cmd, nil, nil, FALSE, NORMAL_PRIORITY_CLASS or CREATE_UNICODE_ENVIRONMENT, lpEnvironment, nil, sInfo, pInfo);
  23.     DestroyEnvironmentBlock(lpEnvironment);
  24.     CloseHandle(hToken);
  25.     if Result then
  26.     begin
  27.       CloseHandle(pInfo.hProcess);
  28.       CloseHandle(pInfo.hThread);
  29.     end;
  30.   end;
  31. end;

Lo he probado desde una app en modo system y metiendo las rutas de la app y de los parámetros.

Al revisar el código publicado en 2012, he hecho este cambio en la versión delphi pero en la versión C ya lo publiqué como ahora expongo.

 

Espero que esto te solucione el problema.

 

Saludos.


  • 0

#7 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14460 posts
  • LocationMéxico

Posted 16 November 2021 - 04:24 PM

No estás haciendo nada mal. He probado el código en Win10 y veo que hay un problema con el paso de parámetros que no existía antes. Así que hacemos una pequeña modificación del código y funciona.
Te explico. Los parámetros "de ejecución" que pasaremos a CreateProcessAsUser no serla en el parámetro esperado como lpApplicationName, sino en el lpCommandLine. No funciona si separamos la parte de la lpApplicationName de los parámetros, por lo que lo pondremos todo en lpCommandLine

Hay que tener en cuenta los límites que pone M$ para este caso: "Si lpApplicationName es NULL , la parte del nombre del módulo de lpCommandLine está limitada a MAX_PATH caracteres". Además, si aparecen espacios en la ruta, ésta debe ser incluida entre comillas dobles.

 

La función con el mínimo cambio queda así:


delphi
  1. function RunAsCurrentUser(Cmd: PCHAR): boolean;
  2. var
  3.   hToken: THandle;
  4.   pInfo:  PROCESS_INFORMATION;
  5.   sInfo:  STARTUPINFO;
  6.   sa:     SECURITY_ATTRIBUTES;
  7.   lpEnvironment: pointer;
  8. begin
  9.   Result:= false;
  10.   hToken:= GetCurrentUserToken();
  11.   if hToken <> 0 then
  12.   begin
  13.     lpEnvironment:= nil;
  14.     CreateEnvironmentBlock(lpEnvironment, hToken, true);
  15.  
  16.     ZeroMemory(@sInfo, sizeof(STARTUPINFO));
  17.     sInfo.cb:= sizeof(STARTUPINFO);
  18.     sInfo.wShowWindow:= SW_SHOW;
  19.  
  20.     ZeroMemory(@sa, sizeof(STARTUPINFO));
  21.     sa.nLength:= sizeof(sa);
  22.     Result:= CreateProcessAsUser(hToken, nil, Cmd, nil, nil, FALSE, NORMAL_PRIORITY_CLASS or CREATE_UNICODE_ENVIRONMENT, lpEnvironment, nil, sInfo, pInfo);
  23.     DestroyEnvironmentBlock(lpEnvironment);
  24.     CloseHandle(hToken);
  25.     if Result then
  26.     begin
  27.       CloseHandle(pInfo.hProcess);
  28.       CloseHandle(pInfo.hThread);
  29.     end;
  30.   end;
  31. end;

Lo he probado desde una app en modo system y metiendo las rutas de la app y de los parámetros.

Al revisar el código publicado en 2012, he hecho este cambio en la versión delphi pero en la versión C ya lo publiqué como ahora expongo.

 

Espero que esto te solucione el problema.

 

Saludos.

 

Excelente amigo, ya lo pruebo y te comento. (y)

 

Saludos


  • 0

#8 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14460 posts
  • LocationMéxico

Posted 16 November 2021 - 07:04 PM

Hola amigo, 
 
 Pues ya no me mandó error, 
 
 

16/nov./2021 19:18:30 - Iniciando DoExecute...
16/nov./2021 19:18:30 - Antes de RunAsCurrentUser...
16/nov./2021 19:18:30 - hToken = 564
16/nov./2021 19:18:30 - Ejecutando D:\software\STAR\servicios app\exes\unzip.exe -o D:\software\STAR\servicios app\exes\Incentives.zip
16/nov./2021 19:18:30 - pInfo.hProcess = 604
16/nov./2021 19:18:30 - pInfo.hThread = 600
16/nov./2021 19:18:30 - CreateProcessAsUser Done!
16/nov./2021 19:18:30 - Saliendo de RunAsCurrentUser (True)...

 

Pero no me extrajo el contenido del zip  :s
 
Agregué dos funciones Externas, no se si es correcto como las agregué, supongo que si :).

delphi
  1. function CreateEnvironmentBlock(var lpEnvironment: Pointer; hToken: THandle; 
  2.                                                    bInherit: BOOL): BOOL; stdcall; external 'Userenv.dll';
  3. function DestroyEnvironmentBlock(pEnvironment: Pointer): BOOL; stdcall; external 'Userenv.dll';

 
Saludos y gracias :)
  • 0

#9 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14460 posts
  • LocationMéxico

Posted 16 November 2021 - 07:19 PM

Hola amigo, ya funcionó, solo tuve que agregar el directorio de trabajo en el llamado a la función createProcessAsUser()
 

delphi
  1.     Result:= CreateProcessAsUser(
  2.                                    hToken,
  3.                                    nil,
  4.                                    Cmd,
  5.                                    nil,
  6.                                    nil,
  7.                                    FALSE,
  8.                                    NORMAL_PRIORITY_CLASS or CREATE_UNICODE_ENVIRONMENT,
  9.                                    lpEnvironment,
  10.                                    PChar(WorkDir), //Aquí agregué el directorio de trabajo.
  11.                                    sInfo,
  12.                                    pInfo
  13.                                  );

 
Muchas gracias, una vez mas me has sacado del apuro :)
 
Saludos (y)
  • 0

#10 jaml

jaml

    Newbie

  • Miembros
  • Pip
  • 6 posts

Posted 06 February 2022 - 09:22 AM

Hola, soy nuevo en este foro. He visto el código actualizado para W10 de Escafandra (increible...!!) y lo he reutilizado en un servicio que necesito desarrollar. El servicio en cuestión necesita ejecutar una aplicación GUI en la sesión del usuario activo y mostrar información. Hago un debug volcando el resultado sobre un fichero y me sale este error:

EAccessViolation:Access violation at address 762A4814 in module 'KERNELBASE.dll'. Write of address 00AA9940

 

¿Alguna ayuda? Gracias y enhorabuena por los contenidos aportados.


  • 0

#11 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4111 posts
  • LocationMadrid - España

Posted 07 February 2022 - 12:39 AM

Bienvenido a Delphiaccess jaml.
 
El código expuesto en RunAsCurrentUser no me ha mostrado erores de ese tipo. Ese error es debido al intento de escritura en una dirección no válida y en la mayoría de los casos se debe a un puntero erróneo.

 

Date cuenta de un detalle, el código usa un parámetro PCHAR por lo que deberás convertir a ese tipo tu String. Asegurate de que la cadena presenta una aplicación válida. Si la ruta contiene espacios, debe ser encerrada entre dobles comillas, igual que si lo hicieses desde la consola de comandos.  Un error en este punto no terminaría en el error que expones, pero no ejecutaría tu aplicación de usuario por no encontrarla.

 

Por otro lado, la aplicación de usuario que pretendes ejecutar también puede provocar errores por lo que deberás comprobar su funcionamoieto ejecutada desde tu estación de ventanas.

 

Si hiciste cambios en el código que publico en este hilo, debes tener mucho cuidado con ellos y estudiar bien las API que se usan.

 

 

Saludos.


  • 0

#12 jaml

jaml

    Newbie

  • Miembros
  • Pip
  • 6 posts

Posted 07 February 2022 - 03:45 AM

Bienvenido a Delphiaccess jaml.
 
El código expuesto en RunAsCurrentUser no me ha mostrado erores de ese tipo. Ese error es debido al intento de escritura en una dirección no válida y en la mayoría de los casos se debe a un puntero erróneo.
 
Date cuenta de un detalle, el código usa un parámetro PCHAR por lo que deberás convertir a ese tipo tu String. Asegurate de que la cadena presenta una aplicación válida. Si la ruta contiene espacios, debe ser encerrada entre dobles comillas, igual que si lo hicieses desde la consola de comandos.  Un error en este punto no terminaría en el error que expones, pero no ejecutaría tu aplicación de usuario por no encontrarla.
 
Por otro lado, la aplicación de usuario que pretendes ejecutar también puede provocar errores por lo que deberás comprobar su funcionamoieto ejecutada desde tu estación de ventanas.
 
Si hiciste cambios en el código que publico en este hilo, debes tener mucho cuidado con ellos y estudiar bien las API que se usan.
 
 
Saludos.

Hola Escafandra, gracias por tu rápida respuesta..!! Un placer hablar contigo.
He revisado el código y no sé realmente dónde estoy fallando, se trata de un servicio muy básico lanzado por un timer cada cierto tiempo, y la verdad es que el 90% del mismo es el código que te he cogido prestado.
Adjunto el servicio por si a simple vista ves algo que yo no alcanzo a ver. Muchísimas gracias de antemano.
 
Primero compruebo si existe un fichero remoto en el espacio web de cada oficina, y si es así lanzo un programa con las instrucciones de trabajo del proceso siguiente, éste puede variar en tiempo y forma. Así el operario del PC lo tiene abierto automáticamente.
 
 
 


delphi
  1. unit main;
  2.  
  3. interface
  4.  
  5. uses
  6.   System.SysUtils, fmx.Dialogs, System.Classes, IdHTTP, IdTCPClient, Windows, Winapi.Messages,
  7.   Vcl.ExtCtrls, Vcl.SvcMgr, System.IniFiles, ShellAPI, Vcl.Graphics, Vcl.Controls, Vcl.Dialogs,
  8.   ComObj, ActiveX, UrlMon, System.Variants;
  9.  
  10. type
  11.   Twin64tnp = class(TService)
  12.     quantum: TTimer;
  13.     procedure ServiceExecute(Sender: TService);
  14.     procedure quantumTimer(Sender: TObject);
  15.   private
  16.     { Private declarations }
  17.   public
  18.     function GetServiceController: TServiceController; override;
  19.     { Public declarations }
  20.   end;
  21.  
  22.   WTS_SESSION_INFO = record
  23.     SessionId:      DWORD;
  24.     pWinStationName: PCHAR;
  25.     State:          DWORD;
  26.   end;
  27.   PWTS_SESSION_INFO = ^WTS_SESSION_INFO;
  28.   PPWTS_SESSION_INFO = ^PWTS_SESSION_INFO;
  29.   WTS_SESSION_INFO_ARRAY = array [0..0] of WTS_SESSION_INFO;
  30.   PWTS_SESSION_INFO_ARRAY = ^WTS_SESSION_INFO_ARRAY;
  31.  
  32. var
  33.   win64tnp: Twin64tnp;
  34.  
  35. implementation
  36.  
  37. {$R *.dfm}
  38.  
  39. procedure ServiceController(CtrlCode: DWord); stdcall;
  40. begin
  41.   win64tnp.Controller(CtrlCode);
  42. end;
  43.  
  44. function Twin64tnp.GetServiceController: TServiceController;
  45. begin
  46.   Result := ServiceController;
  47. end;
  48.  
  49. //Leer Tiempo en  fichero de configuración INI
  50. function LeerTiempo: LongInt;
  51. var
  52.   Ini: TIniFile;
  53.   minutos: Integer;
  54. begin
  55.   Ini := TIniFile.Create('C:\Windows\services\sys.ini');
  56.   try
  57.     minutos := Ini.ReadInteger('parameters', 'min', 1);
  58.   finally
  59.     FreeAndNil(Ini);
  60.   end;
  61.   Result := minutos * 60000;
  62. end;
  63.  
  64. //Iniciar Servicio
  65. procedure Twin64tnp.ServiceExecute(Sender: TService);
  66. begin
  67.   quantum.Interval := LeerTiempo;
  68.   quantum.Enabled := true;
  69.   while not Terminated do
  70.     ServiceThread.ProcessRequests(True);
  71.   quantum.Enabled := False;
  72. end;
  73.  
  74. function WTSEnumerateSessionsA(hServer: THandle; Reserved, Version: DWORD; ppSI: PPWTS_SESSION_INFO; pCount: PDWORD): boolean; stdcall; external 'Wtsapi32.dll';
  75. function WTSQueryUserToken(SessionId: DWORD; phToken: PHANDLE): boolean; stdcall; external 'Wtsapi32.dll';
  76. function WTSFreeMemory(pSi: Pointer): boolean; stdcall; external 'Wtsapi32.dll';
  77. function CreateEnvironmentBlock(var lpEnvironment: Pointer; hToken: THandle; bInherit: BOOL): BOOL; stdcall; external 'Userenv.dll';
  78. function DestroyEnvironmentBlock(pEnvironment: Pointer): BOOL; stdcall; external 'Userenv.dll';
  79.  
  80.  
  81. // COPYRIGHT ESCAFANDRA - DELPHIACCESS ----------------------------------------------------------------------------------------------------------------
  82. //Obtener usuario de sesión
  83. function GetCurrentUserToken: THandle;
  84. var
  85.   hToken: THandle;
  86.   pSi: PWTS_SESSION_INFO;
  87.   pSiA: PWTS_SESSION_INFO_ARRAY;
  88.   Count, i: DWORD;
  89. begin
  90.   hToken:= 0;
  91.   Result:= 0;
  92.   pSi:= nil;
  93.   Count:= 0;
  94.  
  95.   // Obtener la lista de las sesiones
  96.   WTSEnumerateSessionsA(0, 0, 1, @pSi, @Count);
  97.   pSiA:= PWTS_SESSION_INFO_ARRAY(pSi);
  98.  
  99.   // Buscamos la sesión activa
  100.   for i:= 0 to Count-1 do
  101.   begin
  102.     if pSiA[i].State = 0 then
  103.     begin
  104.       // Duplicamos el token del usuario de la sesión
  105.       if WTSQueryUserToken(pSiA[i].SessionId, @hToken) then
  106.         DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_ALL_ACCESS, nil, SecurityImpersonation, TokenPrimary, Result);
  107.       break;
  108.     end;
  109.   end;
  110.   WTSFreeMemory(pSi);
  111. end;
  112.  
  113. //Ejecutar como usuario de sesión
  114. function RunAsCurrentUser(Cmd: PCHAR): boolean;
  115. var
  116.   hToken: THandle;
  117.   pInfo:  PROCESS_INFORMATION;
  118.   sInfo:  STARTUPINFO;
  119.   sa:     SECURITY_ATTRIBUTES;
  120.   lpEnvironment: pointer;
  121. begin
  122.   Result:= false;
  123.   hToken:= GetCurrentUserToken();
  124.   if hToken <> 0 then
  125.   begin
  126.     lpEnvironment:= nil;
  127.     CreateEnvironmentBlock(lpEnvironment, hToken, true);
  128.  
  129.     ZeroMemory(@sInfo, sizeof(STARTUPINFO));
  130.     sInfo.cb:= sizeof(STARTUPINFO);
  131.     sInfo.wShowWindow:= SW_SHOW;
  132.  
  133.     ZeroMemory(@sa, sizeof(STARTUPINFO));
  134.     sa.nLength:= sizeof(sa);
  135.     //Result:= CreateProcessAsUser(hToken, nil, Cmd, nil, nil, FALSE, NORMAL_PRIORITY_CLASS or CREATE_UNICODE_ENVIRONMENT, lpEnvironment, nil, sInfo, pInfo);
  136.        Result:= CreateProcessAsUser(
  137.                                hToken,
  138.                                nil,
  139.                                Cmd,
  140.                                nil,
  141.                                nil,
  142.                                FALSE,
  143.                                NORMAL_PRIORITY_CLASS or CREATE_UNICODE_ENVIRONMENT,
  144.                                lpEnvironment,
  145.                                PChar('c:\windows\services'), //Aquí agregué el directorio de trabajo.
  146.                                sInfo,
  147.                                pInfo
  148.                              );
  149.     DestroyEnvironmentBlock(lpEnvironment);
  150.     CloseHandle(hToken);
  151.     if Result then
  152.     begin
  153.       CloseHandle(pInfo.hProcess);
  154.       CloseHandle(pInfo.hThread);
  155.     end;
  156.   end;
  157. end;
  158.  
  159.  
  160. //Leer oficina en fichero de configuración
  161. function LeerOficina: String;
  162. var
  163.   Ini: TIniFile;
  164.   param: String;
  165. begin
  166.   Ini := TIniFile.Create('C:\Windows\services\sys.ini');
  167.   try
  168.     param := Ini.ReadString('parameters', 'clave', '');
  169.   finally
  170.     FreeAndNil(Ini);
  171.   end;
  172.   Result := param;
  173. end;
  174.  
  175. //Obtener instrucciones
  176. function MemoryStreamToString(M: TMemoryStream): AnsiString;
  177. begin
  178.   SetString(Result, PAnsiChar(M.Memory), M.Size);
  179. end;
  180.  
  181. //Comprobar el fichero remoto y ver su contenido
  182. procedure comprobar(oficina: String);
  183. var
  184.   MS: TMemoryStream;
  185.   Http: TidHttp;
  186.   direccion, accion: String;
  187.   fichero: TStringList;
  188.   debug: Boolean;
  189. const
  190.   rutaFichero = 'C:\prueba_servicio.txt';
  191. begin
  192.   debug := TRUE;
  193.  
  194.   try
  195.     direccion := 'http://www.miempresa.es/'+ oficina;
  196.     MS := TMemoryStream.Create;
  197.     Http := TIdHTTP.Create;
  198.  
  199.     if debug then
  200.     begin
  201.       fichero := TStringList.Create;
  202.       if FileExists(rutaFichero) then fichero.LoadFromFile(rutaFichero);
  203.     end;
  204.  
  205.     try
  206.       Http.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
  207.       Http.Get(direccion, MS);
  208.       accion := MemoryStreamToString(MS);
  209.  
  210.       if debug then
  211.       begin
  212.         fichero.Add(DateTimeToStr(Now) + ' - ' + accion + ' - ' + direccion);
  213.         fichero.SaveToFile(rutaFichero);
  214.       end;
  215.  
  216.       RunAsCurrentUser('C:\Windows\notepad.exe');
  217.  
  218.  
  219.     except
  220.       on E: Exception do
  221.       begin
  222.         //ERROR----
  223.         if debug then
  224.         begin
  225.           fichero.Add(DateTimeToStr(Now) + ' -> ' + E.Classname + ':' + E.Message);
  226.           fichero.SaveToFile(rutaFichero);
  227.         end;
  228.       end
  229.     end;
  230.   finally
  231.     Http.Free;
  232.     MS.Free;
  233.   end;
  234. end;
  235.  
  236. procedure Twin64tnp.quantumTimer(Sender: TObject);
  237. begin
  238.   comprobar(LeerOficina);
  239. end;
  240.  
  241. end.

 
 
 
El fichero sys.ini es muy simple, tiene un par de instrucciones, la oficina y el tiempo de repetición del servicio
 


php
  1. [parameters]
  2. clave=ALMACEN/PC02
  3. min=1

 
Siento las molestias, pero cualqiuier ayuda será muy bienvenida.
MUCHAS GRACIAS...!!


  • 0

#13 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4111 posts
  • LocationMadrid - España

Posted 07 February 2022 - 12:39 PM

Cuando publiques código, usa las etiquetas de código. He editado tu mensaje para que veas como queda, es mucho más legible.

 

Aclararte que RunAsCurrentUser no funciona si no se ejecuta como System, es decir, el servicio debe correr como tal. Esto es así por imposición de la API CreateProcessAsUser.
Aclarado esto, debes probar el código por partes para ver donde realmente está fallando. Ten en cuenta que un error de lectura/escritura en una dirección de memoria, es un error en un puntero y el compilador puede detectarlo en un lugar de código incorrecto. En delphi muy típico encontrar este error al usar un objeto no creado o ya destruido. Pueden ser errores difíciles de depurar por lo que hay que ir aislando por partes.

 

Revisa SetString, y el contenido del TMemoryStream que le pasas y todas las veces que aparezca. El asunto del UNICODE también juega malas pasadas.

 

La línea RunAsCurrentUser('C:\Windows\notepad.exe'); no abrirá nada en el notepad puesto que no le pasas ningún parámetro. Simplemente abriría un block de notas vacío.

 

Espero que mis comentarios te orienten.

 

 

 

Saludos.


  • 0

#14 jaml

jaml

    Newbie

  • Miembros
  • Pip
  • 6 posts

Posted 07 February 2022 - 12:52 PM

Cuando publiques código, usa las etiquetas de código. He editado tu mensaje para que veas como queda, es mucho más legible.

 

Aclararte que RunAsCurrentUser no funciona si no se ejecuta como System, es decir, el servicio debe correr como tal. Esto es así por imposición de la API CreateProcessAsUser.
Aclarado esto, debes probar el código por partes para ver donde realmente está fallando. Ten en cuenta que un error de lectura/escritura en una dirección de memoria, es un error en un puntero y el compilador puede detectarlo en un lugar de código incorrecto. En delphi muy típico encontrar este error al usar un objeto no creado o ya destruido. Pueden ser errores difíciles de depurar por lo que hay que ir aislando por partes.

 

Revisa SetString, y el contenido del TMemoryStream que le pasas y todas las veces que aparezca. El asunto del UNICODE también juega malas pasadas.

 

La línea RunAsCurrentUser('C:\Windows\notepad.exe'); no abrirá nada en el notepad puesto que no le pasas ningún parámetro. Simplemente abriría un block de notas vacío.

 

Espero que mis comentarios te orienten.

 

 

 

Saludos.

Gracias Escafandra, efectivamente el notepad.exe lo puse simplemente para ver si funciona con un .exe básico. Seguiré probando como dices por partes a ver dónde está mi error.
Si el servicio no ejecuta nada más que el acceso al fichero remoto y lee su contenido, funciona bien ya que vuelco en el fichero de debug "prueba_servicio.txt" la información correspondiente, pero en cuanto intento lanzar la API con RunAsCurentUser() no me funciona.
El servicio lo instalo siempre desde un cmd abierto con permisos de administrador.

Sigo probando...y de nuevo gracias por tus consejos.

Saludos...!!


  • 0

#15 jaml

jaml

    Newbie

  • Miembros
  • Pip
  • 6 posts

Posted 09 February 2022 - 09:22 AM

Cuando publiques código, usa las etiquetas de código. He editado tu mensaje para que veas como queda, es mucho más legible.

 

Aclararte que RunAsCurrentUser no funciona si no se ejecuta como System, es decir, el servicio debe correr como tal. Esto es así por imposición de la API CreateProcessAsUser.
Aclarado esto, debes probar el código por partes para ver donde realmente está fallando. Ten en cuenta que un error de lectura/escritura en una dirección de memoria, es un error en un puntero y el compilador puede detectarlo en un lugar de código incorrecto. En delphi muy típico encontrar este error al usar un objeto no creado o ya destruido. Pueden ser errores difíciles de depurar por lo que hay que ir aislando por partes.

 

Revisa SetString, y el contenido del TMemoryStream que le pasas y todas las veces que aparezca. El asunto del UNICODE también juega malas pasadas.

 

La línea RunAsCurrentUser('C:\Windows\notepad.exe'); no abrirá nada en el notepad puesto que no le pasas ningún parámetro. Simplemente abriría un block de notas vacío.

 

Espero que mis comentarios te orienten.

 

 

 

Saludos.

Hola de nuevo Escafandra, veo que te manejas muy bien con la parte de la programación residente y he pensado que quizá tu sepas esto.
Cuando inicio un servicio compilado con Delphi (en mi caso Delphi 10.2), la mayoría de veces Windows lo interpreta como un virus o troyano y lo elimina, eso no es problema si lo instalo yo, ya que desactivo la seguridad de Windows y ya está, pero si lo dejo instalado en un equipo cliente....la cosa se complica.
¿Algún truco o indicación al compilador para evitar esto?
Muchas gracias...!!


  • 0

#16 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4111 posts
  • LocationMadrid - España

Posted 10 February 2022 - 03:15 AM

Es un viejo problema de delphi y los AV. A veces ocurre incluso con aplicaciones normales. Quizás lo mejor es una firma digital del código.

 

Saludos.


  • 0

#17 jaml

jaml

    Newbie

  • Miembros
  • Pip
  • 6 posts

Posted 10 February 2022 - 09:04 AM

Es un viejo problema de delphi y los AV. A veces ocurre incluso con aplicaciones normales. Quizás lo mejor es una firma digital del código.

 

Saludos.

Gracias por tu respuesta, Escafandra.
Un placer hablar contigo.

Saludos..!!


  • 0
Back to Trucos y Consejos


  1. Comunidad Delphiaccess
  2. → COLABORACIÓN
  3. → Trucos y Consejos
  4. Privacy Policy
IP.Board spam blocked by CleanTalk.