Nicholas Sherlock napisal(a):
> losthook wrote:
> > Is there way to find a string in memory something like ( memory scan)
> > if some exe have inside strings like (:terminal) i found it and it
tell
> > me what a file have that string??? is there any way of doing that?
>
> Do you mean, scan every program in memory to find the one that you want?
> That would be very expensive. Are you just trying to locate a given
> running program? If so, say that, and we can offer better solutions.
>
> Cheers,
> Nicholas Sherlock
>
> --
> http://www.sherlocksoftware.org
I have do that:
i do ProcList take it to the ListBox
and then take listbox item to the memo (with change it to hexedit wiev)
and there i look for string but i can't do one files by anather only
one from lisbox ;(
and the search for string is so slow and taking to many CPU ;(
please help:/
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Cl*****, 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 := @[EMAIL PROTECTED]
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;
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(@[EMAIL PROTECTED]
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, @[EMAIL PROTECTED]
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;
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
MyProcList: TstringList;
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]);
finally
MyProcList.Free;
end;
end;
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[4] );
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:='CHEAT 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:='*';
end
else
find := False;
finally
ms.Free
end;
end;
end;
end.
|
