ipc.pas

《Delphi 7经典问题解析》源代码 第一到七章 基础篇源程序 应用篇源程序

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.