PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Surveiller les process

http://forums.purebasic.com/french/viewtopic.php?t=3786

Page 1 sur 1

Surveiller les process

Publié : dim. 16/oct./2005 21:12
par Heis Spiter
Pour tous les paresseux qui ont une panoplie d'applications vitales à ne surtout pas quitter, j'ai fait un programme qui permet de surveiller le status de ces applications, et de les lancer si elles sont coupées, ou de les arrêter (dans la cas inverse). Je compte encore rajouter quelques optiosn plus tard, comme l'avertissement si une des application est coupée, etc...

Code : Tout sélectionner

Structure PROCESSENTRY32 
    dwSize.l 
    cntUsage.l 
    th32ProcessID.l 
    th32DefaultHeapID.l 
    th32ModuleID.l 
    cntThreads.l 
    th32ParentProcessID.l 
    pcPriClassBase.l 
    dwFlags.l 
    szExeFile.b[260] 
EndStructure

Structure Process
  ProcessName.s
  ProcessID.l
  Processhdl.l
EndStructure
NewList Process.Process()

Structure Apps
  AppName.s
  AppExe.s
  AppPath.s
  ID.l
  State.b
EndStructure
NewList Apps.Apps()
AddElement(Apps()) 
Apps()\AppName = "Nom de l'application" 
Apps()\AppExe = "NomDeLExecutable.exe" 
Apps()\AppPath = "C:\Repertoire\de\l\application\" 

Procedure Update()
  If OpenLibrary (0,"kernel32.dll")
    s=CallFunction(0,"CreateToolhelp32Snapshot",274,0) 
    If s
      ForEach Process()
        CloseHandle_(Process()\Processhdl)
      Next
      ClearList(Process())
      DefType.PROCESSENTRY32 Proc32 
      Proc32\dwSize = SizeOf(PROCESSENTRY32) 
      If CallFunction(0,"Process32First",s, @Proc32)
        AddElement(Process())
        Process()\ProcessName = PeekS(@Proc32\szExeFile)
        Process()\ProcessID = proc32\th32ProcessID
        hProcess = OpenProcess_(#PROCESS_ALL_ACCESS, #False, proc32\th32ProcessID)
        If hProcess
          Process()\Processhdl = hProcess
        EndIf
        While CallFunction (0, "Process32Next", s, @Proc32) 
          AddElement(Process())
          Process()\ProcessName = PeekS(@Proc32\szExeFile)
          Process()\ProcessID = proc32\th32ProcessID
          hProcess = OpenProcess_(#PROCESS_ALL_ACCESS, #False, proc32\th32ProcessID)
          If hProcess
            Process()\Processhdl = hProcess
          EndIf
        Wend 
      EndIf 
    EndIf
    CloseLibrary(0)
  EndIf
EndProcedure

Procedure StartProgram(ID)
  ID = ID-200
  ForEach Apps()
    If Apps()\ID = ID
      Rep.s = Apps()\AppPath
      Exe.s = Apps()\AppExe
      Break
    EndIf
  Next
  Apps()\State = 1
  RunProgram(Rep+Exe, "", Rep)
EndProcedure

Procedure StopProgram(ID)
  ID = ID-300
  lpExitCode = 0
  ForEach Apps()
    If Apps()\ID = ID
      Exe.s = Apps()\AppExe
      Break
    EndIf
  Next
  ForEach Process()
    If Process()\ProcessName = Apps()\AppExe
      hProcess = Process()\Processhdl
      Break
    EndIf
  Next
  If hProcess
    GetExitCodeProcess_(hProcess, @lpExitCode)
    TerminateProcess_(hProcess, lpExitCode)
    Apps()\State = 0
  EndIf
EndProcedure

#LWA_COLORKEY = 1
#LWA_ALPHA = 2
#GWL_EXSTYLE = -20
#WS_EX_LAYERED = $00080000
ExamineDesktops()
Update()
If OpenWindow(1, DesktopWidth(0)-400, DesktopHeight(0)-400, 400, 400, #PB_Window_BorderLess, "Serveur")
  SetWindowLong_(WindowID(1) , #GWL_EXSTYLE , GetWindowLong_(WindowID(1) , #GWL_EXSTYLE) | #WS_EX_LAYERED)
  SetLayeredWindowAttributes_(WindowID(1), RGB(0, 0, 0), 128, #LWA_ALPHA)
  If CreateGadgetList(WindowID(1))
    TextGadget(2, 0, 0, 400, 20, "Serveur", #PB_Text_Center|#PB_Text_Border)
    i = 3
    ForEach Apps()
      Apps()\ID = i
      Apps()\State = 0
      TextGadget(i, 10, 20*(i-1), 190, 20, Apps()\AppName)
      TextGadget(100+i, 200, 20*(i-1), 80, 20, "Erreur")
      ButtonGadget(200+i, 290, 20*(i-1), 50, 20, "Lancer")
      ButtonGadget(300+i, 340, 20*(i-1), 50, 20, "Arrêter")
      DisableGadget(200+i, 0)
      DisableGadget(300+i, 1)
      ForEach Process()
        If Process()\ProcessName = Apps()\AppExe
          SetGadgetText(100+i, "OK")
          DisableGadget(200+i, 1)
          DisableGadget(300+i, 0)
          Apps()\State = 1
          Break
        EndIf
      Next
      i = i + 1
    Next
  EndIf
  If CreatePopupMenu(1000)
    MenuItem(1001, "Fermer") 
  EndIf 
  Start = ElapsedMilliseconds()
  Repeat
    If ElapsedMilliseconds() - Start > 1000
      Update()
      i = 3
      ForEach Apps()
        PState = Apps()\State
        Apps()\State = 0
        SetGadgetText(100+i, "Erreur")
        DisableGadget(200+i, 0)
        DisableGadget(300+i, 1)
        ForEach Process()
          If Process()\ProcessName = Apps()\AppExe
            SetGadgetText(100+i, "OK")
            DisableGadget(200+i, 1)
            DisableGadget(300+i, 0)
            Apps()\State = 1
            Break
          EndIf
        Next
        If Apps()\State = 0 And PState = 1
          MessageRequester("Erreur", "["+FormatDate("%dd/%mm/%yy, %hh:%ii:%ss", Date())+"] "+Apps()\AppName+" ("+Apps()\AppExe+") a été quitté de façon inattendue !", #MB_ICONERROR)
        EndIf
        i = i + 1
      Next
      Start = ElapsedMilliseconds()
    EndIf
    Event = WaitWindowEvent()
    If Event = #PB_EventGadget
      GadgetID = EventGadgetID()
      If GadgetID > 300
        StopProgram(GadgetID)
      ElseIf GadgetID > 200
        StartProgram(GadgetID)
      EndIf
    ElseIf Event = #WM_RBUTTONDOWN
      DisplayPopupMenu(1000, WindowID(1))
    ElseIf Event = #PB_Event_Menu
      MenuID = EventMenuID()
      If MenuID = 1001
        Quit = 1
      EndIf
    EndIf
    Delay(1)
  Until Quit = 1
  ForEach Process()
    CloseHandle_(Process()\Processhdl)
  Next
  ClearList(Process())
  ClearList(Apps())
EndIf

Publié : sam. 22/oct./2005 15:00
par Dr. Dri
ca ne fonctionne pas avec windows 98 :(
même en mettant en commentaire les deux lignes qui posent problème

Code : Tout sélectionner

SetWindowLong_(WindowID(1),#GWL_EXSTYLE,SetWindowLong_(WindowID(1),#GWL_EXSTYLE)|#WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(1),RGB(0,0,0),128,#LWA_ALPHA)
Dri

Publié : sam. 22/oct./2005 15:48
par nico
Essayes la lib PBOSL pour voir, il y a les sources dispo avec

Publié : sam. 22/oct./2005 15:56
par Chris
Euhhh...
Ca doit faire quoi?

Parce que ça m'affiche une fenêtre transparente, mais à part ça, rien d'autre.

Il y a juste "Serveur", "Nom de l'application', "Erreur", et deux boutons "Lancer" et "Arreter" (grisé), mais rien d'autre.

Je suis sous XP SP2.

PS
...et de les lancer si elles sont coupées, ou de les lancer (dans la cas inverse)
de les lancer ou de les lancer? :lol:

Publié : sam. 22/oct./2005 18:11
par Dr. Dri
@Chris
j'ai la même chose sans la transparence

Dri

Publié : sam. 22/oct./2005 18:32
par Chris
Dr. Dri a écrit :@Chris
j'ai la même chose sans la transparence

Dri
Normal si tu as 98, SetLayeredWindowAttributes() n'est supporté que par Win2000 et XP
SetLayeredWindowAttributes Function

--------------------------------------------------------------------------------

The SetLayeredWindowAttributes function sets the opacity and transparency color key of a layered window.

Syntax
....
....

Function Information

Header Declared in Winuser.h, include Windows.h
Import library User32.lib
Minimum operating systems Windows 2000

Publié : sam. 22/oct./2005 19:35
par Heis Spiter
Bon, le truc c'est qu'il faut ajouter les applications que vous voulez surveiller :lol:.
Le code

Code : Tout sélectionner

AddElement(Apps()) 
Apps()\AppName = "Nom de l'application" 
Apps()\AppExe = "NomDeLExecutable.exe" 
Apps()\AppPath = "C:\Repertoire\de\l\application\"
Remplacez-le pour ajouter toutes les applications que vous voulez (surveiller).
Pour exemple, chez moi, ça correspond à

Code : Tout sélectionner

AddElement(Apps())
Apps()\AppName = "Apache2"
Apps()\AppExe = "Apache.exe"
Apps()\AppPath = "D:\Site\Apache2\bin\"
AddElement(Apps())
Apps()\AppName = "ArGoSoft Mail Server"
Apps()\AppExe = "mlsrvnt.exe"
Apps()\AppPath = "D:\Site\agsmail\"
AddElement(Apps())
Apps()\AppName = "Bird Chat Server"
Apps()\AppExe = "Server.exe"
Apps()\AppPath = "D:\Site\www\dev\Chat\sources\"
AddElement(Apps())
Apps()\AppName = "MySQL"
Apps()\AppExe = "mysqld-nt.exe"
Apps()\AppPath = "D:\Site\mysql\bin\"
AddElement(Apps())
Apps()\AppName = "start.exe"
Apps()\AppExe = "start.exe"
Apps()\AppPath = "D:\Site\"
AddElement(Apps())
Apps()\AppName = "Uptime"
Apps()\AppExe = "uptime.exe"
Apps()\AppPath = "D:\Site\uptime\"
AddElement(Apps())
Apps()\AppName = "zFTPServer"
Apps()\AppExe = "zFTPServer.exe"
Apps()\AppPath = "D:\Site\zFTPServer\"
Libre à vous de mettre les applis que vous voulez.

PS : merci Chris, je corrige ;).
PS2 : J'en ai profité pour mettre le code à jour.

Publié : sam. 22/oct./2005 19:47
par Backup
c'est pas mal du tout ton truc !! :D

je vais m'en servir pour mon firewall "kerio"
une fois un truc l'a fait dijoncté , je sais pas quoi !
dorenavant se sera plus dur ! :D

Cool !

Publié : dim. 23/oct./2005 13:21
par Dr. Dri
nico a écrit :Essayes la lib PBOSL pour voir, il y a les sources dispo avec
Je l'ai fait et la lib PBOSL_Process utilise psapi.dll
impossible de l'ouvrir avec un openlibrary sous windows 98

Dri :?
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru