关键代码如下
unit PrcMemMgrTestForm;

{

author: Michael Winter, delphi.net@gmx.net
ver:    0.1, 2000-02-26
desc:
Simple test and demo program that should show how to use uProcessMemMgr.
Captures the content of a listview control, even from inside another process
(e. g. the Desktop window in Explorer).
For demonstration, the foreign listview content is written into a stream, after
that the stream is used to fill the MainForm's own listview.

notes:
Position the mouse over a listview window. You can see the window's class name
in the caption of the main form. To capture, press F12.
Please report any problems with this unit to the email address above.

}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  ExtCtrls, ComCtrls, StdCtrls;

type
  TMainForm = class(TForm)
    Timer1: TTimer;
    lvTestListView: TListView;
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    procedure Timer1Timer(Sender: TObject);
  private
    procedure GrabListView(W: HWND;
      const OnlySelectedItem: boolean = false);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses
  CommCtrl, uProcessMemMgr;

procedure ForeignListViewToStream(Wnd: HWND; Writer: TWriter;
  const OnlySelectedItem: boolean = false);
const
  MaxTextLen = 1024;
var
  MemMgr: TProcessMemMgr;
  Column: TLVColumn;
  Item: TLVItem;
  c, i: Integer;
  ColCount: Integer;
  Ok: Boolean;
  // these Pointers are Pointers into the possibly foreign process
  PrItemText: PChar;
  PrColumn: PLVColumn;
  PrItem: PLVItem;
begin
  MemMgr := CreateProcessMemMgrForWnd(Wnd);
  try
    PrItemText := MemMgr.AllocMem(MaxTextLen);
    PrColumn := MemMgr.AllocMem(SizeOf(TLVColumn));
    PrItem := MemMgr.AllocMem(SizeOf(TLVItem));

    // write Colunms
    c := 0;
    repeat
      Column.mask := LVCF_FMT or LVCF_WIDTH or LVCF_TEXT;
      Column.pszText := PrItemText;
      Column.cchTextMax := MaxTextLen;
      MemMgr.Write(Column, PrColumn, SizeOf(TLVColumn));
      Ok := ListView_GetColumn(Wnd, c, PrColumn^);
      if Ok then begin
        MemMgr.Read(PrColumn, Column, SizeOf(TLVColumn));
        Writer.WriteBoolean(true);
        Writer.WriteString(MemMgr.ReadStr(Column.pszText));
        case Column.fmt of
          LVCFMT_RIGHT: Writer.WriteInteger(ord(taRightJustify));
          LVCFMT_CENTER: Writer.WriteInteger(ord(taCenter))
          else Writer.WriteInteger(ord(taLeftJustify));
        end;
        Writer.WriteInteger(Column.cx);
        inc(c);
      end;
    until not Ok;
    ColCount := c;
    if ColCount = 0 then ColCount := 1;
    Writer.WriteBoolean(false);

    // write items
    if OnlySelectedItem then i := ListView_GetNextItem(Wnd, -1, LVNI_SELECTED) else
    i := ListView_GetNextItem(Wnd, -1, LVNI_ALL);
    while i >= 0 do begin
      Writer.WriteBoolean(true);
      for c := 0 to ColCount - 1 do begin
        Item.mask := LVIF_TEXT;
        Item.iItem := i;
        Item.iSubItem := c;
        Item.pszText := PrItemText;
        Item.cchTextMax := MaxTextLen;
        MemMgr.Write(Item, PrItem, SizeOf(TLVItem));
        ListView_GetItem(Wnd, PrItem^);
        MemMgr.Read(PrItem, Item, SizeOf(TLVItem));
        Writer.WriteString(MemMgr.ReadStr(Item.pszText));
      end;
      if OnlySelectedItem then i := ListView_GetNextItem(Wnd, i, LVNI_SELECTED) else
      i := ListView_GetNextItem(Wnd, i, LVNI_ALL);
    end;
    Writer.WriteBoolean(false);
  finally
    MemMgr.Free;
  end;
end;

procedure StreamToListView(LV: TListView; Reader: TReader);
var
  c: Integer;
begin
  LV.Items.BeginUpdate;
  try
    LV.Items.Clear;
    LV.Columns.Clear;

    // read columns
    while Reader.ReadBoolean do begin
      with LV.Columns.Add do begin
        Caption := Reader.ReadString;
        Alignment := TAlignment(Reader.ReadInteger);
        Width := Reader.ReadInteger;
      end;
    end;
    if LV.Columns.Count = 0 then
      LV.Columns.Add;

    // read items
    while Reader.ReadBoolean do begin
      with LV.Items.Add do begin
        Caption := Reader.ReadString;
        for c := 1 to LV.Columns.Count - 1 do begin
          SubItems.Add(Reader.ReadString);
        end;
      end;
    end;
  finally
    LV.Items.EndUpdate;
  end;
end;

function GetWndClassName(Wnd: HWND): String;
var
  S: Array[0..255] of Char;
begin
  GetClassName(Wnd, S, 255);
  Result := S;
end;

procedure TMainForm.GrabListView(W: HWND;
  const OnlySelectedItem: boolean = false);
var
  Stream: TStream;
  Writer: TWriter;
  Reader: TReader;
begin
  Stream := TMemoryStream.Create;
  try
    Writer := TWriter.Create(Stream, 1024);
    try
      ForeignListViewToStream(W, Writer, OnlySelectedItem);
    finally
      Writer.Free;
    end;
    Stream.Position := 0;
    Reader := TReader.Create(Stream, 1024);
    try
      StreamToListView(lvTestListView, Reader);
    finally
      Reader.Free;
    end;
  finally
    Stream.Free;
  end;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var
  W: HWND;
  CName: String;
begin
  W := WindowFromPoint(Mouse.CursorPos);
  CName := GetWndClassName(W);
  Caption := CName;
  if GetAsyncKeyState(VK_F12) and 1 <> 0 then begin
    if SameText(CName, 'SysListView32')
    or SameText(CName, 'TListView') or
    SameText(CName, 'SysTabControl32')
    then begin
      GrabListView(W, CheckBox1.Checked);
    end;
  end;
end;

end.

支持Unit：
unit uProcessMemMgr;

interface

uses
  Windows, Classes, ipcthrd;

const
  MemMgrMemSize = 16*1024;

type
  TProcessMemMgr = class(TObject)
  public
    function AllocMem(Bytes: Cardinal): Pointer; virtual; abstract;
    procedure FreeMem(P: Pointer); virtual; abstract;
    procedure Read(Source: Pointer; var Dest; Bytes: Cardinal); virtual; abstract;
    function ReadStr(Source: PChar): String; virtual; abstract;
    procedure Write(const Source; Dest: Pointer; Bytes: Cardinal); virtual; abstract;
    procedure WriteStr(const Str: String; Dest: Pointer); virtual; abstract;
  end;

function CreateProcessMemMgr(ProcessID: Cardinal): TProcessMemMgr;
function CreateProcessMemMgrForWnd(Wnd: HWND): TProcessMemMgr;

implementation

uses
  SysUtils, Contnrs;

type
  EProcessMemMgr = class(Exception);

  TOwnProcessMemMgr = class(TProcessMemMgr)
  private
    FMemList: TThreadList;
  public
    constructor Create;
    destructor Destroy; override;
    function AllocMem(Bytes: Cardinal): Pointer; override;
    procedure FreeMem(P: Pointer); override;
    procedure Read(Source: Pointer; var Dest; Bytes: Cardinal); override;
    function ReadStr(Source: PChar): String; override;
    procedure Write(const Source; Dest: Pointer; Bytes: Cardinal); override;
    procedure WriteStr(const Str: String; Dest: Pointer); override;
  end;

  TForeignProcessMemMgr = class(TProcessMemMgr)
  private
    FProcess: THandle;
    FMemList: TThreadList;
  protected
    procedure NeedMoreMem(Bytes: Cardinal); virtual; abstract;
  public
    constructor Create(ProcessID: Cardinal);
    destructor Destroy; override;
    function AllocMem(Bytes: Cardinal): Pointer; override;
    procedure FreeMem(P: Pointer); override;
    procedure Read(Source: Pointer; var Dest; Bytes: Cardinal); override;
    function ReadStr(Source: PChar): String; override;
    procedure Write(const Source; Dest: Pointer; Bytes: Cardinal); override;
    procedure WriteStr(const Str: String; Dest: Pointer); override;
  end;

  TWin9xProcessMemMgr = class(TForeignProcessMemMgr)
  private
    FSharedList: TObjectList;
  protected
    procedure NeedMoreMem(Bytes: Cardinal); override;
  public
    constructor Create(ProcessID: Cardinal);
    destructor Destroy; override;
  end;

  TWinNTProcessMemMgr = class(TForeignProcessMemMgr)
  private
    FAllocList: TList;
  protected
    procedure NeedMoreMem(Bytes: Cardinal); override;
  public
    constructor Create(ProcessID: Cardinal);
    destructor Destroy; override;
  end;

  PMemRec = ^TMemRec;
  TMemRec = record
    Start: Pointer;
    Size: Cardinal;
    Group: Integer;
    Used: Boolean;
  end;

{ TOwnProcessMemMgr }

function TOwnProcessMemMgr.AllocMem(Bytes: Cardinal): Pointer;
begin
  Result := SysUtils.AllocMem(Bytes);
  FMemList.Add(Result);
end;

constructor TOwnProcessMemMgr.Create;
begin
  inherited;
  FMemList := TThreadList.Create;
end;

destructor TOwnProcessMemMgr.Destroy;
var
  i: Integer;
begin
  with FMemList.LockList do try
    for i := 0 to Count - 1 do
      System.FreeMem(Items[i]);
  finally
    FMemList.UnlockList;
  end;
  FMemList.Free;
  inherited;
end;

procedure TOwnProcessMemMgr.FreeMem(P: Pointer);
begin
  FMemList.Remove(P);
  System.FreeMem(P);
end;

procedure TOwnProcessMemMgr.Read(Source: Pointer; var Dest; Bytes: Cardinal);
begin
  System.Move(Source^, Dest, Bytes);
end;

function TOwnProcessMemMgr.ReadStr(Source: PChar): String;
begin
  Result := Source;
end;

procedure TOwnProcessMemMgr.Write(const Source; Dest: Pointer; Bytes: Cardinal);
begin
  System.Move(Source, Dest^, Bytes);
end;

procedure TOwnProcessMemMgr.WriteStr(const Str: String; Dest: Pointer);
begin
  StrPCopy(Dest, Str);
end;

{ TForeignProcessMemMgr }

function TForeignProcessMemMgr.AllocMem(Bytes: Cardinal): Pointer;
var
  t: Integer;
  i: Integer;
  Rec, NewRec: PMemRec;
  Remain: Cardinal;
begin
  Result := nil;
  with FMemList.LockList do try
    for t := 0 to 1 do begin
      for i := 0 to Count - 1 do begin
        Rec := Items[i];
        if not Rec^.Used and (Rec^.Size >= Bytes) then begin
          Remain := Rec^.Size - Bytes;
          Rec^.Size := Bytes;
          Rec^.Used := true;
          Result := Rec^.Start;
          if Remain > 0 then begin
            New(NewRec);
            NewRec^.Start := Pointer(Cardinal(Result) + Cardinal(Bytes));
            NewRec^.Size := Remain;
            NewRec^.Group := Rec^.Group;
            NewRec^.Used := false;
            Insert(i + 1, NewRec);
          end;
          exit;
        end;
      end;
      NeedMoreMem(Bytes);
    end;
    raise EProcessMemMgr.Create('ProcessMemMgr.AllocMem: not enough memory');
  finally
    FMemList.UnlockList;
  end;
end;

constructor TForeignProcessMemMgr.Create(ProcessID: Cardinal);
begin
  inherited Create;
  FProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, false, ProcessID);
  if FProcess = 0 then RaiseLastWin32Error;
  FMemList := TThreadList.Create;
end;

destructor TForeignProcessMemMgr.Destroy;
begin
  FMemList.Free;
  CloseHandle(FProcess);
  inherited;
end;

procedure TForeignProcessMemMgr.FreeMem(P: Pointer);
var
  i, j: Integer;
  Rec, NextRec: PMemRec;
begin
  with FMemList.LockList do try
    for i := 0 to Count - 1 do begin
      Rec := Items[i];
      if Rec^.Start = P then begin
        Rec^.Used := false;
        j := i + 1;
        while j < Count do begin
          NextRec := Items[j];
          if NextRec^.Used then exit;
          if NextRec^.Group <> Rec^.Group then exit;
          inc(Rec^.Size, NextRec^.Size);
          Dispose(NextRec);
          Delete(j);
        end;
        exit;
      end;
    end;
    Assert(false, 'ProcessMemMgr.FreeMem: unknown pointer');
  finally
    FMemList.UnlockList;
  end;
end;

procedure TForeignProcessMemMgr.Read(Source: Pointer; var Dest; Bytes: Cardinal);
var
  BytesRead: Cardinal;
begin
  if not ReadProcessMemory(FProcess, Source, @Dest, Bytes, BytesRead) then
    RaiseLastWin32Error;
end;

function TForeignProcessMemMgr.ReadStr(Source: PChar): String;
var
  BytesRead: Cardinal;
  OldSz, DeltaSz, NewSz: Integer;
  Buf: PChar;
  i: Integer;
  Found: Integer;
begin
  Result := '';
  if Source = nil then exit;
  Buf := nil;
  OldSz := 0;
  DeltaSz := $1000 - (Cardinal(Source) and $FFF);
  Found := -1;
  try
    while Found < 0 do begin
      NewSz := OldSz + DeltaSz;
      System.ReallocMem(Buf, NewSz);
      if not ReadProcessMemory(FProcess, Source + OldSz, Buf + OldSz , DeltaSz, BytesRead) then
        RaiseLastWin32Error;
      for i := OldSz to NewSz - 1 do begin
        if Buf[i] = #0 then begin
          Found := i;
          break;
        end;
      end;
      DeltaSz := $1000;
    end;
    SetLength(Result, Found);
    if Found > 0 then
      System.Move(Buf^, Result[1], Found);
  finally
    System.FreeMem(Buf);
  end;
end;

procedure TForeignProcessMemMgr.Write(const Source; Dest: Pointer; Bytes: Cardinal);
var
  BytesWritten: Cardinal;
begin
  if not WriteProcessMemory(FProcess, Dest, @Source, Bytes, BytesWritten) then
    RaiseLastWin32Error;
end;

procedure TForeignProcessMemMgr.WriteStr(const Str: String; Dest: Pointer);
begin
  Write(PChar(Str)^, Dest, Length(Str) + 1);
end;

{ TWin9xProcessMemMgr }

constructor TWin9xProcessMemMgr.Create(ProcessID: Cardinal);
begin
  inherited;
  FSharedList := TObjectList.Create;
end;

destructor TWin9xProcessMemMgr.Destroy;
begin
  FSharedList.Free;
  inherited;
end;

procedure TWin9xProcessMemMgr.NeedMoreMem(Bytes: Cardinal);
var
  Ix: Integer;
  Share: TSharedMem;
  Rec: PMemRec;
begin
  if Bytes < MemMgrMemSize then
    Bytes := MemMgrMemSize
  else
    Bytes := (Bytes + $FFF) and not $FFF;
  Ix := FSharedList.Count;
  Share := TSharedMem.Create('', Bytes);
  FSharedList.Add(Share);
  New(Rec);
  Rec^.Start := Share.Buffer;
  Rec^.Size := Bytes;
  Rec^.Group := Ix;
  Rec^.Used := false;
  FMemList.Add(Rec);
end;

{ TWinNTProcessMemMgr }

constructor TWinNTProcessMemMgr.Create(ProcessID: Cardinal);
begin
  inherited;
  FAllocList := TList.Create;
end;

destructor TWinNTProcessMemMgr.Destroy;
var
  i: Integer;
begin
  for i := 0 to FAllocList.Count - 1 do
    VirtualFreeEx(FProcess, FAllocList[i], 0, MEM_RELEASE);
  FAllocList.Free;
  inherited;
end;

procedure TWinNTProcessMemMgr.NeedMoreMem(Bytes: Cardinal);
var
  Ix: Integer;
  Alloc: Pointer;
  Rec: PMemRec;
begin
  if Bytes < MemMgrMemSize then
    Bytes := MemMgrMemSize
  else
    Bytes := (Bytes + $FFF) and not $FFF;
  Ix := FAllocList.Count;
  Alloc := VirtualAllocEx(FProcess, nil, MemMgrMemSize, MEM_COMMIT, PAGE_READWRITE);
  if Alloc = nil then RaiseLastWin32Error;
  FAllocList.Add(Alloc);
  New(Rec);
  Rec^.Start := Alloc;
  Rec^.Size := Bytes;
  Rec^.Group := Ix;
  Rec^.Used := false;
  FMemList.Add(Rec);
end;

function CreateProcessMemMgr(ProcessID: Cardinal): TProcessMemMgr;
begin
  if ProcessID = GetCurrentProcessId then begin
    Result := TOwnProcessMemMgr.Create;
  end else begin
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      Result := TWinNTProcessMemMgr.Create(ProcessID)
    else
      Result := TWin9xProcessMemMgr.Create(ProcessID);
  end;
end;

function CreateProcessMemMgrForWnd(Wnd: HWND): TProcessMemMgr;
var
  PID: Cardinal;
begin
  PID := 0;
  GetWindowThreadProcessId(Wnd, @PID);
  Result := CreateProcessMemMgr(PID);
end;

end.

强...虽然我没有看完..呵呵..