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;