PureBasic

Marc,

Permet moi d'être honnête, je te perçois comme un troll.
Si tu détourne la discussion pour insister sur une certaine moralité, ou donner des conseils hors champ, tu me pardonneras, je préfère ne plus te répondre.
J'essaie toujours de ne pas embourber une conversation, que je n'ai pas démarrée, de propos qui à mon sens, n'y ont pas leur places.
Désolé.

J'aime coder...

@Pierre Bellisle
Malheureusement sur le forum français tu risques de te confronter plus d'une fois à ce genre de "bourbier"... Je ne sais pas pourquoi car ses même membres peuvent se montrer très utile et d'une grande aide sur le même forum coté anglais.
Je te conseil donc, pour tes question de ce genre d'aller y faire un tour, tu as plus de chance d'y trouver une aide satisfaisante.
https://www.purebasic.fr/english/

Pierre Bellisle a écrit :Bon, voici le machin en question.

A Windows service that can launch a GUI application in System Administrator mode.

Je l'ai codé en 5.42. Cela fonctionne bien sous Windows 7 et Windows 10.
À partir du service je lance RegEdit sans message d'avertissement UAC.
Soyez prudent, les applications lancées depuis le service auront les droits systèmes, donc plus puissant que ceux d'administrateur.
Il y a plus d'explications à lire au début du code...
De mon coté, tout fonctionne à merveille, bien sûr, c'est à vous de tout vérifier, vous devez assumer tous les risques si vous utilisez ce programme.

Si certains d'entre vous ont de l'expérience avec les services Windows, j'aimerais bien savoir si tout fonctionne bien de votre côté. Je vous remercie à l'avance.

Pierre

Bonjour Pierre, ton code marche bien sous w10 aussi. ton code est propre et agréable à lire.

Salutation G-Rom,

Merci pour ces impressions,
ça me conforte un peu dans l'idée que je n'ai pas oublié trop de détails...

À+

Super code merci!

Heureux d'avoir pu donner un petit coup de main... :-)

Bonjour,

En partant du source de Pierre Bellisle, j'ai créé un service qui permet d’empêcher le process de Compatibilité de Microsoft de s'exécuter.

Code : Tout sélectionner

Procedure serviceThread(idThread.l)
;Here goes the service's job...
; Modifier cette procédure pour ajouter les actions a effectuer
; Call TaskKill.exe /f /im CompatTelRunner.exe
  
  Protected WindowsDirectory.s{#MAX_PATH}
  Protected FullNameExe.s{#MAX_PATH}
  GetWindowsDirectory_(@WindowsDirectory, #MAX_PATH)
  FullNameExe = WindowsDirectory + "\System32\TaskKill.exe"
  Repeat
    RunProgram(FullNameExe, "/f /im CompatTelRunner.exe", #Null$, #PB_Program_Hide)
    Sleep_(2000)
    If #AutoStop
      ServiceStopRaw() ;Used when a service want To End by itself after his job is done
    EndIf
  ForEver
EndProcedure

Les sources sont téléchargeables ici : abletaskkill_sources.7z
CAGE

Hello Cage,

Taskkill étant dans system32 il est accessible directement sans chemin (%windir%/system32)

Tu peux aussi remplacer GetWindowsDirectory_(@WindowsDirectory, #MAX_PATH)
par
GetEnvironmentVariable("windir"). Pas besoin d'API

Tout ce qui est visible avec la commande SET est utilisable directement dans PB avec GetEnvironmentVariable()

Merci pour tes excellentes contributions techniques

Merci Marc56,

Procédure simplifiée au minimum

Code : Tout sélectionner

Procedure serviceThread(idThread.l)
;Here goes the service's job...
; Modifier cette procédure pour ajouter les actions a effectuer
; Call TaskKill.exe /f /im CompatTelRunner.exe
  
  Repeat
    RunProgram("TaskKill.exe", "/f /im CompatTelRunner.exe", #Null$, #PB_Program_Hide)
    Sleep_(2000)
  ForEver
EndProcedure

Testé en lançant CompatTelRunner.exe dans une 'Invite de commandes (admin)'
a) service lancé
Le process 'Microsoft Compatibility Telemetry' n'a pas le temps de s'exécuter.
b) service arrêté
Le process 'Microsoft Compatibility Telemetry' s'exécute normalement

CAGE

Bonjour a tous,

Voici le résultat final de le procédure Procedure serviceThread(idThread.l)

Code : Tout sélectionner

Procedure netStop(sService.s)
  RunProgram("net.exe", "stop " + sService, #Null$, #PB_Program_Hide)
EndProcedure
;_____________________________________________________________________________

Procedure scConfig(sService.s, sStart.s)
  RunProgram("sc.exe" , "config " + sService + " start= " + sStart, #Null$, #PB_Program_Hide)
EndProcedure
;_____________________________________________________________________________

Procedure serviceThread(idThread.l) ; ; Here goes the service's job...
  ; Here goes the service's job...
  ; Modifier cette procédure pour effectuer les actions désirées
  
  Protected ptrPID = 0
  Protected sService.s, ExeName.s
  
  DataSection
    Demand:                         ; Début des services a positionner en Type de démarrage "Manuel"
      Data.s "QHActiveDefense"      ; 360 Total Security
      Data.s "BoxSyncUpdateService" ; Updater for Box Sync
      Data.s "DbxSvc"               ; Dropbox Service
      Data.s "Emby"                 ; The windows background Service For Emby Server.
      Data.s "MEmuSVC"              ; MEmu Service
      Data.s "SbieSvc"              ; SandBoxie Service
      Data.s "gupdate"              ; Service Google Update (gupdate)
      Data.s "gupdatem"             ; Service Google Update (gupdatem)
      Data.s "dbupdate"             ; Service Mise à jour Dropbox (dbupdate)
      Data.s "dbupdatem"            ; Service Mise à jour Dropbox (dbupdatem)
      Data.s "uSHAREitSvc"          ; SHAREit Hotspot Service
      Data.s "Spooler"              ; Spouleur d’impression
      Data.s "TomTomHOMEService"    ; TomTom Home Service For ejecting devices
      Data.s "tvmosaic_server"      ; C:\Program Files (x86)\DVBLogic\TVMosaic\tvmosaic_server.exe
      Data.s #Null$                 ; Fin des services Manuel
      
    Disabled:                       ; Début des services a positionner en Type de démarrage "Désactivé"
      Data.s "SysMain"              ; Gère et améliore les performances du système dans le temps.
      Data.s "WSearch"              ; Fournit des fonctionnalités d’indexation de contenu, ...
      Data.s #Null$                 ; Fin des services "Désactivé"
      
    TaskKill:                       ; Début des processus a tuer
      Data.s "CompatTelRunner.exe"  ; Microsoft Compatibility Telemetry
      Data.s #Null$                 ; Fin des processus a tuer
  EndDataSection
  
  ;;; *********************************************************
  ;;; ACTIONS A REALISER A CHAQUE DEMARRAGE DU SERVICE OU DU PC
  ;;; *********************************************************
  Restore Demand
  
  Repeat
    Read.s sService
    If sService <> #Null$
      scConfig(sService, "demand") : netStop(sService)
    EndIf
  Until sService = #Null$
  
  Restore Disabled
  
  Repeat
    Read.s sService
    If sService <> #Null$
      scConfig(sService, "disabled") : netStop(sService)
    EndIf
  Until sService = #Null$
  
  ;;; *******************************************************************
  ;;; MONITORING : ACTION A REALISER TANT QUE LE PC EST EN FONCTIONNEMENT
  ;;; *******************************************************************
  
  Repeat
    Restore TaskKill
    Repeat
      Read.s ExeName
      If ExeName <> #Null$
        ptrPID = 0
        If getNamePID(ExeName,@ptrPID)
          RunProgram("TaskKill.exe", "/f /im " + ExeName, #Null$, #PB_Program_Hide)
        EndIf
      EndIf
    Until ExeName = #Null$
    Delay(3000) ; Sleep_(3000)
  ForEver
EndProcedure
;_____________________________________________________________________________

Vos retours seront appréciés.
CAGE

Bonjour,
Mise à jour de la procédure serviceThread(idThread.l)

Code : Tout sélectionner

Procedure serviceThread(idThread.l)
  ;
  ; début de procédure identique
  ;
  ; ajout d'un action toutes les minutes pour tuer tous les processus morts
  ;
  ;;; *******************************************************************
  ;;; MONITORING : ACTION A RÉALISER TANT QUE LE PC EST EN FONCTIONNEMENT
  ;;; *******************************************************************
  
  Repeat
    Restore TaskKill
    Repeat
      Read.s ExeName
      If ExeName <> #Null$
        ptrPID = 0
        If getNamePID(ExeName,@ptrPID)
          RunProgram("TaskKill.exe", "/f /im " + ExeName, #Null$, #PB_Program_Hide)
        EndIf
      EndIf
    Until ExeName = #Null$
    Delay(3000)
    loop+1
    ;;; ************************************
    ;;; ACTION A REALISER TOUTES LES MINUTES
    ;;; ************************************
    If loop = 20
      loop = 0
      RunProgram("TaskKill.exe", "/F /FI "+Chr(34)+"status eq Not RESPONDING"+Chr(34), #Null$, #PB_Program_Hide)
    EndIf
  ForEver
EndProcedure

Création d'un fichier batch pour faciliter l'utilisation du service en période de test
Contenu du fichier Able-Gestion-Du-Service.cmd

Code : Tout sélectionner

@echo off
echo.
echo  Les droits Administrateur sont requis pour lancer %~n0
echo.
echo  Detection en cours...
echo.
net session >nul 2>&1
if %errorLevel% == 0 (
		echo  OK:  Les droits Administrateur sont garantis.
		echo.
) else (
		echo  ECHEC: Les droits actuels sont insuffisants.
		echo.
		echo  Appuyez sur une touche pour quitter...
		pause >nul
		exit
)
set serviceNom=AbleTaskKill
set serviceExe=AbleTaskKill.exe
:menu
echo.
echo  Commandes disponibles:
echo.
echo  H) Afficher les commandes
echo  I) Installer le service
echo  U) Desinstaller le service
echo  A) Afficher le status du service

echo  D) Demarrer le service
echo  X) Stopper le service

echo  T) Lancer le Gestionnaire des taches (taskmgr.exe)
echo  S) Lancer le Gestionnaire des services (services.msc)

echo  Q) Quitter
echo.
choice /t 60 /d Q /c HIUADXTSQ /m "> Quelle action voulez-vous faire ? "
cls
echo.
if %errorlevel% == 1 set param=/help
if %errorlevel% == 2 set param=/install
if %errorlevel% == 3 set param=/uninstall
if %errorlevel% == 4 set param=/status

if %errorlevel% == 5 (
	net start %serviceNom%
	goto :menu
)
if %errorlevel% == 6 (
	net stop %serviceNom%
	goto :menu
)

if %errorlevel% == 7 (
	start taskmgr.exe
	goto :menu
)

if %errorlevel% == 8 (
	start services.msc
	goto :menu
)

if %errorlevel% == 9 exit

set dossier=%~dp0

echo %dossier%%serviceExe% %param%
echo.
call %dossier%%serviceExe% %param%
echo.
goto :menu
exit

Un utilitaire identique écrit en PB est a venir.
CAGE

Bonjour,
Voici la version PB (AbleGestion.pb)

et l'icône

Code : Tout sélectionner

;
;************************************************************************
;Titre      : AblGestion.pb
;Auteur     : (C) 2019 CAGE
;Date       : 2019/03/10
;Version PB : PureBasic 5.70 LTS (Windows - x86)
;Version PB : PureBasic 5.70 LTS (Windows - x64)
;Compiler Options
;Compiler Options : Enable moderm theme support (for Windows X and above)
;Compiler Options : Request Administrator mode for Windows Vista and above
;Compile/Run      : Create temporary executable in the source directory
;
;Libairies: aucunes
;
;************************************************************************
;

EnableExplicit

OnErrorGoto(?ErrorHandler)

Global AppName$ = GetFilePart(ProgramFilename(), #PB_FileSystem_NoExtension)
Global AppPath$ = GetPathPart(ProgramFilename())

;;; https://msdn.microsoft.com/en-us/library/windows/desktop/cc144179%28v=vs.85%29.aspx
Global TB_Message = RegisterWindowMessage_("TaskbarCreated")

#homemail$ = "pbcage@free.fr"
#homesite$ = "http://pbcage.free.fr"
#homepure$ = "http://www.purebasic.com"

#bgcolor = 14474460 ; bgcolor = RGB(220,220,220) $00DCDCDC
#fgcolor = 0        ; fgcolor = RGB(0,0,0)

#MyServiceName$ = "AbleTaskKill"
Global MyServiceExe$ = AppPath$ + #MyServiceName$ + ".exe"

Global Mutex, Message$

CompilerIf #PB_Compiler_Debugger
  ;;; We are in the IDE
  #WinApp = 999
CompilerElse
  #WinApp = 666 ; use by Mutex if needed
  If TB_Message
    Mutex = CreateMutex_(#Null, #False, AppName$)
    If GetLastError_() = #ERROR_ALREADY_EXISTS
      ;;;
      ;;; Same Mutex in memory, that same app is running ???
      ;;; 
      Define hWnd = FindWindow_("WindowClass_"+Str(#WinApp), #NUL)
      If hWnd
        ;;;
        ;;; Same Mutex in memory and same ClassName, no doubt, is the same app.
        ;;;
        SendMessage_(hWnd,#WM_SYSCOMMAND, #SC_RESTORE,0)
        SetForegroundWindow_(hWnd)
        End
      EndIf
    EndIf
  Else
    ;;; Desktop is not activated, then no TaskBar (TB)
    End
  EndIf
CompilerEndIf

Enumeration Menus
  #MenuApp
  #MenuTray
EndEnumeration

Enumeration FormMenu
  ;
  #MenuAppHide
  #MenuAppHelp1
  #MenuAppHelp2
  #MenuAppHelp3
  ;
  #MenuAppHome
  #MenuAppPage
  #MenuAppFolder
  #MenuAppTaskmgr
  #MenuAppServices
  #MenuAppQuit
  #MenuAppShow
  #MenuAppAbout
EndEnumeration

Enumeration Gadgets
  #Gadget
  #GadgetBtnT  ; (T)askmgr.exe
  #GadgetBtnS  ; (S)ervices.msc
  #GadgetBtnGo ; (Go) -> Lancer
  #GadgetBtnQ  ; (Q)uitter
  #GadgetComboBox1
  #GadgetComboBox2
  #GadgetComboBox3
  #GadgetEditor        ; zone d'affichage des résultats de la commande passée
  #GadgetEnd           ; fin de changement des couleurs bg/fg
EndEnumeration

DataSection ; Images
  Image_App:
  IncludeBinary "AbleGestion.ico"
EndDataSection

Enumeration Images
  #Image_App
EndEnumeration

Enumeration Fonts
  #Font0
  #Font1
EndEnumeration

Global optMinimize = #True

Global IconApp = CatchImage(#Image_App  , ?Image_App)

Global Event, IndexMenu
Global indexGadget, indexGadgetType

Procedure messageBox(request = #False)
  If Message$ = #Null$
    ProcedureReturn -1
  EndIf
  Protected flag = #PB_MessageRequester_Ok ;|#MB_ICONINFORMATION
  If request
    flag = #PB_MessageRequester_YesNo ; |#MB_ICONQUESTION
  EndIf
  ProcedureReturn MessageRequester(AppName$, Message$, flag | #MB_TOPMOST)
EndProcedure

Procedure initSysTray()
  If FindWindow_("Progman", #NUL) <> 0
    AddSysTrayIcon(#WinApp, WindowID(#WinApp), IconApp)
    SysTrayIconToolTip(#WinApp, AppName$)
  EndIf
EndProcedure

Procedure window_Callback(win, msg, wParam, lParam)
  Protected Result = #PB_ProcessPureBasicEvents
  Select Msg
    Case TB_Message ; explorer crash
      initSysTray()
  EndSelect
  ProcedureReturn Result
EndProcedure

Procedure hideAppWindow()
  HideWindow(#WinApp, #True)
  SetWindowState(#WinApp, #PB_Window_Minimize)
EndProcedure

Procedure showAppWindow()
  HideWindow(#WinApp, #False)
  SetWindowState(#WinApp, #PB_Window_Normal)
EndProcedure

Procedure appAbout()
  Protected confirm
  Protected home.s = GetFilePart(#homepure$)
  Message$ = AppName$ + #CRLF$ + #CRLF$
  Message$ + "Cette application est copyright © 2019 CAGE" + #CRLF$ + #CRLF$
  Message$ + "Mes remerciements à l'équipe PureBasic" + #CRLF$ + #CRLF$
  message$ + "Souhaitez-vous visiter le site " + #homepure$
  confirm = messageBox(#True)
  If confirm = #PB_MessageRequester_Yes
    RunProgram(#homepure$)
  EndIf
EndProcedure

Procedure set_service(service$=#Null$, program$=#Null$, action$=#Null$)
  Protected parameters$, status$, rc=#False
  Protected myexe$  = MyServiceExe$
  Protected scexe$  = "sc.exe"
  Protected netexe$ = "net.exe"
  DisableGadget(#GadgetBtnGo, #True)
  ClearClipboard()
  ClearGadgetItems(#GadgetEditor)
  service$ = Chr(34)+service$+Chr(34)
  Select LCase(action$)
    Case "start"           :                     action$ = "start   " + service$
    Case "stop"            :                     action$ = "stop    " + service$
    Case "create"          : AddGadgetItem(#GadgetEditor, 0, "Action non traitée.") : ProcedureReturn 0
    Case "delete"          : program$ = scexe$ : action$ = "delete  " + service$
    Case "query"           : program$ = scexe$ : action$ = "query   " + service$
    Case "queryex"         : program$ = scexe$ : action$ = "queryex " + service$
    Case "auto"            : program$ = scexe$ : action$ = "config  " + service$ + " start= auto"
    Case "delayed-auto"    : program$ = scexe$ : action$ = "config  " + service$ + " start= delayed-auto"
    Case "demand"          : program$ = scexe$ : action$ = "config  " + service$ + " start= demand"
    Case "disabled"        : program$ = scexe$ : action$ = "config  " + service$ + " start= disabled"
    ;;; Les trois commandes suivantes sont spécifique au service lui même.
    Case "/help"           : program$ = myexe$ : action$ = "/help"
    Case "/install"        : program$ = myexe$ : action$ = "/install"
    Case "/uninstall"      : program$ = myexe$ : action$ = "/uninstall"
    Default
      action$ = #Null$
  EndSelect
  If action$ <> #Null$
    If program$ = myexe$
      Select LCase(action$)
        Case "/uninstall"
          parameters$ = "/c "+netexe$+" stop "+service$+" 2>&1|clip" : Debug parameters$
          rc = RunProgram("cmd.exe",parameters$,#Null$,#PB_Program_Wait|#PB_Program_Hide)
      EndSelect
      parameters$ = "/c "+program$+" "+action$+" &&pause" : Debug parameters$
      rc = RunProgram("cmd.exe",parameters$,#Null$)
    Else
      parameters$ = "/c "+program$+" "+action$+" 2>&1|clip" : Debug parameters$
      rc = RunProgram("cmd.exe",parameters$,#Null$,#PB_Program_Wait|#PB_Program_Hide)
    EndIf
    AddGadgetItem(#GadgetEditor, 0, GetClipboardText())
    ClearClipboard()
  EndIf
  DisableGadget(#GadgetBtnGo, #False)
  ProcedureReturn rc
EndProcedure

ExamineDesktops()
#WinAppWidth  = 600
#WinAppHeight = 260
Define X = (DesktopWidth(0)-#WinAppWidth)/2
Define Y = (DesktopHeight(0)-#WinAppHeight)/2

Define Flags = #PB_Window_TitleBar|#PB_Window_ScreenCentered|#PB_Window_SystemMenu

If OpenWindow(#WinApp, X, Y, #WinAppWidth, #WinAppHeight, AppName$ + " - " + #MyServiceName$, Flags)
  ;;; choix de couleur et de police a faie avant de construire l'interface
  SetWindowColor(#WinApp, #bgcolor)
  
  SetWindowCallback(@window_Callback(),#WinApp) ; crash explorer
  
  initSysTray()
  
  If CreatePopupImageMenu(#MenuTray, #PB_Menu_ModernLook)
    MenuItem(#MenuAppShow  , AppName$ , IconApp)
    MenuBar()
    MenuItem(#MenuAppAbout ,"About")
    MenuItem(#MenuAppQuit  ,"Quitter")
  EndIf
  
  If CreateImageMenu(#MenuApp, WindowID(#WinApp), #PB_Menu_ModernLook)
    MenuTitle("Fichier")
      MenuItem(#MenuAppFolder        , "Ouvrir le dossier de l'application")
      MenuBar()
      MenuItem(#MenuAppTaskmgr       , "Lancer le Gestionnaire de tâches")
      MenuItem(#MenuAppServices      , "Lancer le Gestionnaire de services")
      MenuBar()
      MenuItem(#MenuAppHome          , "Visiter le site " + #homesite$)
      MenuItem(#MenuAppPage          , "Consulter la page de l'application")
      MenuBar()
      MenuItem(#MenuAppQuit          , "Quitter")
    MenuTitle("?")
      MenuItem(#MenuAppAbout         , "About")
  EndIf
  
  Define X,Y,W,H,G
  
  X=2:Y=2:W=55:H=24
  ButtonGadget(#GadgetBtnT, X, Y, W, H, "Taskmgr")
  GadgetToolTip(#GadgetBtnT, " Cliquez pour lancer le Gestionnaire de tâches (Taskmgr.exe) ")
  ;
  X+W+1
  ButtonGadget(#GadgetBtnS, X, Y, W, H, "Services")
  GadgetToolTip(#GadgetBtnS, " Cliquez pour lancer la console services.msc ")
  ;
  X+W+12:Y=2:W=60:H=24
  ButtonGadget(#GadgetBtnGo, X, Y, W, H, "Exécuter >")
  GadgetToolTip(#GadgetBtnGo, " Cliquez pour lire ou modifier le status du service " + #MyServiceName$)
  ;
  X+W+2:Y=3:W=100:H=22
  ComboBoxGadget(#GadgetComboBox3, X, Y, W, H)
  AddGadgetItem(#GadgetComboBox3, -1, "sc.exe")
  AddGadgetItem(#GadgetComboBox3, -1, "net.exe")
  AddGadgetItem(#GadgetComboBox3, -1, LCase(#MyServiceName$)+".exe")
  SetGadgetState(#GadgetComboBox3, 0)
  ;
  X+W+4:W=120
  ComboBoxGadget(#GadgetComboBox2, X, Y, W, H)
  AddGadgetItem(#GadgetComboBox2, -1, "query")
  AddGadgetItem(#GadgetComboBox2, -1, "queryex")
  AddGadgetItem(#GadgetComboBox2, -1, "start")
  AddGadgetItem(#GadgetComboBox2, -1, "stop")
  AddGadgetItem(#GadgetComboBox2, -1, "create")
  AddGadgetItem(#GadgetComboBox2, -1, "delete")
  AddGadgetItem(#GadgetComboBox2, -1, "delayed-auto")
  AddGadgetItem(#GadgetComboBox2, -1, "auto")
  AddGadgetItem(#GadgetComboBox2, -1, "demand")
  AddGadgetItem(#GadgetComboBox2, -1, "disabled")
  AddGadgetItem(#GadgetComboBox2, -1, "/help")
  AddGadgetItem(#GadgetComboBox2, -1, "/install")
  AddGadgetItem(#GadgetComboBox2, -1, "/uninstall")
  SetGadgetState(#GadgetComboBox2, 0)
  ;
  X+W+2:Y=3:W=120:H=22
  ComboBoxGadget(#GadgetComboBox1, X, Y, W, H)
  AddGadgetItem(#GadgetComboBox1, -1, #MyServiceName$)
  SetGadgetState(#GadgetComboBox1, 0)
  DisableGadget(#GadgetComboBox1, #True)
  ;
  W=45:H=24:X=#WinAppWidth-W-2:H=24
  ButtonGadget(#GadgetBtnQ, X, Y, W, H, "Quitter")
  GadgetToolTip(#GadgetBtnQ, " Cliquez pour fermer l'application ")
  ;
  X=2:Y=27:H=208
  EditorGadget(#GadgetEditor, X , Y , #WinAppWidth-4 , H, #PB_Editor_ReadOnly)
  SetGadgetColor(#GadgetEditor, #PB_Gadget_BackColor , #bgcolor)
  SetGadgetColor(#GadgetEditor, #PB_Gadget_FrontColor, RGB(0,0,0))
  ;
  Define G
  
  For G = #Gadget + 1 To #GadgetEnd - 1
    SetGadgetColor(G, #PB_Gadget_BackColor , #bgcolor)
    SetGadgetColor(G, #PB_Gadget_FrontColor, RGB(0,0,0))
  Next
  
  If LoadFont(#Font1, "Consolas", 9)
    SetGadgetFont(#GadgetEditor , FontID(#Font1))
  EndIf
  
  Define input$ = #Null$
  
  Repeat
    Event = WaitWindowEvent()
    Select Event
      Case #PB_Event_Menu
        indexMenu = EventMenu()
        Select indexMenu
          Case #MenuAppQuit
            Break
          Case #MenuAppFolder
            RunProgram(AppPath$,#Null$,AppPath$)
          Case #MenuAppTaskmgr
            RunProgram("taskmgr.exe")
          Case #MenuAppServices
            RunProgram("services.msc")
          Case #MenuAppAbout
            appAbout()
          Case #MenuAppHome
            RunProgram(#homesite$)
          Case #MenuAppPage
            RunProgram(#homesite$+"/pb/abletaskkill.html")
        EndSelect
        
;;;;;;;;;
;;;;;;;;; Events GADGETS
;;;;;;;;;
;---- Events GADGETS
      Case #PB_Event_Gadget
        indexGadget     = EventGadget()
        indexGadgetType = EventType()
        Select indexGadget
          Case #GadgetBtnGo
            Define service$ = GetGadgetText(#GadgetComboBox1)
            Define status$  = GetGadgetText(#GadgetComboBox2)
            Define program$ = GetGadgetText(#GadgetComboBox3)
            set_service(service$, program$, status$)
          Case #GadgetBtnS
            RunProgram("services.msc")
          Case #GadgetBtnT
            RunProgram("taskmgr.exe")
          Case #GadgetBtnQ
            Break
          Case #GadgetComboBox2, #GadgetComboBox3
            Select indexGadgetType
              Case #PB_EventType_Change
                If GetGadgetState(#GadgetComboBox3) = 2
                  SetGadgetState(#GadgetComboBox3, 0)
                EndIf
                input$ = GetGadgetText(#GadgetComboBox2)
                Select input$
                  Case "start","stop"
                  Case "create","delete"
                    SetGadgetState(#GadgetComboBox3, 0)
                  Case "help","install","uninstall"
                    SetGadgetState(#GadgetComboBox3, 2)
                  Default : SetGadgetState(#GadgetComboBox3, 0)
                EndSelect
            EndSelect
        EndSelect
;;;;;
;---- Events SYSTEM SYSTRAY
;;;;;
      Case #PB_Event_SysTray
        Select EventType()
          Case #PB_EventType_RightClick
            DisplayPopupMenu(#MenuTray, WindowID(#WinApp))
            
          Case #PB_EventType_LeftClick
            If GetWindowState(#WinApp) = #PB_Window_Normal
              hideAppWindow()
            Else
              showAppWindow()
              StickyWindow(#WinApp, #True)
            EndIf
        EndSelect
;;;;;
;;;;; Events system window
;;;;;
;---- Events SYSTEM WINDOW
      Case #PB_Event_CloseWindow
        hideAppWindow()
      Case #PB_Event_MinimizeWindow
        If optMinimize
          HideWindow(#WinApp, #True)
        EndIf
      Case #PB_Event_MaximizeWindow
        ;
      Case #PB_Event_RestoreWindow
        ;
    EndSelect
  ForEver
EndIf
;---- Events ERROR HANDLER
ErrorHandler:
  
  Define lHwd = FindWindow_("Progman", #NUL)
  ShowWindow_(lHwd, 8)
  RemoveSysTrayIcon(#WinApp)
  ReleaseMutex_(Mutex)
  End

CAGE

Bonsoir a tous,

Pour piloter le service AbleTaskKill et intercepter ses messages de sortie, j'ai essayé la commande suivante dans une Invite de commande Administrateur

Code : Tout sélectionner

AbleTaskKill /help 2>&1 | clip

puis un CTRL+V dans une fenêtre Notepad
Et rien ne s'affiche.
Les messages envoyés par le service Windows AbleTaskKill n'apparaissent pas.
J'ai regardé comment étaient générés ces messages.
Ils sont gérés par la procédure

Code : Tout sélectionner

Procedure StdOut(Text$)
  Protected CharDone.l
  Protected Reserved.l
  WriteConsole_(GetStdHandle_(#STD_OUTPUT_HANDLE), Text$ + #CRLF$, Len(Text$) + 2, CharDone, Reserved)
EndProcedure
; Exemple d'utilisation:
ElseIf FindString(sCmdLine, "/help") | FindString(sCmdLine, "/?")
   StdOut(#AppName)
   StdOut(" /install")
   StdOut(" /uninstall")
   StdOut(" /status")
   StdOut(" /help")
   StdOut(" /?")
   StdOut(" Net start    " + #AppName)
   StdOut(" Net stop     " + #AppName)
   StdOut(" Net pause    " + #AppName)
   StdOut(" Net continue " + #AppName)
   StdOut(" Services.msc (For Service Manager)")

J'avoue humblement que je ne sais pas comment interpréter cette procédure.
J'ai donc créé une procédure que je comprend mieux

Code : Tout sélectionner

Procedure ConsOut(Text$)
  OpenConsole()
    PrintN(#CRLF$+Text$+#CRLF$)
  CloseConsole()
EndProcedure
; Exemple d'utilisation:
ElseIf FindString(sCmdLine, "/help") | FindString(sCmdLine, "/?")
  Text.s + " "+#AppName+" /install"   + #CRLF$
  Text.s + " "+#AppName+" /uninstall" + #CRLF$
  Text.s + " "+#AppName+" /status" + #CRLF$
  Text.s + " "+#AppName+" /help" + #CRLF$
  Text.s + " "+#AppName+" /?" + #CRLF$
  Text.s + #CRLF$
  Text.s + " Net start    " + #AppName + #CRLF$
  Text.s + " Net stop     " + #AppName + #CRLF$
  Text.s + " Net pause    " + #AppName + #CRLF$
  Text.s + " Net continue " + #AppName + #CRLF$
  Text.s + #CRLF$
  Text.s + " Services.msc (For Service Manager)"
  ConsOut(Text.s)

Question pour un champion, ce changement de procédure peut-il avoir un impact sur le fonctionnement interne du service Windows.
Le service ainsi modifié tourne sur mon PC depuis quelque temps et je n'ai pas constaté de problème.
Merci des retours que vous pourrez me faire.
CAGE

Salut Cage,
À vue de nez, je ne vois aucun problèmes, après plus d'un an, si tout roule bien de ton coté, c'est de bonne augure!

J'ai récemment travaillé avec tatanas pour insérer des notifications SERVICE_CONTROL_SESSIONCHANGE.

J'en ai profité pour apporter une multitude de corrections mineures...
J'ai ajouté la possibilitée d'écrire un fichier log en plus du OutputDebugString() déja présent.

De plus le service démarre maintenant une application qui servira de rampe de lancement pour pouvoir expérimenter à loisir différents programmes de votre choix.
Je l'ai nommé: SysAdminExec.exe, il détecte si vous êtes simple utilisateur, Administrateur, ou Système-Administrateur, un icône approprié sera choisi. Via un fichier ini, SysAdminExec mémorise son emplacement à l'écran, sa grandeur, ainsi que les 150 derniers exécutable choisis. Grâce à un mutex, une seule instance est permise. Une tentative de relance vas ramener l'original au premier plan. À noter que SysAdminExec accepte les messages <Drag and Drop> d'applications à l'élévation inférieure. Vous pouvez aussi spécifier une liste d'exécutables via la ligne de commande.

J'ai utilisé la version 5.72 du compilateur.
Je préfère souvent faire appel directement aux APIs Windows.

Service Able
Service Able (Adresse alternative)

PureBasic

créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)

Re: créer un service windows (avec PB 5.62)