weconnect_unit.~pas

群组对话,组播版,分为服务器端和客户端代码,详细功能有介绍

unit Weconnect_Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, ImgList, winsock, Buttons, Registry,
  Shellapi, Menus, XPMenu, WinSkinData, MPlayer;

const
  WM_SOCKETRECEIVE = WM_USER + 123; //自定义的SOCKET接收消息ID
  Icon_Message = WM_USER + 124; //小图标消息
  m_SendPort = 60001; //本机IP组播的端口(UDP端口)
  m_GroupAddr = '224.0.0.9'; //组播组的地址

type
  TaPInAddr = array[0..10] of PInAddr; //定义一个IN_ADDR类型的数组
  PaPInAddr = ^TaPInAddr; //同上,用来得到本机的地址.
  ip_mreq = record //加入组播时常用的东西.
    imr_multiaddr: in_addr; (* 要加入的组播组的地址 *)
    imr_interface: in_addr; (* 本地接口地址 *)
  end;
  TIpMReq = ip_mreq;
  PIpMReq = ^ip_mreq;
type
  TfrmWeConnect = class(TForm)
    TreeView1: TTreeView;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Ed_Name: TEdit;
    Panel3: TPanel;
    GroupBox1: TGroupBox;
    li_Message: TListView;
    Label2: TLabel;
    Ed_Content: TEdit;
    SpeedButton1: TSpeedButton;
    ImageList1: TImageList;
    co_Picture: TComboBoxEx;
    Label3: TLabel;
    Label4: TLabel;
    lb_State: TLabel;
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    R1: TMenuItem;
    N2: TMenuItem;
    Timer2: TTimer;
    IP1: TMenuItem;
    XPMenu1: TXPMenu;
    SkinData1: TSkinData;
    O1: TMenuItem;
    Me_player: TMediaPlayer;
    N3: TMenuItem;

    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure Ed_ContentKeyPress(Sender: TObject; var Key: Char);
    procedure N1Click(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure IP1Click(Sender: TObject);
    procedure O1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    m_Socket: TSocket; //通信用SOCKET
    m_Sendaddr: TSockAddr; //发送的UDP地址.
    FSockAddrIn: TSockAddrIn; //信息来源的地址信息
    mreq: ip_mreq; //组播设置
    bSocketReady: boolean; //Socket 准备好
    dt_lastOnline: TdateTime; //最后一次收到 '**||zz||'的时间
    m_IP: string; //IP地址
    m_PC: string; //机名
    m_Icon: TNotifyIconData;
    m_MessageS, m_LoginS, m_ExitS: string; //消息音,登录音,退出音
    m_SysPath: string; //系统目录
    procedure ReadData(var Message: TMessage); message WM_SOCKETRECEIVE;
    procedure IconMessage(var Message: TMessage); message Icon_Message;
    procedure StartupSocket();
    procedure SetOutLook(sContent: string); //显示内容
    procedure SetOnLine(value: string; in_addr: TSockAddrIn); //设在线
    procedure SetOffLine(value: string; in_addr: TSockAddrIn); //设离线
    procedure SendData(sSend: string); //发送数据.
    procedure GetIPUSER(); //得到本机IP,本机名
    procedure SetIcon(); //注册小图标
    procedure DelRoute(); //如果开了ADSL,会多加一个224.0.0.0的ROUT,要删掉它.

    //hkey_current_user\Software\WeConnect (m_pc,m_IP)
    function ReadRegistry(): boolean;

    //hkey_current_user\Software\WeConnect (m_pc,m_IP)
    function WriteRegistry(): boolean;

  end;

var
  frmWeConnect: TfrmWeConnect;

implementation

uses uSelectIP, uIntroduce, uSoundSelect;

{$R *.dfm}

procedure TFrmWeConnect.StartupSocket();
//起动UPD SOCKET的代码,
var
  wWSAData: TWSAData;
  wVersion: WORD;
  iError: integer;
begin
  Timer2.Enabled := false;
  wVersion := MakeWord(2, 0); //要求版本为 WinSocket 2.0
  iError := WSAStartup(wVersion, wWSAData);
  //初始化可用的DLL.不一定是2.0版,正确时为0
  if iError = 1 then //非0,关闭DLL
  begin
    WSACleanup();
    lb_state.Caption := '不能初始化你的WINSOCK2.0 DLL ';
    exit;
  end;

  //**读注册表,没有信息,就重新得到机名,IP
  if not self.ReadRegistry then
  begin
    GetIPUSER(); //得到IP信息等
    if M_IP = '127.0.0.1' then //可能当时的网络并不存在,算出错.
    begin
      lb_state.Caption := '网络不存在或未连通';
      WSACLeanUP();
      Timer2.Enabled := true;
      exit;
    end;
    WriteRegistry;
  end;
  ed_name.Text := m_PC;
  m_Socket := Socket(AF_INET, SOCK_DGRAM, 0); //创建一个UPD数据报SOCKET.
  if m_Socket = INVALID_SOCKET then //SOCKET创建出错.
  begin
    closeSocket(m_Socket);
    lb_State.Caption := '通信用的SOCKET 创建出错.';
    Timer2.Enabled := true;
    WSACleanup();
    exit;
  end;
  m_SendAddr.sin_family := AF_INET;
  m_SendAddr.sin_addr.S_addr := inet_addr(pchar(m_IP)); //本机的UDP SOCKET 地址
  m_SendAddr.sin_port := htons(m_SendPort); //转换为TCP/IP标准格式.
  if bind(m_Socket, m_sendAddr, sizeof(m_SendAddr)) <> 0 then
  begin
    lb_State.Caption := 'SOCKET 绑定失败';
    closeSocket(m_Socket);
    WSACleanup();
    Timer2.Enabled := true;
    exit;
  end;

  //组播IP地址
  mreq.imr_multiaddr.S_addr := inet_addr(pchar(m_GroupAddr));
  //转换String到in_addr;
  mreq.imr_interface.S_addr := inet_addr(pchar(m_IP)); //本机地址,默认值.

  if setsockopt(m_Socket, IPPROTO_IP, IP_ADD_MEMBERSHIP, pchar(@mreq),
    sizeof(mreq)) =
    SOCKET_ERROR then
  begin
    lb_State.Caption := 'Socket 加入组播组失败!!!';
    closeSocket(m_Socket);
    WSACleanup();
    Timer2.Enabled := true;
    exit;
  end;

  //为SOCKET注册一个读事件消息.
  WSAASYNCSelect(m_Socket, frmWeconnect.Handle, WM_SOCKETRECEIVE, FD_READ);

  //接收端SockAddrIn设定
  FSockAddrIn.SIn_Family := AF_INET;
  FSockAddrIn.SIn_Port := htons(m_SendPort);
  lb_State.Caption := '初始化SOCKET(成功),加入到组播组(成功)';
  bSocketReady := true;
  treeview1.AutoExpand := true;
  Timer1.Enabled := true;
  Timer2.Enabled := true;
end;

procedure TfrmWeConnect.FormCreate(Sender: TObject);
begin
  StartupSocket();
  if bSocketReady then
  begin
    SendData('**||up||' + ed_name.Text + '||');
    SendData('**||zz||'); //要求得到所有的用户名
  end;
  SetIcon;
  Me_Player.FileName := m_LoginS;
  //self.DelRoute(); //怕有ADSL且为双网卡,要删224.0.0.0路由删掉.
  if m_LoginS <> '' then
  begin
    Me_player.Open;
    Me_Player.Play;
  end;
end;

procedure TFrmWeConnect.ReadData(var Message: TMessage);
var
  buffer: array[1..4096] of char;
  len: integer;
  flen: integer;
  Event: word;
  value: string;
begin
  if not bSocketReady then exit;
  flen := sizeof(FSockAddrIn);
  Event := WSAGetSelectEvent(Message.LParam);
  if Event = FD_READ then
  begin
    FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(m_GroupAddr));
    len := recvfrom(m_socket, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
    value := copy(buffer, 1, len);

    if copy(value, 1, 8) = '**||up||' then //上线标志
      self.SetonLine(value, FSockAddrIn)
    else
      if copy(value, 1, 8) = '**||do||' then //下线标志
        self.setOffLine(value, FSockAddrIn)
      else
        if copy(value, 1, 8) = '**||zz||' then //要求发送用户名,确认在线.
        begin
          SendData('**||up||' + ed_name.Text + '||');
          dt_lastonline := now;
        end
        else
          if value <> '' then
            SetOutLook(value);
  end;
end;

//********************************************
//  当发送过来的是信息,就显示在LISTVIEW中.
//********************************************

procedure TfrmWeConnect.SetOutLook(sContent: string);
var
  sTB, sUser, sWhat: string; //图标,用户,内容
begin
  self.Visible := true;
  sTB := copy(sContent, 1, 2);
  delete(scontent, 1, 4);
  sUser := copy(sContent, 1, pos('||', sContent) - 1);
  delete(sContent, 1, pos('||', sContent) + 1);
  sWhat := sContent;
  li_Message.Items.AddItem(TListItem.Create(li_Message.items), 0);
  li_Message.Items[0].Caption := sUser;
  if sTB <> '99' then
    li_Message.Items[0].ImageIndex :=
      strtoint(sTB)
  else
    li_Message.Items[0].ImageIndex := -1;
  li_Message.Items[0].SubItems.add(formatdatetime('HH:NN:SS', now));
  li_Message.Items[0].SubItems.add(sWhat);
  Me_Player.FileName := self.m_MessageS;
  if m_MessageS <> '' then
  begin
    Me_player.Open;
    Me_Player.Play;
  end;

end;

//**********************************************
//设置在线
//**********************************************

procedure TFrmWeConnect.SetOnLine(value: string; in_addr: TSockAddrIn);
var
  TN: TTreeNode;
  sName: string;
begin
  delete(value, 1, 8);
  sName := copy(value, 1, pos('||', value) - 1) + '(' +
    inet_ntoa(in_addr.sin_addr) //将IP地址信息转成本机STRING类地址
  + ')';
  TN := Treeview1.Items[0];
  while TN <> nil do
  begin
    if TN.Text = sName then
      exit