PureBasic

En passant, j'ai changé de DLL pour le suivi des processus.
ICI
Ca doit maintenant marcher sous win2k. (et plus de problème de sablier de temps en temps)
Quelqu'un peut confirmer?

Salut,

ça marche que sous XP NT et 2K ? ou sur touts les systèmes ?

Ben faut essayer. peut-être sous win98 (?).
Peux pas dire : j'ai que XP Pro.

C'est nettement mieux côté sablier

Je tourne avec et j'ai XP édition familiale, Pack2, Norton internet security

Je confirme, je n'ai plus d'apparition du sablier.

Dans un moment de désoeuvrement, j'ai rajouté deux bricoles.
Alors, je sais toujours pas si ça marche ailleurs que sous XP...

Je ne sais pas quelle fonction tu utilises, mais méfie-toi. Je crois me souvenir que sous NT la liste des processus n'a pas le même format que sous XP ou 98. (sous nt il n'y a pas le chemin si je me souviens bien).

Je n'ai pas malheureusement pas de poste NT actuellement sous la main donc je ne peux pas t'en dire plus

Là, j'utilise la lib psapi.
En WMI, ça plante au bout d'un moment, et il faut relancer. Sais pas pourquoi.
Idem avec CreateToolhelp32Snapshot & Co.

Tiens, je ne connais pas cette lib. Moi j'utilise CreateToolhelp32Snapshot et ça ne plante pas... Enfin, si ça marche comme ça pour toi!

Utilise dans un prog createtoolhelpsnapshot32 toute les 50ms, et regarde l'évolution de la mémoire dans le taskmanager...
Au bout d'un moment, tu ne recois plus rien.
Sais pas pourquoi.

Hardy, tu parles de WMI : je cherche à faire une appli style "security center" ! peux-tu me préciser quels sont tes problèmes avec WMI ? et puis demain j'essaye ton programme (un peu tard ce soir)...

A+

Voilà le code que j'ai repompé je ne sais plus où (codearchiv sûrement...)

Code : Tout sélectionner

;********************************************************************************************************
;Initialise une liste de processus actifs
Procedure.l get_process_list()
  ; Add processes to Process32 () list... 
  ClearList(Process32 ())
  If OpenLibrary (#PROCESS32LIB, "kernel32.dll") 

      snap = CallFunction (#PROCESS32LIB, "CreateToolhelp32Snapshot", #TH32CS_SNAPPROCESS, 0) 

      If snap 

          DefType.PROCESSENTRY32 Proc32 
          Proc32\dwSize = SizeOf (PROCESSENTRY32) 
          
          If CallFunction (#PROCESS32LIB, "Process32First", snap, @Proc32) 

              AddElement (Process32 ()) 
              CopyMemory (@Proc32, @Process32 (), SizeOf (PROCESSENTRY32)) 
              
              While CallFunction (#PROCESS32LIB, "Process32Next", snap, @Proc32) 
                  AddElement (Process32 ()) 
                  CopyMemory (@Proc32, @Process32 (), SizeOf (PROCESSENTRY32)) 
              Wend 
              
          EndIf    
          CloseHandle_ (snap) 
      
      EndIf 

      CloseLibrary (#PROCESS32LIB) 
      ProcedureReturn #TRUE
  Else
    ProcedureReturn #FALSE
  EndIf 
EndProcedure

Oui, j'utilisais ce genre de code. Mais pour des raisons inconues, la mémoire du processus avec des itérations augmente et au bout d'un moment, ça ne retourne plus rien.
TOujours pas compris pourquoi.
Même problème avec l'utilisation de WMI.
@Golfy : même problème : augmentation progressive de la mémoire utilisée puis arrêt.

un code que j'avais posté, si ça t'intéresse:

Code : Tout sélectionner


#COINIT_MULTITHREAD=0 
#RPC_C_AUTHN_LEVEL_CONNECT=2 
#RPC_C_IMP_LEVEL_IDENTIFY=2 
#EOAC_NONE=0 
#RPC_C_AUTHN_WINNT=10 
#RPC_C_AUTHZ_NONE=0 
#RPC_C_AUTHN_LEVEL_CALL=3 
#RPC_C_IMP_LEVEL_IMPERSONATE=3 
#CLSCTX_INPROC_SERVER=1 
#WBEM_S_NO_ERROR = 0 

Structure d
  l.l
  h.l
EndStructure


Procedure.l ansi2bstr(ansi.s) 
  size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0) 
  Dim unicode.w(size) 
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size) 
  ProcedureReturn SysAllocString_(@unicode()) 
EndProcedure 

Procedure.s unicode2ansi(mem)
  ansi.s=""
  Repeat
    a=PeekW(mem)
    ansi=ansi+Chr(a)
    mem+2
  Until a=0
  ProcedureReturn ansi
EndProcedure



; ___________________ Initialisations __________________________ 

; partout, hres doit être nul si pas d'erreur 

CoInitializeEx_(0,#COINIT_MULTITHREAD)
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0) 
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator) 
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices) 
hres=svc\queryinterface(?IID_IUnknown,@pUnk.IUnknown)
hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
pUnk\release()
hres=CoCreateInstance_(?CLSID_WbemRefresher,0,#CLSCTX_INPROC_SERVER,?IID_IWbemRefresher,@pRefresher.IWbemRefresher)
hres=pRefresher\queryinterface(?IID_IWbemConfigureRefresher,@pConfig.IWbemConfigureRefresher)
hres=pConfig\AddEnum(svc,ansi2bstr("Win32_PerfFormattedData_PerfProc_Process"),0,0,@penum.IWbemHiPerfEnum,@id)
pConfig\release()
Dim tab.IWbemObjectAccess(100)
For x=1 To 2
pRefresher\refresh(0)
hres=penum\GetObjects(0,100*SizeOf(IWbemObjectAccess),@tab(),@retour.l)
If x=1
  hres=tab(0)\GetPropertyHandle(ansi2bstr("IdProcess"),0,@hIDProcess)
  hres=tab(0)\GetPropertyHandle(ansi2bstr("PercentProcessorTime"),0,@hpercent)
  hres=tab(0)\GetPropertyHandle(ansi2bstr("WorkingSet"),0,@hsize)
  hres=tab(0)\GetPropertyHandle(ansi2bstr("Name"),0,@hname)
EndIf
If x>1
Debug "***************************************"
For i=0 To retour-1
  tab(i)\ReadDWORD(hIDProcess,@IDProcess)
  tab(i)\ReadDWORD(hpercent,@percent)
  tab(i)\ReadDWORD(hsize,@size)
  name.s=Space(255)
  tab(i)\Readpropertyvalue(hname,255,@len,@name)
  Debug "Nom="+unicode2ansi(@name)+" id="+Str(IDProcess)+"   CPU usage="+Str(percent)+"%  Memory="+Str(size>>10)+"Ko"
  tab(i)\release()
Next i
EndIf
Delay(500)
Next
penum\release()
pRefresher\release();
svc\release() 
loc\release() 
CoUninitialize_() 
End

;_______________ données_________________________ 

DataSection 
CLSID_WbemLocator: 
    ;4590f811-1d3a-11d0-891f-00aa004b2e24 
Data.l $4590F811 
Data.w $1D3A, $11D0 
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24 
IID_IWbemLocator: 
    ;dc12a687-737f-11cf-884d-00aa004b2e24 
Data.l $DC12A687 
Data.w $737F, $11CF 
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
IID_IUnknown: 
    ;00000000-0000-0000-C000-000000000046 
Data.l $00000000 
Data.w $0000, $0000 
Data.b $C0, $00, $00, $00, $00, $00, $00, $46 
IID_IWbemRefresher: 
;49353c99-516b-11d1-aea6-00c04fb68820
Data.l $49353C99
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 
CLSID_WbemRefresher:
;c71566f2-561E-11D1-AD87-00C04FD8FDFF
Data.l $C71566F2
Data.w $561E, $11D1 
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF
IID_IWbemConfigureRefresher:
;49353c92-516b-11d1-aea6-00c04fb68820
Data.l $49353C92
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 
IID_IWbemObjectAccess:
;49353c9a-516b-11d1-aea6-00c04fb68820
Data.l $49353C9A
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20

EndDataSection

Wowww! Quel bordel windows quand même!

Merci pour le code, ça peut toujours servir!

En effet, le code ne renvoit plus rien au bout d'un temps :
2 : nom=_Total id=0 CPU usage=98% Memory=253192Ko (253192 Ko)
3 : nom=_Total id=0 CPU usage=98% Memory=253236Ko (44 Ko)
...
100 : nom=_Total id=0 CPU usage=95% Memory=252792Ko (4 Ko)
101 : nom=_Total id=0 CPU usage=0% Memory=252792Ko (0 Ko)

Avec le code suivant (modif d'affichage principalement)

Code : Tout sélectionner

#COINIT_MULTITHREAD=0 
#RPC_C_AUTHN_LEVEL_CONNECT=2 
#RPC_C_IMP_LEVEL_IDENTIFY=2 
#EOAC_NONE=0 
#RPC_C_AUTHN_WINNT=10 
#RPC_C_AUTHZ_NONE=0 
#RPC_C_AUTHN_LEVEL_CALL=3 
#RPC_C_IMP_LEVEL_IMPERSONATE=3 
#CLSCTX_INPROC_SERVER=1 
#WBEM_S_NO_ERROR = 0 

Structure d 
  l.l 
  h.l 
EndStructure 


Procedure.l ansi2bstr(ansi.s) 
  size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0) 
  Dim unicode.w(size) 
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size) 
  ProcedureReturn SysAllocString_(@unicode()) 
EndProcedure 

Procedure.s unicode2ansi(mem) 
  ansi.s="" 
  Repeat 
    a=PeekW(mem) 
    ansi=ansi+Chr(a) 
    mem+2 
  Until a=0 
  ProcedureReturn ansi 
EndProcedure 



; ___________________ Initialisations __________________________ 

; partout, hres doit être nul si pas d'erreur 

CoInitializeEx_(0,#COINIT_MULTITHREAD) 
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0) 
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator) 
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices) 
hres=svc\queryinterface(?IID_IUnknown,@pUnk.IUnknown) 
hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
pUnk\release() 
hres=CoCreateInstance_(?CLSID_WbemRefresher,0,#CLSCTX_INPROC_SERVER,?IID_IWbemRefresher,@pRefresher.IWbemRefresher) 
hres=pRefresher\queryinterface(?IID_IWbemConfigureRefresher,@pConfig.IWbemConfigureRefresher) 
hres=pConfig\AddEnum(svc,ansi2bstr("Win32_PerfFormattedData_PerfProc_Process"),0,0,@penum.IWbemHiPerfEnum,@id) 
pConfig\release() 
Dim tab.IWbemObjectAccess(100) 
For x=1 To 500
  pRefresher\refresh(0) 
  hres=penum\GetObjects(0,100*SizeOf(IWbemObjectAccess),@tab(),@retour.l) 
  If x=1 
    hres=tab(0)\GetPropertyHandle(ansi2bstr("IdProcess"),0,@hIDProcess) 
    hres=tab(0)\GetPropertyHandle(ansi2bstr("PercentProcessorTime"),0,@hpercent) 
    hres=tab(0)\GetPropertyHandle(ansi2bstr("WorkingSet"),0,@hsize) 
    hres=tab(0)\GetPropertyHandle(ansi2bstr("Name"),0,@hname)
    old_size = 0
  EndIf 
  If x>1 
    For i=0 To retour-1 
      tab(i)\ReadDWORD(hIDProcess,@IDProcess) 
      tab(i)\ReadDWORD(hpercent,@percent) 
      tab(i)\ReadDWORD(hsize,@size) 
      name.s=Space(255) 
      tab(i)\Readpropertyvalue(hname,255,@len,@name) 
      If unicode2ansi(@name) = "_Total"
        Difference = size - old_size
        Debug Str(x)+"  : nom="+unicode2ansi(@name)+" id="+Str(IDProcess)+"   CPU usage="+Str(percent)+"%  Memory="+Str(size>>10)+"Ko"+" ("+Str(Difference>>10)+" Ko)"
        
        old_size = size
      EndIf
      tab(i)\release() 
    Next i 
  EndIf 
  Delay(1000) 
  ; Debug "=========================="
Next 
penum\release() 
pRefresher\release(); 
svc\release() 
loc\release() 
CoUninitialize_() 
End 

;_______________ données_________________________ 

DataSection 
CLSID_WbemLocator: 
    ;4590f811-1d3a-11d0-891f-00aa004b2e24 
Data.l $4590F811 
Data.w $1D3A, $11D0 
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24 
IID_IWbemLocator: 
    ;dc12a687-737f-11cf-884d-00aa004b2e24 
Data.l $DC12A687 
Data.w $737F, $11CF 
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
IID_IUnknown: 
    ;00000000-0000-0000-C000-000000000046 
Data.l $00000000 
Data.w $0000, $0000 
Data.b $C0, $00, $00, $00, $00, $00, $00, $46 
IID_IWbemRefresher: 
;49353c99-516b-11d1-aea6-00c04fb68820 
Data.l $49353C99 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 
CLSID_WbemRefresher: 
;c71566f2-561E-11D1-AD87-00C04FD8FDFF 
Data.l $C71566F2 
Data.w $561E, $11D1 
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF 
IID_IWbemConfigureRefresher: 
;49353c92-516b-11d1-aea6-00c04fb68820 
Data.l $49353C92 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 
IID_IWbemObjectAccess: 
;49353c9a-516b-11d1-aea6-00c04fb68820 
Data.l $49353C9A 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 

EndDataSection

Je continue à chercher pourquoi mais il semble qu'avec un delai de 2000, le comptage montre l'erreur au environ de 45... serait-ce un pb de temps ?????

PureBasic

surveillance des processus & suivi registre

surveillance des processus & suivi registre