Analitcs

Pesquisar no conteúdo do blog.atlabs.com.br

segunda-feira, 25 de junho de 2012

DELPHI - Listando Processos da Memória

Reações: 


// Dados da Unit1.Pas

// Unit1.pas - Inicio

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type

  TForm1 = class(TForm)
    Timer1: TTimer;
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    lp : Integer;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function EnumProcess(hHwnd: HWND; lParam : integer): boolean; stdcall;
var
  pPid : DWORD;
  title, ClassName, Extra : string;
begin
  //Se retornar nulo, cancela e sai
  if (hHwnd=NULL) then
  begin
    result := false;
  end
  else
  begin
    //Pega o Numero Identificado Do Processo(PID)
    GetWindowThreadProcessId(hHwnd,pPid);
    //ClassName do Processo
    SetLength(ClassName, 255);
    SetLength(ClassName,
              GetClassName(hHwnd,
                           PChar(className),
                           Length(className)));
    SetLength(title, 255);
    //Titulo do Processo
    SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));
    //Exibe a informação em uma lista (Componente Visual)
    Form1.ListBox1.Items.Add
      ('Class Name = ' + className +
       '; Title = ' + title +
       '; HWND = ' + IntToStr(hHwnd) +
       '; Pid = ' + IntToStr(pPid));
    Result := true;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Timer1Timer(Self); 
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  ListBox1.Clear;
  if not EnumWindows(@EnumProcess,lp) then exit; // A cada 10 segundos exibe o q está em memória
end;

end.

//Unit1.pas Fim


// Unit1.dfm - Inicio (Form1)

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 1179
  Height = 585
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 0
    Width = 1171
    Height = 551
    Align = alClient
    ItemHeight = 13
    TabOrder = 0
  end
  object Timer1: TTimer
    Interval = 10000
    OnTimer = Timer1Timer
    Left = 69
    Top = 33
  end
end
// Unit1.dfm - Fim (Form1)

Nenhum comentário:

Postar um comentário

Observação: somente um membro deste blog pode postar um comentário.

Max Gehringer