使用WM_COPYDATA进行通讯

公共单元，定义server 与client类

unit IPC;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
const
  {定义消息常量}
  IPCServerDisconnecting = 'IPCServerDisconnecting';
  IPCClientDisconnecting = 'IPCClientDisconnecting';
  IPCConnectRequest = 'IPCConnectRequest';
  IPCConnectRespose = 'IPCConnectRespose';
type
  {定义事件类型}
  TOnData = procedure(MsgPointer: Pointer) of object; //数据事件
  TOnClientData = procedure(MsgPointer: Pointer; AHwnd: HWND) of object; //当客户端接收数据事件
  TOnConnect = procedure(AHwnd: HWND) of object; //连接事件
  TOnDisconnect = procedure(AHwnd: HWND) of object; //断开事件


  {定义TIPCServer服务器类}
  TIPCServer = class(TComponent)
  private
    FWinHwnd: HWND; //窗体句柄
    FOnClientData: TOnClientData; //当接收到客户端数据时
    FOnConnect: TOnConnect; //当连接
    FOnDisconnect: TOnDisconnect; //当断开
    FActive: Boolean; //是否激活
    FSessionName: string; //连接会话的名字
    FSessionHandle: Longint; //连接会话的消息标识符
    FServerDisconnectHwnd: Longword; //IPCServerDisconnecting消息标识符
    FConnectRequestHwnd: Longword; //IPCConnectRequest消息标识符
    FConnectResposeHwnd: Longword; //IPCConnectRespose消息标识符
    FClientDisconnectHwnd: Longword; //IPCClientDisconnecting消息标识符
    FOnAfterClose: TNotifyEvent; //打开事件
    FOnAfterOpen: TNotifyEvent; //关闭事件
  protected
    procedure WndProc(var AMsg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SendMsg(MsgPointer: Pointer; AWinHwnd: HWND; ASize: DWORD);
    procedure Open;
    procedure Close;
  published
    property Active: Boolean read FActive default False;
    property OnClientData: TOnClientData read FOnClientData write FOnClientData;
    property OnConnect: TOnConnect read FOnConnect write FOnConnect;
    property OnDisconnect: TOnDisconnect read FOnDisconnect write FOnDisconnect;
    property OnAfterClose: TNotifyEvent read FOnAfterClose write FOnAfterClose;
    property OnAfterOpen: TNotifyEvent read FOnAfterOpen write FOnAfterOpen;
    property SessionName: string read FSessionName write FSessionName;
  end;
  {定义客户端TIPCClient}
  TIPCClient = class(TComponent)
  private
    FWinHwnd: HWND; //窗体句柄
    FServerWinHwnd: HWND; //窗体句柄
    FOnData: TOnData; //当客户端接受数据
    FOnConnect: TOnConnect; //当客户端连接
    FOnDisconnect: TOnDisconnect; //当客户端断开连接
    FActive: Boolean; //是否激活
    FSessionName: string; // 连接会话的名字
    FSessionHandle: Longint; //连接会话的消息标识符
    FServerDisconnectHwnd: Longword; //IPCServerDisconnecting消息标识符
    FConnectRequestHwnd: Longword; //IPCConnectRequest消息标识符
    FConnectResposeHwnd: Longword; //IPCConnectRespose消息标识符
    FClientDisconnectHwnd: Longword; //IPCClientDisconnecting消息标识符
  protected
    procedure WndProc(var AMsg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SendMsg(MsgPointer: Pointer; ASize: DWORD);
    procedure Open;
    procedure Close;
  published
    property Active: Boolean read FActive default False;
    property OnData: TOnData read FOnData write FOnData;
    property OnConnect: TOnConnect read FOnConnect write FOnConnect;
    property OnDisconnect: TOnDisconnect read FOnDisconnect write FOnDisconnect;
    property SessionName: string read FSessionName write FSessionName;
  end;


implementation


//TIPCServer实现


constructor TIPCServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWinHwnd := 0;
  FSessionHandle := 0;
  //注册消息常量
  FServerDisconnectHwnd := RegisterWindowMessage(IPCServerDisconnecting);
  FConnectRequestHwnd := RegisterWindowMessage(IPCConnectRequest);
  FConnectResposeHwnd := RegisterWindowMessage(IPCConnectRespose);
  FClientDisConnectHwnd := RegisterWindowMessage(IPCClientDisconnecting);
end;


destructor TIPCServer.Destroy;
begin
  if FWinHwnd <> 0 then
  begin
    //广播服务器断开消息
    SendMessage(HWND_BROADCAST, FServerDisconnectHwnd, FWinHwnd, 0);
    DeallocateHWND(FWinHwnd);
  end;
  inherited Destroy;
end;


procedure TIPCServer.Open;
begin
  if not FActive then
  begin
    //注册连接会话的消息标识符
    FSessionHandle := RegisterWindowMessage(PChar(FSessionName));
    //创建新窗体，窗体过程执行WndProc;
    FWinHwnd := AllocateHWND(WndProc);
    if FWinHwnd <> 0 then
    begin
      FActive := True;
      if Assigned(FOnAfterOpen) then
        FOnAfterOpen(Self);
    end
    else
      raise Exception.Create('Cannot Allocate Window Handle');
  end;
end;


procedure TIPCServer.Close;
begin
  if FActive then
  begin
    if FWinHwnd <> 0 then
    begin
      //广播服务器断开的消息
      SendMessage(HWND_BROADCAST, FServerDisconnectHwnd, FWinHwnd, FSessionHandle);
      //释放由AllocateHWND创建的窗体
      DeallocateHWND(FWinHwnd);
      FWinHwnd := 0;
      FActive := False;
      if Assigned(FOnAfterClose) then
        FOnAfterClose(Self);
    end;
  end;
end;


//重载消息处理过程


procedure TIPCServer.WndProc(var AMsg: TMessage);
var
  MsgPointer: Pointer;
  ClientHwnd: HWND;
begin
  //根据消息种类，分别处理
  if ((AMsg.Msg = WM_COPYDATA) and (AMsg.wParam = FSessionHandle)) then
  begin
  //如果是WM_CopyData消息
    MsgPointer := (TCopyDataStruct(Pointer(AMsg.lParam)^)).lpData;
    ClientHwnd := (TCopyDataStruct(Pointer(AMsg.lParam)^)).dwData;
    if Assigned(FOnClientData) then
      FOnClientData(MsgPointer, ClientHwnd);
  end
  else if ((AMsg.Msg = FConnectRequestHwnd) and (AMsg.lParam = FSessionHandle)) then
  begin
  //如果是客户端连接请求消息时
    if FActive then
    begin
      //得到客户端窗口句柄
      ClientHwnd := AMsg.wParam;
      if ClientHwnd <> 0 then
      begin
        SendMessage(ClientHwnd, FConnectResposeHwnd, FWinHwnd, 0);
        if Assigned(FOnConnect) then
          FOnConnect(ClientHwnd);
      end;
    end;
  end
  else if ((AMsg.Msg = FClientDisconnectHwnd) and (AMsg.lparam = FSessionHandle)) then
  begin
    //如果是客户端断开连接时
    ClientHwnd := Amsg.WParam;
    SendMessage(ClientHwnd, FServerDisconnectHwnd, FwinHwnd, 0);
    if Assigned(FOnDisConnect) then
      FOnDisConnect(clientHwnd);
  end;
end;


procedure TIPCServer.SendMsg(MsgPointer: Pointer; AWinHwnd: HWND; ASize: DWORD);
var
  CopyDataStruct: TCopyDataStruct;
begin
  CopyDataStruct.dwData := 0;
  CopyDataStruct.cbData := ASize;
  CopyDataStruct.lpData := MsgPointer;
  SendMessage(AWinHwnd, WM_COPYDATA, FSessionHandle, lParam(@CopyDataStruct));
end;


//TIPCClient实现


constructor TIPCClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWinHwnd := 0;
  FServerWinHwnd := 0;
  FSessionHandle := 0;
  //注册消息常量
  FServerDisconnectHwnd := RegisterWindowMessage(IPCServerDisconnecting);
  FConnectRequestHwnd := RegisterWindowMessage(IPCConnectRequest);
  FConnectResposeHwnd := RegisterWindowMessage(IPCConnectRespose);
  FClientDisconnectHwnd := RegisterWindowMessage(IPCClientDisconnecting);
end;


destructor TIPCClient.Destroy;
begin
  if FWinHwnd <> 0 then
  //释放由AllocateHWND创建的窗体
    DeallocateHWND(FWinHwnd);
  inherited Destroy;
end;


procedure TIPCClient.Open;
begin
  if not FActive then
  begin
    //注册连接会话的消息标识符
    FSessionHandle := RegisterWindowMessage(PChar(FSessionName));
   //创建新窗体，窗体过程执行WndProc;
    FWinHwnd := AllocateHWND(WndProc);
    if FWinHwnd <> 0 then
      SendMessage(HWND_BROADCAST, FConnectRequestHwnd, FWinHwnd, FSessionHandle);
  end;
end;


procedure TIPCClient.Close;
begin
  if FActive then
  begin
    if FWinHwnd <> 0 then
    begin
      //广播消息，客户端断开
      SendMessage(HWND_BROADCAST, FClientDisconnectHwnd, FWinHwnd, FSessionHandle);
     //释放由AllocateHWND创建的窗体
      DeallocateHWND(FWinHwnd);
      FWinHwnd := 0;
      FActive := False;
    end;
  end;
end;


procedure TIPCClient.WndProc(var AMsg: TMessage);
var
  MsgPointer: Pointer;
begin
  //根据消息种类，分别执行
  //WM_CopyData消息
  if (AMsg.Msg = WM_COPYDATA) then
  begin
    MsgPointer := (TCopyDataStruct(Pointer(AMsg.lParam)^)).lpData;
    if Assigned(FOnData) then
      FOnData(MsgPointer);
  end
  //连接响应消息
  else if AMsg.Msg = FConnectResposeHwnd then
  begin
    if not FActive then
    begin
      FServerWinHwnd := AMsg.wParam;
      if Assigned(FOnConnect) then
        FOnConnect(FServerWinHwnd);
      FActive := True;
    end;
  end
  //服务器端断开连接消息
  else if AMsg.Msg = FServerDisconnectHwnd then
  begin
    if FActive then
    begin
      if AMsg.wParam = Longint(FServerWinHwnd) then
      begin
        if Assigned(FOnDisconnect) then
          FOnDisconnect(FServerWinHwnd);
        FServerWinHwnd := 0;
        FActive := False;
      end;
    end;
  end;
end;


procedure TIPCClient.SendMsg(MsgPointer: Pointer; ASize: DWORD);
var
  CopyDataStruct: TCopyDataStruct;
begin
  if FServerWinHwnd <> 0 then
  begin
    CopyDataStruct.dwData := FWinHwnd;
    CopyDataStruct.cbData := ASize;
    CopyDataStruct.lpData := MsgPointer;
    SendMessage(FServerWinHwnd, WM_COPYDATA, FSessionHandle, lParam(@CopyDataStruct));
  end;
end;


end.

server端代码

unit ServerMain;


interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IPC, ComCtrls, Spin;


type
  TfrmServer = class(TForm)
    Label6: TLabel;
    edtSessionName: TEdit;
    btnListen: TButton;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    edtReceiveString: TEdit;
    sedtReceiveInteger: TSpinEdit;
    StatusBar: TStatusBar;
    Label5: TLabel;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    edtSendString: TEdit;
    sedtSendInteger: TSpinEdit;
    btnSend: TButton;
    procedure btnSendClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnListenClick(Sender: TObject);
  private
    FClientHwnd: HWND;
    IPCServer: TIPCServer; //定义IPCServer
    Procedure IPCServerAfterOpen(Sender : Tobject);
    procedure IPCServerConnect(AHwnd: HWND);
    procedure IPCServerDisconnect(AHwnd: HWND);
    procedure IPCServerClientData(MsgPointer: Pointer; AHwnd: HWND);
    procedure IPCServerAfterClose(Sender: TObject);


  public
    { Public declarations }
  end;


type
  {定义一个发送和接收数据记录类型}
  PIPCData = ^TIPCData;
  TIPCData = record
    SendString: string[30];
    SendInteger: integer;
  end;
var
  frmServer: TfrmServer;


implementation


{$R *.DFM}


//当窗体被创建时
procedure TfrmServer.FormCreate(Sender: TObject);
begin
//创建IPCServer
  IPCServer := TIPCServer.Create(self);
  IPCServer.OnAfterOpen := IPCServerAfterOpen;
  IPCServer.OnConnect := IPCServerConnect;
  IPCServer.OnDisconnect := IPCServerDisConnect;
  IPCServer.OnAfterClose := IPCServerAfterClose;
  IPCServer.OnClientData := IPCServerClientData;
end;


//监听连接
procedure TfrmServer.btnListenClick(Sender: TObject);
begin
  if not IPCServer.Active then
    IPCServer.SessionName := edtSessionName.Text;
  IPCServer.Open;
end;




//发送数据
procedure TfrmServer.btnSendClick(Sender: TObject);
var
  MsgData: TIPCData;
begin
  if IPCServer.Active then
  begin
    MsgData.SendString := edtSendString.Text;
    MsgData.SendInteger := SedtSendInteger.Value;
    IPCServer.SendMsg(@MsgData, FClientHwnd, Sizeof(MsgData));
  end;
end;


//服务器连接事件
procedure TfrmServer.IPCServerConnect(AHwnd: HWND);
begin
  FClientHwnd := AHwnd;
  statusbar.Panels[0].Text := '连接状态：已连接';
  statusbar.Refresh;
end;


//服务器断开事件
procedure TfrmServer.IPCServerDisconnect(AHwnd: HWND);
begin
  statusbar.Panels[0].Text := '连接状态：未连接';
  statusbar.Refresh;


end;


//接收客户端数据
procedure TfrmServer.IPCServerClientData(MsgPointer: Pointer; AHwnd: HWND);
var
  AMsg: TIPCData;
begin
  FClientHwnd := AHwnd;
  AMsg := TIPCData(MsgPointer^);
  edtReceiveString.Text := AMsg.SendString;
  sedtReceiveInteger.Value := AMsg.SendInteger;
end;


//服务器端被打开事件
procedure TfrmServer.IPCServerAfterOpen(sender : TObject);
begin
  statusbar.Panels[0].Text := '连接状态：处于监听状态....';
  statusbar.Refresh;
  FClientHwnd := 0;
end;


//服务器端被断开事件
procedure TfrmServer.IPCServerAfterClose(Sender: TObject);
begin
  statusbar.Panels[0].Text := '连接状态：未连接';
  statusbar.Refresh;
  FClientHwnd := 0;
end;






end.

Client端 代码

unit ClientMain;


interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IPC, Spin, ComCtrls;


type
  TfrmClient = class(TForm)
    edtSessionName: TEdit;
    btnConnect: TButton;
    GroupBox1: TGroupBox;
    edtReceiveString: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    sedtReceiveInteger: TSpinEdit;
    StatusBar: TStatusBar;
    Label5: TLabel;
    GroupBox2: TGroupBox;
    edtSendString: TEdit;
    sedtSendInteger: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    btnSend: TButton;
    procedure btnSendClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    IPCClient: TIPCClient;  //定义IPCClient
    procedure IPCClientConnect(AHwnd: HWND);
    procedure IPCClientDisconnect(AHwnd: HWND);
    procedure IPCClientData(MsgPointer: Pointer);
    { Private declarations }
  public
    { Public declarations }
  end;


type
  {定义一个发送和接收数据记录类型}
  PIPCData = ^TIPCData;
  TIPCData = record
    SendString: string[30];
    SendInteger: integer;
  end;


var
  frmClient: TfrmClient;


implementation


{$R *.DFM}


//主窗体创建事件
procedure TfrmClient.FormCreate(Sender: TObject);
begin
  IPCClient := TIPCClient.Create(self);
  IPCClient.OnConnect := IPCClientConnect;
  IPCClient.OnDisconnect := IPCClientDisConnect;
  IPCClient.OnData := IPCClientData;
end;


//连接或断开服务器
procedure TfrmClient.btnConnectClick(Sender: TObject);
begin
  if btnconnect.Caption = '连接' then
  begin
    if not IPCClient.Active then
      IPCClient.SessionName := edtSessionName.Text;
    IPCClient.Open;
  end
  else
    IPCClient.Close;
end;


//发送数据
procedure TfrmClient.btnSendClick(Sender: TObject);
var
  MsgData: TIPCData;
begin
  if IPCClient.Active then
  begin
    MsgData.SendString := edtSendString.Text;
    MsgData.SendInteger := sedtSendInteger.Value;
    IPCClient.SendMsg(@MsgData, Sizeof(MsgData));
  end;
end;


//连接服务器事件
procedure TfrmClient.IPCClientConnect(AHwnd: HWND);
begin
  Statusbar.Panels[0].Text := '连接状态 ：已连接';
  Statusbar.Refresh;
  btnConnect.Caption := '断开连接'
end;


//断开服务器连接事件
procedure TfrmClient.IPCClientDisconnect(AHwnd: HWND);
begin
  Statusbar.Panels[0].Text := '连接状态 ：未连接';
  Statusbar.Refresh;
  btnConnect.Caption := '连接'
end;


//接收数据事件
procedure TfrmClient.IPCClientData(MsgPointer: Pointer);
var
  AMsg: TIPCData;
begin
  AMsg := TIPCData(MsgPointer^);
  edtReceiveString.Text := AMsg.SendString;
  sedtReceiveInteger.Value := AMsg.SendInteger;
end;


end.


interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IPC, Spin, ComCtrls;


type
  TfrmClient = class(TForm)
    edtSessionName: TEdit;
    btnConnect: TButton;
    GroupBox1: TGroupBox;
    edtReceiveString: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    sedtReceiveInteger: TSpinEdit;
    StatusBar: TStatusBar;
    Label5: TLabel;
    GroupBox2: TGroupBox;
    edtSendString: TEdit;
    sedtSendInteger: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    btnSend: TButton;
    procedure btnSendClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    IPCClient: TIPCClient;  //定义IPCClient
    procedure IPCClientConnect(AHwnd: HWND);
    procedure IPCClientDisconnect(AHwnd: HWND);
    procedure IPCClientData(MsgPointer: Pointer);
    { Private declarations }
  public
    { Public declarations }
  end;


type
  {定义一个发送和接收数据记录类型}
  PIPCData = ^TIPCData;
  TIPCData = record
    SendString: string[30];
    SendInteger: integer;
  end;


var
  frmClient: TfrmClient;


implementation


{$R *.DFM}


//主窗体创建事件
procedure TfrmClient.FormCreate(Sender: TObject);
begin
  IPCClient := TIPCClient.Create(self);
  IPCClient.OnConnect := IPCClientConnect;
  IPCClient.OnDisconnect := IPCClientDisConnect;
  IPCClient.OnData := IPCClientData;
end;


//连接或断开服务器
procedure TfrmClient.btnConnectClick(Sender: TObject);
begin
  if btnconnect.Caption = '连接' then
  begin
    if not IPCClient.Active then
      IPCClient.SessionName := edtSessionName.Text;
    IPCClient.Open;
  end
  else
    IPCClient.Close;
end;


//发送数据
procedure TfrmClient.btnSendClick(Sender: TObject);
var
  MsgData: TIPCData;
begin
  if IPCClient.Active then
  begin
    MsgData.SendString := edtSendString.Text;
    MsgData.SendInteger := sedtSendInteger.Value;
    IPCClient.SendMsg(@MsgData, Sizeof(MsgData));
  end;
end;


//连接服务器事件
procedure TfrmClient.IPCClientConnect(AHwnd: HWND);
begin
  Statusbar.Panels[0].Text := '连接状态 ：已连接';
  Statusbar.Refresh;
  btnConnect.Caption := '断开连接'
end;


//断开服务器连接事件
procedure TfrmClient.IPCClientDisconnect(AHwnd: HWND);
begin
  Statusbar.Panels[0].Text := '连接状态 ：未连接';
  Statusbar.Refresh;
  btnConnect.Caption := '连接'
end;


//接收数据事件
procedure TfrmClient.IPCClientData(MsgPointer: Pointer);
var
  AMsg: TIPCData;
begin
  AMsg := TIPCData(MsgPointer^);
  edtReceiveString.Text := AMsg.SendString;
  sedtReceiveInteger.Value := AMsg.SendInteger;
end;


end.