Gestion des processus

hardy · Message par **hardy** » ven. 11/juin/2004 16:46

Un code, non encore optimisé, pour gérer les processus.
Principe : le programme surveille les processus, et dès qu'il en repère un non répertorié, demande si on l'autorise.
Deux modes : mode normal : laisse le processus s'exécuter en attendant la réponse.
mode pause : le met en pause en attendant.
Onglet "statuts" pour modifier la liste des processus répertoriés.
Noter que créer un statut "purebasic" (autorisé!) par exemple laisse s'exécuter tous les processus dont une partie du nom est "purebasic". (sinon, pas pratique avec les purebasicXXXX...)
permet aussi de stopper/suspendre/reprendre un processus.

Il faut compiler le "Gros" sous le nom "surveillance.exe" et le "petit" sous le nom "relance.exe" dans un même répertoire.
Le programme à lancer est surveillance.exe
Ne pas activer sous peine de plantage le mode pause avant de l'avoir fait tourner en mode normal afin que les processus système soit répertoriés.
Idem pour mise en veille, réveil, démarrage, extinction.

A voir : à l'origine la partie listant les processus devait être un thread, mais régulièrement, les appels aux DLLs ne marchent plus, et tuer et relancer le thread ne donnnait rien. D'où le programme relance.exe, qui communique avec le programme principal et se relance quand ça ne va plus!

Autre : J'ai eu quelques problèmes avec les listes chainées (problème de synchronisation peut-être) donc pour l'instant tableau.

Dites-moi si ça marche

oubli : j'ai un problème de plantage avec l'imagegadget mis en remarque.
Pourquoi?

note : viens d'enlever divers morceaux qui ne servent plus. Il en reste sans doute quelques uns...

surveillance

Code : Tout sélectionner

If FindWindow_(0,"Surveillance - Mode pause") Or FindWindow_(0,"Surveillance - Mode normal")
MessageRequester("Surveillance","Programme déjà actif")
End
EndIf


Declare privilege(pid)
privilege(GetCurrentProcessId_())


Structure thread32
size.l
use.l
idth.l
parentid.l
base.l
delta.l
flags.l
EndStructure

Structure proc
nom.s
id.l
EndStructure

Declare refresh()
Declare sauver()
Declare kill(idd.l)
Declare creerstatut()
Declare cherche(nom.s)
Declare resetliste()
Declare reception(Window, Message, wParam, lParam)
Declare request()
Declare pause(pid)
Declare resume(pid)

If OpenLibrary(0,"kernel32.dll")=0
MessageRequester("Surveillance","Erreur d'ouverture de kernel32.dll")
End
EndIf

idsurveillance=GetCurrentProcessId_()
handle0.l=OpenProcess_($1F0FFF,0,idsurveillance)

Global path.s,idsurveillance,handle0
path.s=Space(255) 
GetModuleFileName_(0,@path,255)

While Right(path,1)<>"\"
path=Left(path,Len(path)-1)
Wend

;path="c:\survey\"

; A MODIFIER---------------

LoadImage(0,path+"berlioz.ico")
LoadImage(1,path+"berlioz.bmp")

; ----------------------------------



Dim requeteid.l(200)
Dim requetenom.s(200)
Dim liste.s(1000)
Dim statut.b(1000)
Dim actuel.s(1000)
Dim id.l(1000)
Dim etat.b(1000)
NewList lrequest.proc()
Global listprocess.s,nbliste.l,nprocess.l,requeteactuelle.b
Global liste,statut,adresse.l,nouveau.b,reprise.b
Global actuel,id,nbactuel.l,start.b,entree.s,supprime.b
Global run.b,nbrequete.l,hwin.l,mode.b,titre.s,x.l,runsprite.b
Global requeteid,requetenom

;--------------- Lecture config---------------------

nrequest=0

If ReadFile(0,path+"surv.cfg")
mode=ReadByte()
nbliste=0
Repeat
nbliste=nbliste+1
liste(nbliste)=ReadString()
statut(nbliste)=ReadByte()
Until Eof(0)
CloseFile(0)
Else
nbliste=3
liste(1)="surveillance.exe"
statut(1)=1
liste(2)="relance.exe"
statut(2)=1
liste(3)="system"
statut(3)=1
sauver()
EndIf

If mode
titre="Surveillance - Mode pause"
Else
titre="Surveillance - Mode normal"
EndIf

;--------------Main------------------------
start=1 : run=1 :frequence=100

win.l=OpenWindow(0,0,0,530,380,#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget|#PB_Window_Invisible,titre)
CreateMenu(20,win)
MenuTitle("Mode")
MenuItem(20,"Mode normal")
MenuItem(21,"Mode pause")
CreateGadgetList(win)

; Pourquoi ça crée des plantages?!!! 
;ImageGadget(30,355,50,167,250,UseImage(1))

PanelGadget(1,0,0,350,350)
AddGadgetItem(1,0,"Processus en cours")
ListIconGadget(2,0,0,330,280,"Nom",150)
AddGadgetColumn(2,1,"ID",58)
AddGadgetColumn(2,2,"Etat",100)
ButtonGadget(5,10,290,60,20,"Stopper")
ButtonGadget(8,90,290,60,20,"Pause")
ButtonGadget(15,170,290,60,20,"Reprendre")
AddGadgetItem(1,1,"Statuts")
ListIconGadget(3,0,0,330,280,"Nom",150)
AddGadgetColumn(3,1,"Statut",158)
ButtonGadget(4,10,290,60,20,"Changer")
ButtonGadget(6,90,290,60,20,"Créer")
ButtonGadget(7,170,290,60,20,"Effacer")
CloseGadgetList()
CreateMenu(0,win)

run=1
SetWindowText_(win,@titre)
SetWindowCallback(@reception())
RunProgram(path+"relance.exe",Str(win),"")

AddSysTrayIcon(0,win,UseImage(0))
SysTrayIconToolTip(0,"Surveillance")

Repeat
event=WaitWindowEvent()

If IsIconic_(win)<>0 And hide=0
HideWindow(0,1):hide=1
EndIf

Select event
  Case #PB_eventmenu
  Select EventMenuID()
  Case 20
  mode=0:titre="Surveillance - Mode normal"
  SetWindowText_(win,@titre)
  Case 21
  mode=1:titre="Surveillance - Mode pause"
  SetWindowText_(win,@titre)
  EndSelect
  
  Case #PB_Event_SysTray
  HideWindow(0,0):hide=0
  SetForegroundWindow_(win)
  Case #PB_Event_CloseWindow
  If MessageRequester("Surveillance","Quitter?",#PB_MessageRequester_YesNo)=6
  run=0
  sauver()
  refresh()
  EndIf 
    
  Case #PB_Event_Gadget
  Select EventGadgetID()
  
    Case 5
    n=GetGadgetState(2)+1
    If n>0
    If GetGadgetText(2)<>"relance.exe"
    kill(id(n))
    EndIf
    EndIf
    
    Case  4
    n=GetGadgetState(3)+1
    If n>0
    If statut(n)=1
    statut(n)=0
    Else
    statut(n)=1
    EndIf
    resetliste()
    sauver()
    EndIf
    
    Case 6
    CreateThread(@creerstatut(),0)
    
    Case 7
    n=GetGadgetState(3)+1
    If n>0
    For i=n+1 To nbliste
    liste(i-1)=liste(i)
    statut(i-1)=statut(i)
    Next i
    nbliste=nbliste-1
    sauver()
    resetliste()
    EndIf   
    
    Case 8
    n=GetGadgetState(2)+1
    If n>0 And etat(n)=0
    pause(id(n))
    etat(n)=1
    resetliste()
    EndIf

    Case 15
    n=GetGadgetState(2)+1
    If n>0 
    resume(id(n))
    etat(n)=0
    resetliste()
    EndIf

  EndSelect
  
EndSelect
ForEver
End

;--- Procedures --- 

Procedure refresh()

If supprime
supprime=0
nbrequete=nbrequete-1
For i=1 To nbrequete
requeteid(i)=requeteid(i+1)
requetenom(i)=requetenom(i+1)
Next i
;Debug "suppression"
EndIf

ClearList(lrequest())
Dim encours.s(1000)
oldnbactuel=nbactuel
examen()
For j=1 To nbactuel
nom.s=actuel(j)
idd.l=id(j)
pos=cherche(nom)
If LCase(nom)="relance.exe" And run=0
kill(idd)
EndIf

If pos
  If statut(pos)=0
    kill(idd)
  EndIf
Else
  vu=0
  For i=1 To nbrequete
  If requeteid(i)=idd
  vu=1
  EndIf
  Next i
  If vu=0
  If mode :pause(idd)
  EndIf
  nouveau=1
  nbrequete=nbrequete+1
  requeteid(nbrequete)=idd
  requetenom(nbrequete)=nom
  EndIf
EndIf

Next j

If requeteactuelle=0 And nbrequete>0
requeteactuelle=1
CreateThread(@request(),0)
EndIf

If run=0 : End :EndIf



If nouveau Or start Or nbactuel<>oldnbactuel
ResetListe()
EndIf
nouveau=0:start=0

EndProcedure

;------------------------------------------------

Procedure sauver()
DeleteFile(path+"surv.cfg")
If OpenFile(0,path+"surv.cfg")
WriteByte(mode)
For i=1 To nbliste
WriteStringN(liste(i))
WriteByte(statut(i))
Next i
CloseFile(0)
EndIf

EndProcedure

;------------------------------------------------

Procedure kill(idd)

h=OpenProcess_($1F0FFF,0,idd)
GetExitCodeProcess_(h,@code)
TerminateProcess_(h,code)
CloseHandle_(h)

EndProcedure


;-------------------------------------------------

Procedure creerstatut()
req2=OpenWindow(2,0,0,500,120,#PB_Window_screencentered|#PB_Window_SystemMenu,"Création de statut")
  CreateGadgetList(req2)
  TextGadget(40,30,10,400,14,"Nom (ou partie) du processus")
  EditorGadget(50,30,30,400,20)
  TextGadget(30,30,70,270,14,"Autoriser?")
  ButtonGadget(10,100,60,60,30,"Oui")
  ButtonGadget(20,200,60,60,30,"Non")
SetWindowPos_(req,-1,0,0,0,0,2|1)
run3=1
Repeat
event2=WaitWindowEvent()
Select event2 
    Case #PB_Event_CloseWindow
    run3=0
    Case #pb_event_gadget
    Select EventGadgetID()
    Case 10
      run3=0
      nom.s=GetGadgetText(50)
      If nom<>""
      If cherche(nom)
      MessageRequester("Surveillance","Déjà répertorié")
      Else
      nbliste=nbliste+1:liste(nbliste)=nom:statut(nbliste)=1
      sauver() : nouveau=1
      EndIf
      EndIf
    
    Case 20
      run3=0
      nom.s=GetGadgetText(50)
      If nom<>""
      If cherche(nom)
      MessageRequester("Surveillance","Déjà répertorié")
      Else
      nbliste=nbliste+1:liste(nbliste)=nom:statut(nbliste)=0
      sauver() : nouveau=1
      EndIf
      EndIf
    
    EndSelect
EndSelect

Until run3=0
CloseWindow(3)

EndProcedure


;-----------------------------------------------------

Procedure cherche(nom.s)
For i=1 To nbliste
If FindString(LCase(nom),LCase(liste(i)),1)
ProcedureReturn i
EndIf
Next i
ProcedureReturn 0
EndProcedure

;---------------------------------------------------

Procedure examen()
If Left(entree,2)="&&"
nbactuel=0
entree=Right(entree,Len(entree)-2)
Repeat
nbactuel=nbactuel+1
pos=FindString(entree,"&&",1)
actuel(nbactuel)=Left(entree,pos-1)
entree=Right(entree,Len(entree)-pos-1)
pos=FindString(entree,"&&",1)
id(nbactuel)=Val(Left(entree,pos-1))
entree=Right(entree,Len(entree)-pos-1)
Until Len(entree)=0
EndIf
EndProcedure

;---------------------------------------------------

Procedure ResetListe()
Dim liste2.s(nbliste+1)
For k=1 To nbliste
liste2(k)=liste(k)+Str(statut(k))
Next k

ClearGadgetItemList(2)
ClearGadgetItemList(3)
SortArray(liste2(),2,1,nbliste)
For k=1 To nbactuel
If etat(k)
state.s="En pause"
Else
state.s="Actif"
EndIf

AddGadgetItem(2,-1,actuel(k)+Chr(10)+Str(id(k))+Chr(10)+state)
Next k
For k=1 To nbliste
liste(k)=Left(liste2(k),Len(liste2(k))-1)
If Right(liste2(k),1)="1"
statut(k)=1
state.s="Autorisé"
Else
statut(k)=0
state.s="Interdit"
EndIf
AddGadgetItem(3,-1,Left(liste2(k),Len(liste2(k))-1)+Chr(10)+state)
Next k
EndProcedure



Procedure reception(Win, Message, wParam, lParam)
Shared Sender_ProcessHandle.l
  result = #PB_ProcessPureBasicEvents
  
  If result=#PB_Event_CloseWindow
  run=0
  refresh()
  EndIf
    
  Select Message
  
    Case 673
       Sender_ProcessHandle = OpenProcess_(282, 0, lParam)
      If Sender_ProcessHandle <> 0
        result =1
      Else
        result =0
      EndIf
      
    Case 674
      entree.s = Space(lParam)
      If ReadProcessMemory_(Sender_ProcessHandle, wParam, @entree, lParam, @BytesRead.l) <> 0
        If BytesRead <> lParam
          result =0
        Else
        If Len(entree)>0
          refresh()
        EndIf
          result =1
        EndIf
      Else
        result =0
      EndIf
  
  EndSelect
  ProcedureReturn result
EndProcedure


; ----------------------------------------------

Procedure request()
nom.s=requetenom(1)
pid=requeteid(1)
  req=OpenWindow(10,0,0,500,60,#PB_Window_screencentered,"Processus non répertorié")
  CreateGadgetList(req)
  TextGadget(30,30,20,270,40,"Autoriser "+nom+"?")
  ButtonGadget(10,300,10,60,30,"Oui")
  ButtonGadget(20,400,10,60,30,"Non")
  run2=1
  
  Repeat
  Delay(1)
  SetWindowPos_(req,-1,0,0,0,0,2|1)
  event2=WindowEvent()
  Select event2 
    Case #pb_event_gadget
    Select EventGadgetID()
    Case 10
    nbliste=nbliste+1
    liste(nbliste)=nom
    statut(nbliste)=1
    resume(pid)
    run2=0
    
    Case 20
    run2=0
    nbliste=nbliste+1
    liste(nbliste)=nom
    statut(nbliste)=0
    kill(pid)
   
    EndSelect
  EndSelect
  Until run2=0
  sauver()
  requeteactuelle=0:supprime=1
  CloseWindow(10)
  ResetListe()
EndProcedure

; ---------------------------------------------

Procedure pause(pid)

thread.thread32

snap = CallFunction (0, "CreateToolhelp32Snapshot",4,0)
If snap

thread\size=SizeOf(thread32)
CallFunction(0,"Thread32First",snap,@thread)

If thread\parentid=pid
  h=CallFunction(0,"OpenThread",2,0,thread\idth)
  SuspendThread_(h)
  CloseHandle_(h)
EndIf

While CallFunction(0,"Thread32Next",snap,@thread)

If thread\parentid=pid
  h=CallFunction(0,"OpenThread",2,0,thread\idth)
  SuspendThread_(h)
  CloseHandle_(h)
EndIf

Wend

EndIf

EndProcedure

; -----------------------------------------
Procedure resume(pid)

thread.thread32

snap = CallFunction (0, "CreateToolhelp32Snapshot",4,0)
If snap

thread\size=SizeOf(thread32)
CallFunction(0,"Thread32First",snap,@thread)

If thread\parentid=pid
  h=CallFunction(0,"OpenThread",2,0,thread\idth)
  ResumeThread_(h)
  CloseHandle_(h)
EndIf

While CallFunction(0,"Thread32Next",snap,@thread)

If thread\parentid=pid
  h=CallFunction(0,"OpenThread",2,0,thread\idth)
  ResumeThread_(h)
  CloseHandle_(h)
EndIf

Wend

EndIf
EndProcedure

; -------------------------------------------

Procedure privilege(pid)

ph=OpenProcess_($1F0FFF,1,pid)
OpenProcessToken_(ph,$20,@h)

Dim p.s(29)
p(0)="SeAssignPrimaryTokenPrivilege"
p(1)="SeAuditPrivilege"
p(2)="SeBackupPrivilege"
p(3)="SeChangeNotifyPrivilege"
p(4)="SeCreateGlobalPrivilege"
p(5)="SeCreatePagefilePrivilege"
p(6)="SeCreatePermanentPrivilege"
p(7)="SeCreateTokenPrivilege"
p(8)="SeDebugPrivilege"
p(9)="SeEnableDelegationPrivilege"
p(10)="SeImpersonatePrivilege"
p(11)="SeIncreaseBasePriorityPrivilege"
p(12)="SeIncreaseQuotaPrivilege"
p(13)="SeLoadDriverPrivilege"
p(14)="SeLockMemoryPrivilege"
p(15)="SeMachineAccountPrivilege"
p(16)="SeManageVolumePrivilege"
p(17)="SeProfileSingleProcessPrivilege"
p(18)="SeRemoteShutdownPrivilege"
p(19)="SeRestorePrivilege"
p(20)="SeSecurityPrivilege"
p(21)="SeShutdownPrivilege"
p(22)="SeSyncAgentPrivilege"
p(23)="SeSystemEnvironment"
p(24)="SeSystemProfilePrivilege"
p(25)="SeSystemtimePrivilege"
p(26)="SeTakeOwnershipPrivilege"
p(27)="SeTcbPrivilege"
p(28)="SeUndockPrivilege"
p(29)="SeUnsolicitedInputPrivilege"

Structure LI
low.l
high.l
EndStructure

Structure luidandattributes
pluid.LI
attrib.l
EndStructure

Structure privileges
count.l
privilege.luidandattributes
EndStructure

shut.LI
result=1
For i=0 To 29
LookupPrivilegeValue_(0,@p(i),@shut)

newprivilege.privileges
newprivilege\count=1
newprivilege\privilege\attrib=2
newprivilege\privilege\pluid\low=shut\low
newprivilege\privilege\pluid\high=shut\high

result=result*AdjustTokenPrivileges_(h,0,newprivilege,SizeOf(privileges),0,0)
Next i

ProcedureReturn result
EndProcedure

relance

Code : Tout sélectionner

path.s=Space(255) 
GetModuleFileName_(0,@path,255)

While Right(path,1)<>"\"
path=Left(path,Len(path)-1)
Wend

hWnd=Val(ProgramParameter())
If SendMessage_(hWnd,673, 0, GetCurrentProcessId_())=0
End
EndIf

Dim actuel.s(100)
Structure PROCESSENTRY32 
    dwSize.l 
    cntUsage.l 
    th32ProcessID.l 
    th32DefaultHeapID.l 
    th32ModuleID.l 
    cntThreads.l 
    th32ParentProcessID.l 
    pcPriClassBase.l 
    dwFlags.l 
    szExeFile.b[260] 
EndStructure 

If OpenLibrary (0,"kernel32.dll")=0
MessageRequester("Relance","Echec initialisation")
Else

Repeat
nbactuel=0
    s=CallFunction(0,"CreateToolhelp32Snapshot",274,0)
    If s
        DefType.PROCESSENTRY32 Proc32 
        Proc32\dwSize = SizeOf(PROCESSENTRY32) 
           If CallFunction(0,"Process32First",s, @Proc32) 
            nbactuel=nbactuel+1
            actuel(nbactuel)="&&"+PeekS(@Proc32\szExeFile)+"&&"+Str(proc32\th32ProcessID)
            While CallFunction (0, "Process32Next", s, @Proc32) 
                nbactuel=nbactuel+1
                actuel(nbactuel)="&&"+PeekS (@Proc32\szExeFile)+"&&"+Str(proc32\th32ProcessID)
            Wend
           EndIf
     EndIf 
SortArray(actuel(),2,1,nbactuel)

If nbactuel=0
RunProgram(path+"relance.exe",Str(hWnd),"")
End
EndIf

resultat.s=""
For k=1 To nbactuel
resultat=resultat+actuel(k)
Next k

If SendMessage_(hWnd,674, @resultat, Len(resultat))=0
RunProgram("c:\survey\relance.exe",Str(hWnd),"")
End
EndIf
Delay(200)

ForEver
EndIf
End

Jacobus · Message par **Jacobus** » ven. 11/juin/2004 18:55

Salut

Personnellement je fais comme ceci avec les fonctions LoadImage et ImageGadget :

Code : Tout sélectionner

If LoadImage(#image_2,"C:\Program Files\PMC Utilitaire Standard\PM_01.ico")
       ImageGadget(#image_2,435,175,32,32,UseImage(#image_2),#PB_Image_Border) 
   EndIf

Et ça fonctionne très bien. En donnant le nom de la constante il y a moins de risque d'erreur. Mon gadget est mon image. De plus je les laisse généralement ensemble, écris l'un après l'autre: Load puis aussitôt Use comme dans le bout de code ci-dessus.

Il me semble que sur ton code les valeurs sont différentes :

ImageGadget(30, , , , , UseImage(1))

Maintenant, j'ai remarqué qu'un .exe fonctionne mieux avec un CatchImage qu'avec un LoadImage

Bah, pourquoi ? j'en sais rien.
ca alourdi l'exe c'est sûr, mais ça évite des déplacements d'image par mégarde et donc la disparition de celle-ci dans l'appli.
(Je dis ça parce que ça m'est arrivé

)

Sinon avec le CatchImage :

Code : Tout sélectionner

Global Image2
 Image2 = CatchImage(2, ?Image2)
 Image2:IncludeBinary "C:\Program Files\PMC Utilitaire Standard\PM_01.ico"
;/Une fois ton image chargée tu la place n'importe où dans ta GadgetList
ImageGadget(#image_2, 435,175,32,32,Image2)

Je joue toujours dans la catégorie débutant, donc il se peut que je dise une cône riz (pas de gros mot

) mais j'ai jamais eu de plantage avec ça.

T'as qu'à essayer tu verras bien, salut

Jacobus

fweil · Message par **fweil** » ven. 11/juin/2004 18:59

hardy,

ton pb vient apparement du fait que l'icone est dans un format non supporté par LoadImage ...

Si tu ajoutes un truc du genre :

UseEC_OLEImageDecoder(à (en oubliant pas d'avoir la lib ad-hoc) ça fonctionne.

Jacobus · Message par **Jacobus** » ven. 11/juin/2004 19:05

@Fweil

LoadImage supporte poutant les formats .ico et .bmp

vu que cela fonctionne chez moi.

Tu peux expliquer

jacobus

fweil · Message par **fweil** » ven. 11/juin/2004 19:05

Par contre ... j'ai oublié dans la précipitation :

Félicitations !

L'est peut être pas top fini mais c'est du bon travail.

hardy · Message par **hardy** » ven. 11/juin/2004 20:26

L'image est au format bmp. Je ne pense pas que ce soit un problème de format. Vais essayer catchimage.
Viens de m'appercevoir que je n'ai pas mis de closehandle(s) dans relance.exe! C'est peut-être là le problème qui oblige à relancer (saturation)
J'essaie, auquel cas plus besoin de deux programmes séparés...

fweil · Message par **fweil** » ven. 11/juin/2004 20:29

c'est le .ico qui plante pas le .bmp

hardy · Message par **hardy** » ven. 11/juin/2004 20:58

Le code tel quel, sans le gadgetimage fonctionne, et utilise l'image .ico
Fais tourner le bidule : marche
rajoute le gadgetimage : plante

ai essayé un catchimage : idem

De plus un closehandle dans relance ne donne rien.
Tel quel, marche, mais as-tu une idée de la raison pour laquelle, de temps en temps (variable, parfois au bout de trente secondes), l'appel à createtoolhelpsnapshot échoue?

hardy · Message par **hardy** » ven. 11/juin/2004 23:30

Problème réglé: c'est simplement que dans request(), je créais un gadget de même numéro que l'imagegadget!! (je pensais qu'étant dans une procédure, du son no était considéré comme local et que cela ne posais pas de problème.
Code pour surveillance.exe mis à jour:

Code : Tout sélectionner

If FindWindow_(0,"Surveillance - Mode pause") Or FindWindow_(0,"Surveillance - Mode normal")
MessageRequester("Surveillance","Programme déjà actif")
End
EndIf


Declare privilege(pid)
privilege(GetCurrentProcessId_())


Structure thread32
size.l
use.l
idth.l
parentid.l
base.l
delta.l
flags.l
EndStructure

Structure proc
nom.s
id.l
EndStructure

Declare refresh()
Declare sauver()
Declare kill(idd.l)
Declare creerstatut()
Declare cherche(nom.s)
Declare focus(req)
Declare resetliste()
Declare reception(Window, Message, wParam, lParam)
Declare request()
Declare pause(pid)
Declare resume(pid)
Declare examen()

If OpenLibrary(0,"kernel32.dll")=0
MessageRequester("Surveillance","Erreur d'ouverture de kernel32.dll")
End
EndIf

idsurveillance=GetCurrentProcessId_()

Global path.s,idsurveillance
path.s=Space(255) 
GetModuleFileName_(0,@path,255)

While Right(path,1)<>"\"
path=Left(path,Len(path)-1)
Wend

;path="c:\survey\"

; A MODIFIER--------------- ainsi que le la fin (label Berlioz)

LoadImage(0,path+"berlioz.ico")

; ----------------------------------



Dim requeteid.l(200)
Dim requetenom.s(200)
Dim liste.s(1000)
Dim statut.b(1000)
Dim actuel.s(1000)
Dim id.l(1000)
Dim etat.b(1000)
NewList lrequest.proc()
Global listprocess.s,nbliste.l,nprocess.l,requeteactuelle.b
Global liste,statut,adresse.l,nouveau.b,reprise.b
Global actuel,id,nbactuel.l,start.b,entree.s,supprime.b
Global run.b,nbrequete.l,hwin.l,mode.b,titre.s,x.l,runsprite.b
Global requeteid,requetenom

;--------------- Lecture config---------------------

nrequest=0

If ReadFile(0,path+"surv.cfg")
mode=ReadByte()
nbliste=0
Repeat
nbliste=nbliste+1
liste(nbliste)=ReadString()
statut(nbliste)=ReadByte()
Until Eof(0)
CloseFile(0)
Else
nbliste=3
liste(1)="surveillance.exe"
statut(1)=1
liste(2)="relance.exe"
statut(2)=1
liste(3)="system"
statut(3)=1
sauver()
EndIf

If mode
titre="Surveillance - Mode pause"
Else
titre="Surveillance - Mode normal"
EndIf

;--------------Main------------------------
start=1 : run=1 :frequence=100

win.l=OpenWindow(0,0,0,530,380,#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget|#PB_Window_Invisible,titre)
CreateMenu(20,win)
MenuTitle("Mode")
MenuItem(20,"Mode normal")
MenuItem(21,"Mode pause")
CreateGadgetList(win)

Image= CatchImage(1, ?Berlioz) 
ImageGadget(100, 355,50,167,250,Image)

PanelGadget(1,0,0,350,350)
AddGadgetItem(1,0,"Processus en cours")
ListIconGadget(2,0,0,330,280,"Nom",150)
AddGadgetColumn(2,1,"ID",58)
AddGadgetColumn(2,2,"Etat",100)
ButtonGadget(5,10,290,60,20,"Stopper")
ButtonGadget(8,90,290,60,20,"Pause")
ButtonGadget(15,170,290,60,20,"Reprendre")
AddGadgetItem(1,1,"Statuts")
ListIconGadget(3,0,0,330,280,"Nom",150)
AddGadgetColumn(3,1,"Statut",158)
ButtonGadget(4,10,290,60,20,"Changer")
ButtonGadget(6,90,290,60,20,"Créer")
ButtonGadget(7,170,290,60,20,"Effacer")

;CloseGadgetList()

run=1
SetWindowText_(win,@titre)
SetWindowCallback(@reception())
RunProgram(path+"relance.exe",Str(win),"")

AddSysTrayIcon(0,win,UseImage(0))
SysTrayIconToolTip(0,"Surveillance")

Repeat
event=WaitWindowEvent()

If IsIconic_(win)<>0 And hide=0
HideWindow(0,1):hide=1
EndIf

Select event
  Case #PB_eventmenu
  Select EventMenuID()
  Case 20
  mode=0:titre="Surveillance - Mode normal"
  SetWindowText_(win,@titre)
  Case 21
  mode=1:titre="Surveillance - Mode pause"
  SetWindowText_(win,@titre)
  EndSelect
  
  Case #PB_Event_SysTray
  HideWindow(0,0):hide=0
  SetForegroundWindow_(win)
  Case #PB_Event_CloseWindow
  If MessageRequester("Surveillance","Quitter?",#PB_MessageRequester_YesNo)=6
  run=0
  sauver()
  refresh()
  EndIf 
    
  Case #PB_Event_Gadget
  Select EventGadgetID()
  
    Case 5
    n=GetGadgetState(2)+1
    If n>0
    If GetGadgetText(2)<>"relance.exe"
    kill(id(n))
    EndIf
    EndIf
    
    Case  4
    n=GetGadgetState(3)+1
    If n>0
    If statut(n)=1
    statut(n)=0
    Else
    statut(n)=1
    EndIf
    resetliste()
    sauver()
    EndIf
    
    Case 6
    CreateThread(@creerstatut(),0)
    
    Case 7
    n=GetGadgetState(3)+1
    If n>0
    For i=n+1 To nbliste
    liste(i-1)=liste(i)
    statut(i-1)=statut(i)
    Next i
    nbliste=nbliste-1
    sauver()
    resetliste()
    EndIf   
    
    Case 8
    n=GetGadgetState(2)+1
    If n>0 And etat(n)=0
    pause(id(n))
    etat(n)=1
    resetliste()
    EndIf

    Case 15
    n=GetGadgetState(2)+1
    If n>0 
    resume(id(n))
    etat(n)=0
    resetliste()
    EndIf

  EndSelect
  
EndSelect
ForEver
End

;--- Procedures --- 

Procedure refresh()

If supprime
supprime=0
nbrequete=nbrequete-1
For i=1 To nbrequete
requeteid(i)=requeteid(i+1)
requetenom(i)=requetenom(i+1)
Next i
EndIf

ClearList(lrequest())
Dim encours.s(1000)
oldnbactuel=nbactuel
examen()
For j=1 To nbactuel
nom.s=actuel(j)
idd.l=id(j)
pos=cherche(nom)
If LCase(nom)="relance.exe" And run=0
kill(idd)
EndIf

If pos
  If statut(pos)=0
    kill(idd)
  EndIf
Else
  vu=0
  For i=1 To nbrequete
  If requeteid(i)=idd
  vu=1
  EndIf
  Next i
  If vu=0
  If mode :pause(idd)
  EndIf
  nouveau=1
  nbrequete=nbrequete+1
  requeteid(nbrequete)=idd
  requetenom(nbrequete)=nom
  EndIf
EndIf

Next j

If requeteactuelle=0 And nbrequete>0
requeteactuelle=1
CreateThread(@request(),0)
EndIf

If run=0 : End :EndIf



If nouveau Or start Or nbactuel<>oldnbactuel
ResetListe()
EndIf
nouveau=0:start=0

EndProcedure

;------------------------------------------------

Procedure sauver()
DeleteFile(path+"surv.cfg")
If OpenFile(0,path+"surv.cfg")
WriteByte(mode)
For i=1 To nbliste
WriteStringN(liste(i))
WriteByte(statut(i))
Next i
CloseFile(0)
EndIf

EndProcedure

;------------------------------------------------

Procedure kill(idd)

h=OpenProcess_($1F0FFF,0,idd)
GetExitCodeProcess_(h,@code)
TerminateProcess_(h,code)
CloseHandle_(h)

EndProcedure


;-------------------------------------------------

Procedure creerstatut()
req2=OpenWindow(2,0,0,500,120,#PB_Window_screencentered|#PB_Window_SystemMenu,"Création de statut")
  CreateGadgetList(req2)
  TextGadget(40,30,10,400,14,"Nom (ou partie) du processus")
  EditorGadget(50,30,30,400,20)
  TextGadget(30,30,70,270,14,"Autoriser?")
  ButtonGadget(10,100,60,60,30,"Oui")
  ButtonGadget(20,200,60,60,30,"Non")
SetWindowPos_(req,-1,0,0,0,0,2|1)
run3=1
Repeat
event2=WaitWindowEvent()
Select event2 
    Case #PB_Event_CloseWindow
    run3=0
    Case #pb_event_gadget
    Select EventGadgetID()
    Case 10
      run3=0
      nom.s=GetGadgetText(50)
      If nom<>""
      If cherche(nom)
      MessageRequester("Surveillance","Déjà répertorié")
      Else
      nbliste=nbliste+1:liste(nbliste)=nom:statut(nbliste)=1
      sauver() : nouveau=1
      EndIf
      EndIf
    
    Case 20
      run3=0
      nom.s=GetGadgetText(50)
      If nom<>""
      If cherche(nom)
      MessageRequester("Surveillance","Déjà répertorié")
      Else
      nbliste=nbliste+1:liste(nbliste)=nom:statut(nbliste)=0
      sauver() : nouveau=1
      EndIf
      EndIf
    
    EndSelect
EndSelect

Until run3=0
CloseWindow(3)

EndProcedure


;-----------------------------------------------------

Procedure cherche(nom.s)
For i=1 To nbliste
If FindString(LCase(nom),LCase(liste(i)),1)
ProcedureReturn i
EndIf
Next i
ProcedureReturn 0
EndProcedure

;---------------------------------------------------

Procedure examen()
If Left(entree,2)="&&"
nbactuel=0
entree=Right(entree,Len(entree)-2)
Repeat
nbactuel=nbactuel+1
pos=FindString(entree,"&&",1)
actuel(nbactuel)=Left(entree,pos-1)
entree=Right(entree,Len(entree)-pos-1)
pos=FindString(entree,"&&",1)
id(nbactuel)=Val(Left(entree,pos-1))
entree=Right(entree,Len(entree)-pos-1)
Until Len(entree)=0
EndIf
EndProcedure

;---------------------------------------------------

Procedure ResetListe()
Dim liste2.s(nbliste+1)
For k=1 To nbliste
liste2(k)=liste(k)+Str(statut(k))
Next k

ClearGadgetItemList(2)
ClearGadgetItemList(3)
SortArray(liste2(),2,1,nbliste)
For k=1 To nbactuel
If etat(k)
state.s="En pause"
Else
state.s="Actif"
EndIf

AddGadgetItem(2,-1,actuel(k)+Chr(10)+Str(id(k))+Chr(10)+state)
Next k
For k=1 To nbliste
liste(k)=Left(liste2(k),Len(liste2(k))-1)
If Right(liste2(k),1)="1"
statut(k)=1
state.s="Autorisé"
Else
statut(k)=0
state.s="Interdit"
EndIf
AddGadgetItem(3,-1,Left(liste2(k),Len(liste2(k))-1)+Chr(10)+state)
Next k
EndProcedure



Procedure reception(Win, Message, wParam, lParam)
Shared Sender_ProcessHandle.l
  result = #PB_ProcessPureBasicEvents
  
  If result=#PB_Event_CloseWindow
  run=0
  refresh()
  EndIf
    
  Select Message
  
    Case 673
       Sender_ProcessHandle = OpenProcess_(282, 0, lParam)
      If Sender_ProcessHandle <> 0
        result =1
      Else
        result =0
      EndIf
      
    Case 674
      entree.s = Space(lParam)
      If ReadProcessMemory_(Sender_ProcessHandle, wParam, @entree, lParam, @BytesRead.l) <> 0
        If BytesRead <> lParam
          result =0
        Else
        If Len(entree)>0
          refresh()
        EndIf
          result =1
        EndIf
      Else
        result =0
      EndIf
  
  EndSelect
  ProcedureReturn result
EndProcedure


; ----------------------------------------------

Procedure request()
nom.s=requetenom(1)
pid=requeteid(1)
  req=OpenWindow(10,0,0,500,60,#PB_Window_screencentered,"Processus non répertorié")
  CreateGadgetList(req)
  TextGadget(30,30,20,270,40,"Autoriser "+nom+"?")
  ButtonGadget(10,300,10,60,30,"Oui")
  ButtonGadget(20,400,10,60,30,"Non")
  run2=1
  
  Repeat
  Delay(1)
  SetWindowPos_(req,-1,0,0,0,0,2|1)
  event2=WindowEvent()
  Select event2 
    Case #pb_event_gadget
    Select EventGadgetID()
    Case 10
    nbliste=nbliste+1
    liste(nbliste)=nom
    statut(nbliste)=1
    resume(pid)
    run2=0
    
    Case 20
    run2=0
    nbliste=nbliste+1
    liste(nbliste)=nom
    statut(nbliste)=0
    kill(pid)
   
    EndSelect
  EndSelect
  Until run2=0
  sauver()
  requeteactuelle=0:supprime=1
  CloseWindow(10)
  ResetListe()
EndProcedure

; ---------------------------------------------

Procedure pause(pid)

thread.thread32

snap = CallFunction (0, "CreateToolhelp32Snapshot",4,0)
If snap

thread\size=SizeOf(thread32)
CallFunction(0,"Thread32First",snap,@thread)

If thread\parentid=pid
  h=CallFunction(0,"OpenThread",2,0,thread\idth)
  SuspendThread_(h)
  CloseHandle_(h)
EndIf

While CallFunction(0,"Thread32Next",snap,@thread)

If thread\parentid=pid
  h=CallFunction(0,"OpenThread",2,0,thread\idth)
  SuspendThread_(h)
  CloseHandle_(h)
EndIf

Wend

EndIf

EndProcedure

; -----------------------------------------
Procedure resume(pid)

thread.thread32

snap = CallFunction (0, "CreateToolhelp32Snapshot",4,0)
If snap

thread\size=SizeOf(thread32)
CallFunction(0,"Thread32First",snap,@thread)

If thread\parentid=pid
  h=CallFunction(0,"OpenThread",2,0,thread\idth)
  ResumeThread_(h)
  CloseHandle_(h)
EndIf

While CallFunction(0,"Thread32Next",snap,@thread)

If thread\parentid=pid
  h=CallFunction(0,"OpenThread",2,0,thread\idth)
  ResumeThread_(h)
  CloseHandle_(h)
EndIf

Wend

EndIf
EndProcedure

; -------------------------------------------

Procedure privilege(pid)

ph=OpenProcess_($1F0FFF,1,pid)
OpenProcessToken_(ph,$20,@h)

Dim p.s(29)
p(0)="SeAssignPrimaryTokenPrivilege"
p(1)="SeAuditPrivilege"
p(2)="SeBackupPrivilege"
p(3)="SeChangeNotifyPrivilege"
p(4)="SeCreateGlobalPrivilege"
p(5)="SeCreatePagefilePrivilege"
p(6)="SeCreatePermanentPrivilege"
p(7)="SeCreateTokenPrivilege"
p(8)="SeDebugPrivilege"
p(9)="SeEnableDelegationPrivilege"
p(10)="SeImpersonatePrivilege"
p(11)="SeIncreaseBasePriorityPrivilege"
p(12)="SeIncreaseQuotaPrivilege"
p(13)="SeLoadDriverPrivilege"
p(14)="SeLockMemoryPrivilege"
p(15)="SeMachineAccountPrivilege"
p(16)="SeManageVolumePrivilege"
p(17)="SeProfileSingleProcessPrivilege"
p(18)="SeRemoteShutdownPrivilege"
p(19)="SeRestorePrivilege"
p(20)="SeSecurityPrivilege"
p(21)="SeShutdownPrivilege"
p(22)="SeSyncAgentPrivilege"
p(23)="SeSystemEnvironment"
p(24)="SeSystemProfilePrivilege"
p(25)="SeSystemtimePrivilege"
p(26)="SeTakeOwnershipPrivilege"
p(27)="SeTcbPrivilege"
p(28)="SeUndockPrivilege"
p(29)="SeUnsolicitedInputPrivilege"

Structure LI
low.l
high.l
EndStructure

Structure luidandattributes
pluid.LI
attrib.l
EndStructure

Structure privileges
count.l
privilege.luidandattributes
EndStructure

shut.LI
result=1
For i=0 To 29
LookupPrivilegeValue_(0,@p(i),@shut)

newprivilege.privileges
newprivilege\count=1
newprivilege\privilege\attrib=2
newprivilege\privilege\pluid\low=shut\low
newprivilege\privilege\pluid\high=shut\high

result=result*AdjustTokenPrivileges_(h,0,newprivilege,SizeOf(privileges),0,0)
Next i

ProcedureReturn result
EndProcedure

Berlioz:IncludeBinary "c:\survey\berlioz.bmp"

Puis c'est Berlioz (un de mes chats) qui va être content : je lui avais promis qu'il aurait sa photo dans le programme s'il arrêtait de marcher sur les touches de mon ordinateur quand j'ai le dos tourné