unit Unit1;
//////los errores de programacion
///////o vicios ,sean tomados como programador amateur
{ ajustar en autosize el ancho de columnas agregando
-1 en with de tcolumnlist}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Menus,tlhelp32,unit2,unit3;
type
TForm1 = class(TForm)
ListView1: TListView;
PopupMenu1: TPopupMenu;
actualizart1: TMenuItem;
dumpear1: TMenuItem;
ListBox1: TListBox;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Label3: TLabel;
Button1: TButton;
SaveDialog1: TSaveDialog;
Label4: TLabel;
Label5: TLabel;
procedure FormCreate(Sender: TObject);
procedure actualizart1Click(Sender: TObject);
procedure dumpear1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Label5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Ajustamos los privilegios
function EnablePrivilege(PrivilegeName: PChar; Enable: Boolean): Boolean;
var
hToken: THandle;
Tp: TOKEN_PRIVILEGES;
Luid: TLargeInteger;
begin
Result:= FALSE;
if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
TOKEN_QUERY or TOKEN_READ, hToken) then
if LookupPrivilegeValue(nil,PrivilegeName,Luid) then
begin
Tp.PrivilegeCount:= 1;
Tp.Privileges[0].Luid:= Luid;
if Enable then
Tp.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED
else
Tp.Privileges[0].Attributes:= 0;
Result:= AdjustTokenPrivileges(hToken,FALSE,Tp,0,nil,PDWORD(nil)^);
CloseHandle(hToken);
end;
end;
procedure list();
var
//i: Integer;
bContinue: BOOL;
list:TListItem;
aSnapshotHandle: THandle;
aProcessEntry32: TProcessEntry32;
begin
// Limpiar la lista
form1.ListView1.items.Clear;
// Recoge la lista de procesos en éste momento
aSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
aProcessEntry32.dwSize := SizeOf(aProcessEntry32);
// Acceder al primer proceso
bContinue := Process32First(aSnapshotHandle, aProcessEntry32);
// Recorerr los procesos activos
while (Integer(bContinue) <> 0) do begin
// Añadirlo a la lista
List:=form1.ListView1.Items.Add;
List.caption:=inttostr(aProcessEntry32.th32ProcessID);
List.SubItems.Add(ExtractFileName(aProcessEntry32.szExeFile));
// Hay más?
bContinue := Process32Next(aSnapshotHandle, aProcessEntry32);
end;
// cerrar la estructura
CloseHandle(aSnapshotHandle);
form1.label2.caption:='CANTIDAD DE PROCESOS LISTADOS: '+inttostr(form1.listview1.items.count);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EnablePrivilege('SeDebugPrivilege', TRUE);
list;
end;
procedure TForm1.actualizart1Click(Sender: TObject);
begin
list;
end;
procedure TForm1.dumpear1Click(Sender: TObject);
begin
listbox1.Clear;
if GetDumpFromProcess(strtoint(form1.listview1.selected.caption))then
if FindStrings('dump.exe',2,'')then
//label3.caption :='todo listo'
else
// label3.caption :='hubo un error'
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if savedialog1.Execute then
ListBox1.Items.SaveToFile(savedialog1.filename+'.txt')
else
exit;
end;
procedure TForm1.Edit1Change(Sender: TObject);
const
indexStart = -1;
var
search : array[0..128] of Char;
//str:string;
// I : integer;
begin
if (listbox1.Items = nil) then begin
showmessage('no hay items en listbox ');
end
else begin
//make sure Length(Edit1.Text) <= 128
StrPCopy(search, Edit1.Text) ;
ListBox1.ItemIndex := ListBox1.Perform(LB_SELECTSTRING, indexStart, LongInt(@search)) ;
end;
end;
procedure TForm1.Label5Click(Sender: TObject);
begin
showmessage('dumper extraido de foro ruso¿?'+#13#10+ 'asciidump from ic0de steve10120'+#13#10+'list process idea from neftali');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
EnablePrivilege('SeDebugPrivilege', FALSE);
end;
end.
unit Unit2;
// from foro ruso ??????????
interface
uses
Windows, SysUtils,classes;
function MoveProcessMemoryToFile(aPID: DWORD; aSaveFileTo,aFailMesage: string): Boolean;
function GetDumpFromProcess(procid: dword): Boolean;
implementation
function MoveProcessMemoryToFile(aPID: DWORD; aSaveFileTo,aFailMesage: string): Boolean;
const
GB4 = 4294967296; //?????? 4 ?? ? ??????
var
hProcess: Cardinal;
MBI: TMemoryBasicInformation;
FS: TFileStream;
Buff: PByte;
BaseAddr,
RecivedBytes: Cardinal;
begin
Result := False;
BaseAddr := 0;
RecivedBytes := 0;
//????????? ???????
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_READ, False, aPID);
try
if hProcess <> 0 then
begin
//???? ???????, ??????? ????
fs := TFileStream.Create(aSaveFileTo, fmCreate or fmOpenWrite);
try
//??????????? ?????? ?? ?????????? ?????? BaseAddr
while VirtualQueryEx(hProcess, Pointer(BaseAddr), MBI, SizeOf(MBI)) <> 0 do
begin
//???? ???????? ?????? ???????? ? ?? ????????????? ??? ???
if ((MBI.State = MEM_COMMIT) and (not (MBI.Protect = PAGE_GUARD) or (MBI.Protect = PAGE_NOACCESS))) then
begin
try
//???????? ????? ?????? ?????? ??????? ??????? ?????? ?? ???? ???
Buff := AllocMem(MBI.RegionSize);
//?????? ?????? ????? ???????
if ReadProcessMemory(hProcess, MBI.BaseAddress, Buff, MBI.RegionSize, RecivedBytes) then
begin
//????? ? ???? ??????????? ?????????? ?????? ???-?? ????????? ????
FS.Write(Buff^, RecivedBytes);
end
//???? ?? ??????
else if (GetLastError <> ERROR_PARTIAL_COPY) and
(GetLastError <> ERROR_ACCESS_DENIED) then
begin
//?????? ?????????
aFailMesage:=Format('Error #%d with RMessage: %s ', [GetLastError, SysErrorMessage(GetLastError)]);
Exit;
end;
finally
//??????????? ??????? ???? ??????
FreeMem(Buff);
end;
end;
//???????????(??????????????) ????????? ????? ?? ?????? ???????
BaseAddr := BaseAddr + MBI.RegionSize;
//????????? ??????????? ?? ?? ?????? 4 ??.
if BaseAddr = GB4 then
begin
Exit;
end;
end;
//???? ????????, ???????? ?? ? ????? ???? ???-?????? :d
if FS.Size > 0 then
begin
Result := True;
end;
finally
FreeAndNil(fs);
end;
end
else
begin
aFailMesage:=Format('Error #%d with RMessage: %s ', [GetLastError, SysErrorMessage(GetLastError)]);
Exit;
end;
finally
CloseHandle(hProcess);
end;
end;
//function GetDumpFromProcess(FileName: String): Boolean;
function GetDumpFromProcess(procid: dword): Boolean;
var
//addr, WinSwupWND, ProcID, Proc, NumOfBytes: DWORD;
addr, WinSwupWND, Proc, NumOfBytes: DWORD;
MBI: TMemoryBasicInformation;
f: File;
Buff: Pointer;
filename:string;
begin
Result := False;
//WinSwupWND := FindWindow(NIl, 'mi titulo de ventana');
// GetWindowThreadProcessId(WinSwupWND, ProcID);
Proc := OpenProcess(PROCESS_ALL_ACCESS, False, ProcID);
if (Proc <> 0) then
begin
{$I-}
// AssignFile(f, 'text.txt');
AssignFile(f, 'dump.exe');
ReWrite(f, 1);
addr := 0;
while (addr < high(addr)) do
begin
if VirtualQueryEx(Proc, Pointer(addr), MBI, SIZEOF(MBI)) <> SIZEOF(MBI) then break;
if (MBI.State = MEM_COMMIT) and (MBI.Type_9 = MEM_PRIVATE) then
begin
GetMem(Buff, MBI.RegionSize);
ReadProcessMemory(Proc, MBI.BaseAddress, Buff, MBI.RegionSize, NumOfBytes);
BlockWrite(f, Buff^, NumOfBytes);
FreeMem(Buff);
end;
addr := DWORD(MBI.BaseAddress) + MBI.RegionSize;
end;
CloseFile(f);
{$I+}
CloseHandle(Proc);
Result := True;
end;
end;
end.
unit Unit3;
//codigo sacado de: ic0de steve 10120
interface
uses
windows,sysutils;
function FindStrings(szFilePath:string; dwMinLength:DWORD; szDumpPath:string):Boolean;
implementation
uses
unit1;
function FileToPtr(szFilePath: string; var pFile: Pointer;
var dwFileSize: DWORD): Boolean;
var
hFile: DWORD;
dwRead: DWORD;
begin
Result := FALSE;
hFile := CreateFile(PChar(szFilePath), GENERIC_READ, 0, nil,
OPEN_EXISTING, 0, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
dwFileSize := GetFileSize(hFile, nil);
if (dwFileSize > 0) then
begin
pFile := VirtualAlloc(nil, dwFileSize, MEM_COMMIT, PAGE_READWRITE);
if (Assigned(pFile)) then
begin
SetFilePointer(hFile, 0, nil, FILE_BEGIN);
ReadFile(hFile, pFile^, dwFileSize, dwRead, nil);
if (dwRead = dwFileSize) then
Result := TRUE;
end;
end;
CloseHandle(hFile);
end;
end;
function FindStrings(szFilePath:string; dwMinLength:DWORD; szDumpPath:string):Boolean;
var
pFile: Pointer;
dwFileSize: DWORD;
i: DWORD;
szDump: string;
dwLength: DWORD;
// hFile: TextFile;
begin
Result := FALSE;
if (FileToPtr(szFilePath, pFile, dwFileSize)) then
begin
dwLength := 0;
// AssignFile(hFile, szDumpPath); // yeah I don't like it but its easiest for writing lines..
//Rewrite(hFile);
for i := 0 to (dwFileSize - 1) do
begin
if ((Char(PByte(DWORD(pFile) + i)^) in ['A'..'Z']) or (Char(PByte(DWORD(pFile) + i)^) in ['a'..'z']) or (Char(PByte(DWORD(pFile) + i)^) in ['0'..'9']) or (Char(PByte(DWORD(pFile) + i)^) = ' ')) then
begin
szDump := szDump + Char(PByte(DWORD(pFile) + i)^);
Inc(dwLength);
end
else
begin
if (dwLength >= dwMinLength) then
form1.listbox1.items.add(szDump);
// WriteLn(hFile, szDump);
dwLength := 0;
szDump := '';
end;
end;
Result := TRUE;
// CloseFile(hFile);
VirtualFree(pFile, 0, MEM_RELEASE);
end;
end;
end.