PureBasic

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

Gestion des processus

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

Page 1 sur 1

Gestion des processus

Publié : ven. 11/juin/2004 16:45
par hardy
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?

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 systeminfo
    dwOemID.l
    pagesize.l
    minaddress.l
    maxaddress.l
    dwActiveProcessorMask.l
    dwNumberOfProcessors.l
    dwProcessorType.l
    dwAllocationGranularity.l
    dwReserved.l
EndStructure

info.systeminfo
GetSystemInfo_(@info)

Structure meminfo
    baseaddress.l
    base.l
    allocprotect.l
    regionsize.l
    state.l
    protect.l
    type.l
EndStructure


Global info

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 sprite(wind)
Declare refresh()
Declare sauver()
Declare kill(idd.l)
Declare creerstatut()
Declare reglagefrequence()
Declare cherche(nom.s)
Declare examen()
Declare focus(req)
Declare resetliste()
Declare relance(null)
Declare reception(Window, Message, wParam, lParam)
Declare request()
Declare pause(pid)
Declare resume(pid)
Declare paint()

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
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru