Delphi 的内存操作函数(6): 跨进程的内存分配

Delphi 为我们提供了三个方便的函数:

GlobalAllocPtr {简化自 API 的 GlobalAlloc}
GlobalReAllocPtr {简化自 API 的 GlobalReAlloc}
GlobalFreePtr {简化自 API 的 GlobalFree}

读写本程序以外的数据时可以使用它们, 很方便, 譬如:

p := GlobalAllocPtr(0, Len); {分配}
p := GlobalReAllocPtr(p, Len, 0); {重分配}
GlobalFreePtr(p); {释放}

注意 GlobalAllocPtr 的第一个参数和 GlobalReAllocPtr 的最后一个参数, 上面给的都是 0;
这两个参数的意义是一样的, 规范一点应该写成 GMEM_FIXED (表示分配固定内存), 常用的参数还有:

GMEM_MOVEABLE {分配可移动内存}
GMEM_ZEROINIT {同时清空内存}
GHND {分配可移动内存同时清空}
GPTR {分配固定内存同时清空}

参数还有很多, 和相应的 API 函数的参数是一致的.

下面的例子并没有使用进程以外的对象, 可以把 Memo1.Handle 换做外部的其他文本容器(譬如记事本)试一试:
--------------------------------------------------------------------------------

代码文件:
--------------------------------------------------------------------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
p: Pointer;
Len: Integer;
begin
Len := 6+1; {假如想要读出 6 个字符, 要留出结束的空字符}
p := GlobalAllocPtr(0, Len*2); {分配内存 Len*2 是针对双字节字符}
SendMessage(Memo1.Handle, WM_GETTEXT, Len, Cardinal(p));
ShowMessage(PChar(p)); {CodeGe}
GlobalFreePtr(p);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
p: Pointer;
Len: Integer;
begin
Len := 6+1; {假如想要读出 6 个字符, 要流出结束的空字符}
p := GlobalAllocPtr(0, Len*2); {分配内存 Len*2 是针对双字节字符}
SendMessage(Memo1.Handle, WM_GETTEXT, Len, Cardinal(p));
ShowMessage(PChar(p)); {CodeGe}

{在上一例的基础上继续, 先获取实际长度}
Len := SendMessage(Memo1.Handle, WM_GETTEXTLENGTH, 0, 0);
Len := (Len + 1) * 2;
p := GlobalReAllocPtr(p, Len, GHND); {重新分配内存}
SendMessage(Memo1.Handle, WM_GETTEXT, Len, Cardinal(p));
ShowMessage(PChar(p)); {CodeGear Delphi 2009}

GlobalFreePtr(p);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Align := alLeft;
Memo1.ScrollBars := ssVertical;
Memo1.Text := 'CodeGear Delphi 2009';
end;

end.
--------------------------------------------------------------------------------
窗体文件:
--------------------------------------------------------------------------------

object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 151
ClientWidth = 295
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 8
Top = 8
Width = 169
Height = 89
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object Button1: TButton
Left = 192
Top = 32
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 192
Top = 72
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 2
OnClick = Button2Click
end
end