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.