szybkie szukanie w Memo

0

Witam

jestem dość nowy w delphi ale
pisze program który sprawdza procesy w pamieci - kazdy proces przezucam do memo jako i szukam w nim odpowiedniego stringu ... mozecie mi pomóc ponieważ jak szukam stringu to zajmuje mi caly czas procesora :( i zwalnia komputer jest jakis spsób zeby szukał w tle zeby nie uzywal dużo cpu...

i jeszcze jedno jak zrobic zeby po otryzmaniu calej listy procesów do ListBox'a po kolei kazdy znich wyedytowac w memo i szukac stronga w kazdym ? a nie tylko wybrany?

zamieszczam swój kod poniże ... pomocy bo już slepne:/ a nic nie wychodzi....

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Psapi, tlhelp32, ExtCtrls,ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    ListBox1: TListBox;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Display(const S: string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TDisplayProc = procedure(const s: string) of object;
  procedure ShowBinary(var Data; Count: Cardinal; DispProc: TDisplayProc);
var
  Form1: TForm1;
  x: Integer;
  find: Boolean = False;

implementation

{$R *.dfm}



procedure ShowBinary(var Data; Count: Cardinal; DispProc: TDisplayProc);
var
  line: string[80];
  i: Cardinal;
  p: PChar;
  nStr: string[4];
const
  posStart = 1;
  binStart = 7;
  ascStart = 57;
  HexChars: PChar = '0123456789ABCDEF';
begin
  p    := @Data;
  line := '';
  for i := 0 to Count - 1 do
  begin
    if (i mod 16) = 0 then
    begin
      if Length(line) > 0 then
        DispProc(line);
      FillChar(line, SizeOf(line), ' ');
      line[0] := Chr(72);
      nStr    := Format('%4.4X', [i]);
      Move(nStr[1], line[posStart], Length(nStr));
      line[posStart + 4] := ':';
    end;
    if p[i] >= ' ' then
      line[i mod 16 + ascStart] := p[i]
    else
      line[i mod 16 + ascStart] := '.';
    line[binStart + 3 * (i mod 16)]     := HexChars[(Ord(p[i]) shr 4) and $F];
    line[binStart + 3 * (i mod 16) + 1] := HexChars[Ord(p[i]) and $F];
  end;
  DispProc(line);
end;

procedure TForm1.Display(const S: string);

begin
  Memo1.Lines.Add(S);

end;

//---------------------------------------------------szuka procesów-------
procedure CreateWin9xProcessList(List: TstringList);
var
  hSnapShot: THandle;
  ProcInfo: TProcessEntry32;
begin
  if List = nil then Exit;
  hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapShot <> THandle(-1)) then
  begin
    ProcInfo.dwSize := SizeOf(ProcInfo);
    if (Process32First(hSnapshot, ProcInfo)) then
    begin
      List.Add(ProcInfo.szExeFile);
      while (Process32Next(hSnapShot, ProcInfo)) do
        List.Add(ProcInfo.szExeFile);
    end;
    CloseHandle(hSnapShot);
  end;
end;

procedure CreateWinNTProcessList(List: TstringList);
var
  PIDArray: array [0..1023] of DWORD;
  cb: DWORD;
  I: Integer;
  ProcCount: Integer;
  hMod: HMODULE;
  hProcess: THandle;
  ModuleName: array [0..300] of Char;
begin
  if List = nil then Exit;
  EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
  ProcCount := cb div SizeOf(DWORD);
  for I := 0 to ProcCount - 1 do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
      PROCESS_VM_READ,
      False,
      PIDArray[I]);
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
      GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
      List.Add(ModuleName);
      CloseHandle(hProcess);
    end;
  end;
end;

procedure GetProcessList(var List: TstringList);
var
  ovi: TOSVersionInfo;
begin
  if List = nil then Exit;
  ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(ovi);
  case ovi.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);
    VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List);
  end
end;

function EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
var
  i: Integer;
  MyProcList: TstringList;
begin
  MyProcList := TStringList.Create;
  try
    GetProcessList(MyProcList);
    Result := False;
    if MyProcList = nil then Exit;
    for i := 0 to MyProcList.Count - 1 do
    begin

      if not bFullpath then
      begin

        if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then
          Result := True
      end
      else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True;
      if Result then Break;
    end;
  finally
    MyProcList.Free;
  end;
end;

//-----------------------------------------------wyswietlanie plików--------


procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  MyProcList: TstringList;
  a1:string;
begin
  MyProcList := TStringList.Create;
  try
    GetProcessList(MyProcList);
    if MyProcList = nil then Exit;
    for i := 0 to MyProcList.Count - 1 do
      ListBox1.Items.Add(MyProcList.Strings[i]);
       a1:=IntToStr(MyProcList.Count - 1);
    Label2.Caption:=a1;
  finally
    MyProcList.Free;

  end;
  end;

//-----------------------------------------------------otwiera plik----------//
procedure TForm1.Button1Click(Sender: TObject);
var
  ms: TMemoryStream;
  i: Integer;
  MyProcList: TstringList;
  a,b,c:string;

begin

  if (MyProcList<>nil)  then
  begin

    ms := TMemoryStream.Create;
    try

      ms.LoadFromfile(listbox1.Items.strings[24] );
      ShowBinary(ms.Memory^, ms.Size, Display);
      Memo1.Lines.Text := ' ' + Memo1.Lines.Text;
  for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
  begin
    a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));

      if a = edit1.Text then
      begin
        find := True;
        Label1.Caption:='String FOUND';
        Edit2.Text := listbox1.Items.strings[i];
        x    := 2;
        Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        Memo1.SetFocus;
        Memo1.SelStart  := i - 2;
        Memo1.SelLength := Length(edit1.Text);
        Memo1.Clear;
        break;

      end

    else
    begin
      if lowercase(a) = lowercase(edit1.Text) then
      begin
        Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        find := True;

        x    := 2;
        Memo1.SetFocus;
        Memo1.SelStart  := i - 2;
        Memo1.SelLength := Length(edit1.Text);
        //Memo1.Clear;
        break;

      end;
    end;
  end;
  if find = False then
begin
//Memo1.Clear;
Label1.Caption:='No string';
end

  else
  find := False;

    finally
      ms.Free


    end;
  end;
end;
0
if Pos(Edit1.Text, Memo1.Lines.Text) > 0 then
  znalezione
else
  nieznalezione

1 użytkowników online, w tym zalogowanych: 0, gości: 1