Newsgroup: it.comp.lang.delphi
Titolo: Non mi ricordo più come si fa!

Salve a tutti,
una volta avevo una serie di righe di codice che mi mi permettevano,
dall'interno di un mio prg, di conoscere quali applicazioni erano attive in
in quel momento.
Posseggo già il sistema per farlo in Win9x ma non più per WinXP
Qualcuno ha qualche suggerimento?

 Posseggo già il sistema per farlo in Win9x ma non più per WinXP
Il sistema che funziona su Windows 9x (ToolHelp) funziona anche su Windows
XP.
L' unico a differenziarsi è Windows NT che utilizza le PSAPI.
Qui di seguito ti faccio un copy/paste di una unit che avevo scritto io per
lavorare con i processi. Riadattala secondo le tue necessità.
unit ProcManager;
interface
uses psapi, tlhelp32, SysUtils, Windows, Dialogs;
type TProcInfo = Record
     ProcessName: String;
     Path: String;
     Priority: String;
     ProcessID: dWord;
     ThreadCount: ShortInt;
end;
type TModInfo = Record
     ModuleName : String;
     ModInstance: HModule;
     ModuleSize : Cardinal;
end;
Type TprocInfoArr = Array of TProcInfo;
Type TModInfoArr = Array of TModInfo;
{ Dichiarazione funzione per ottenere la priorità }
function GetPriorityClass(hProcess: THandle): dWord; stdcall;
         external 'kernel32.DLL';
function SetPriorityClass(hProcess: THandle; dwPriorityClass: DWORD):
Boolean; stdcall;
         external 'kernel32.DLL';
{ La funzione ProcessList riempie un Array di Record dinamico con le
informazioni
  relative ai processi attivi sulla macchina - L'array restituito è
Zero-Based
  e l'ultimo processo è alla posizione High(ProcInfoArray) }
function ProcessList(var ProcInfoArray: TprocInfoArr): boolean;
{ La funzione ModuleList riempie un Array di Record dinamico con le
informazioni
  relative ai moduli di un processo di cui si conosce l'ID(entifier) -
  L'array restituito è Zero-Based e l'ultimo processo è alla posizione
High(ModuleInfoArray) }
function ModuleList(var ModuleInfoArray: TModInfoArr; ProcessID: dWord):
boolean;
{ La seguente funzione imposta la priorità di un processo }
function SetProcessPriority(PID, Priority: dWord): Boolean;
implementation
{ Costanti priorità del processo - Utilizzate Internamente }
const NORMAL_PRIORITY_CLASS       = $00000020;
      IDLE_PRIORITY_CLASS         = $00000040;
      HIGH_PRIORITY_CLASS         = $00000080;
      REALTIME_PRIORITY_CLASS     = $00000100;
      BELOW_NORMAL_PRIORITY_CLASS = $00004000;
      ABOVE_NORMAL_PRIORITY_CLASS = $00008000;
{ La funzioni ExtractXXXData vengono utilizzate internamente alla Unit
(privati)
  e servono a riempire i Record tipo TXXXInfo partendo da TXXXEntry32
  (ToolHelp Record) -   Vengono utilizzate solo nella sezione Win9x/ME }
Function ExtractProcessData(RecToExtract: TProcessEntry32):TProcInfo;
begin
  With Result do begin
    ProcessName := ExtractFileName(RecToExtract.szExeFile);
    Path        := ExtractFilePath(RecToExtract.szExeFile);
    ProcessID   := RecToExtract.th32ProcessID;
    ThreadCount := RecToExtract.cntThreads;
  end;
end;
Function ExtractModuleData(RecToExtract: TModuleEntry32):TModInfo;
begin
  With Result do begin
    ModuleName  := RecToExtract.szModule;
    ModInstance := RecToExtract.hModule;
    ModuleSize  := RecToExtract.modBaseSize;
  end;
end;
{ Imposta nel Record TProcInfo il campo Priority }
Function Process_GetPriority(var ProcessInfo: TProcInfo; ProcessID: dWord):
boolean;
var hProcess: THandle;
    Priority: dWord;
begin
  result := false;
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION,false,ProcessID);
  if hProcess <> 0 then begin
     Priority := GetPriorityClass(hProcess);
     Case Priority of
       NORMAL_PRIORITY_CLASS :
         ProcessInfo.Priority := 'Normal_Priority';
       IDLE_PRIORITY_CLASS   :
         ProcessInfo.Priority := 'Idle_Priority';
       HIGH_PRIORITY_CLASS   :
         ProcessInfo.Priority := 'High_Priority';
       REALTIME_PRIORITY_CLASS :
         ProcessInfo.Priority := 'Realtime_Priority';
       BELOW_NORMAL_PRIORITY_CLASS :
         ProcessInfo.Priority := 'Below_Normal_Priority';
       ABOVE_NORMAL_PRIORITY_CLASS :
         ProcessInfo.Priority := 'Above_Normal_Priority';
     end;
     Result := True;
     CloseHandle(hProcess);
  end;
end;
{ Lista di processi }
function ProcessList(var ProcInfoArray: TprocInfoArr): boolean;
{ Variabili di Win9x/ME }
var hSnapShot: THandle;
    isNotLast: Boolean;
    ProcEntry: TProcessEntry32;
{ Variabili di WinNT/2K }
    cbNeeded, cbReturned: DWORD;
    PID: Array [1..1024] of dWord;
    hProcess, hModule: THandle;
    pName: pChar;
{ Variabili comuni - Contatori }
    Indice, Count: Integer;
begin
Result := false;
Indice := 1;
  case Win32Platform of
       Integer(VER_PLATFORM_WIN32_WINDOWS):
       begin
       { Codice di Windows 9x/ME }
          hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
          If (hSnapShot<>-1) then
          begin
             Result := True;
             SetLength(ProcInfoArray,Indice);
             IsNotLast:=Process32First(hSnapShot,ProcEntry);
             While IsNotlast do
             begin
                procInfoArray[Indice-1] := ExtractProcessData(ProcEntry);
                if not
Process_GetPriority(procInfoArray[Indice-1],ProcEntry.th32ProcessID) then
                   procInfoArray[Indice-1].Priority := 'Unknown_Priority';
                IsNotLast:=Process32Next(hSnapShot,ProcEntry);
                Inc(Indice);
                SetLength(ProcInfoArray,Indice);
             end;
             SetLength(ProcInfoArray,Indice-1);
             CloseHandle(hSnapShot);
          end;
       end;
       Integer(VER_PLATFORM_WIN32_NT):
       begin
       { Codice di Windows NT/2K }
         if EnumProcesses(@PID,SizeOf(PID),cbNeeded) then begin
            pName := AllocMem(MAX_PATH);
            Count := 0;
            for Indice := 1 to (cbNeeded div SizeOf(dWord)) do begin
                hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
                                   false,PID[Indice]);
                if hProcess <> 0 then
                begin
                  EnumProcessModules( hProcess, @hModule, sizeof(hModule),
cbReturned );
                  if GetModuleBaseName(hProcess,hModule,pName,MAX_PATH) <> 0
then begin
                        Inc(Count);
                        SetLength(ProcInfoArray,Count);
                        procInfoArray[Count-1].ProcessID := PID[Indice];
                        if not
Process_GetPriority(procInfoArray[Count-1],PID[Indice]) then
                           procInfoArray[Count-1].Priority :=
'Unknown_Priority';
                        procInfoArray[Count-1].ProcessName := String(pName);
GetModuleFileNameEx(hProcess,hModule,pName,MAX_PATH);
                        procInfoArray[Count-1].Path :=
ExtractFilePath(pName);
                     end;
                  CloseHandle(hProcess);
                end;
            end;
            Result := True;
            FreeMem(pName);
         end;
       end;
  end; {Case}
end;
{ Lista di moduli per Win9x - Privata}
function W9x_ModuleList(var ModuleInfoArray: TModInfoArr; ProcessID: dWord):
boolean;
var hSnapShot: THandle;
    isNotLast: Boolean;
    ModuleEntry: TModuleEntry32;
    Indice: Integer;
begin
  Result := false;
  hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcessID);
  If (hSnapShot<>-1) then
  begin
    Indice := 1;
    Result := True;
    SetLength(ModuleInfoArray,Indice);
    IsNotLast:=Module32First(hSnapShot,ModuleEntry);
    While IsNotlast do
    begin
      ModuleInfoArray[Indice-1] := ExtractModuleData(ModuleEntry);
      IsNotLast:=Module32Next(hSnapShot,ModuleEntry);
      Inc(Indice);
      SetLength(ModuleInfoArray,Indice);
    end;
    SetLength(ModuleInfoArray,Indice-1);
  end;
  CloseHandle(hSnapShot);
end;
{ Lista di moduli per WinNT - Privata }
function WNT_ModuleList(var ModuleInfoArray: TModInfoArr; ProcessID: dWord):
boolean;
var hProcess: THandle;
    hModule: Array [1..1024] of THandle;
    cbReturned: dWord;
    mName: pChar;
    mInfo: TModuleInfo;
    Indice, Count: Integer;
begin
 Result := False;
 hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
                         false,ProcessID);
 if (hProcess <> 0) then begin
    Result := True;
    EnumProcessModules( hProcess, @hModule, sizeof(hModule), cbReturned );
    mName := AllocMem(MAX_PATH);
    Count := cbReturned div SizeOf(THandle);
    for Indice := 1 to Count do begin
        GetModuleBaseName(hProcess,hModule[Indice],mName,MAX_PATH);
        GetModuleInformation(hProcess,hModule[Indice],@mINFO,SizeOf(mInfo));
        SetLength(ModuleInfoArray,Indice);
        ModuleInfoArray[Indice-1].ModInstance := hModule[Indice];
        ModuleInfoArray[Indice-1].ModuleSize  := mInfo.SizeOfImage;
        ModuleInfoArray[Indice-1].ModuleName  := mName;
    end;
    FreeMem(mName);
 end;
 CloseHandle(hProcess);
end;
{ Funzione pubblica per la lista dei moduli }
function ModuleList(var ModuleInfoArray: TModInfoArr; ProcessID: dWord):
boolean;
Begin
  result := false;
  if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
     Result := W9x_ModuleList(ModuleInfoArray,ProcessID) else
  if Win32Platform = VER_PLATFORM_WIN32_NT then
     Result := WNT_ModuleList(ModuleInfoArray,ProcessID);
end;
{ Funzione pubblica per l'impostazione della priorità }
function SetProcessPriority(PID, Priority: dWord): Boolean;
var hProcess: THandle;
begin
  result := false;
  hProcess := OpenProcess(PROCESS_SET_INFORMATION,true,PID);
  if (hProcess <> 0) then begin
      if SetPriorityClass(hProcess,Priority) then
         result := true;
      CloseHandle(hProcess)
  end;
end;
(* funzioni di task managment da controllare
function WNT_ExitRemoteProcess(processID: DWord; msecs: DWord): boolean;
var
   hprocess, hthread: THandle;
   dwThreadID: DWord;
begin
   Result := True;
   hProcess := OpenProcess( PROCESS_ALL_ACCESS, False, processID);
   Win32Check( hProcess <> 0);
   hThread := CreateRemoteThread( hProcess,
                                  nil,
                                  0,
                                  GetProcAddress(
GetModuleHandle('Kernel32.dll'),
                                                  'ExitProcess'),
                                  nil,
                                  0,
                                  dwThreadID);
   CloseHandle( hProcess);
   Win32Check( hThread <> 0);
   try
     if WaitForSingleObject( hThread, msecs) = WAIT_TIMEOUT then
        Result := false;
   finally
     CloseHandle(hThread);
   end;
end;
Procedure Force_ExitRemoteProcess(processID: DWord);
var hProcess: THandle;
begin
  hProcess := OpenProcess(PROCESS_TERMINATE,False,ProcessID);
  TerminateProcess(hProcess,0);
  CloseHandle(hProcess);
end;
*)
end.
--
- Carlo -

 ha scritto nel messaggio
news:c6vhe3$5r6$1...@lacerta.tiscalinet.it...
