weconnect_unit.pas

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

    else
      TN := TN.GetNext;
  end;
  TreeView1.Items.AddChild(TreeView1.Items[0], sName).ImageIndex := 15;
end;

//*******************************
//       下线通知
//********************************

procedure TFrmWeConnect.SetOffLine(value: string; in_addr: TSockAddrIn);
var
  TN: TTreeNode;
  sName: string;
begin
  delete(value, 1, 8);
  sName := copy(value, 1, pos('||', value) - 1);
  sName := sName + '(' + inet_ntoa(in_addr.sin_addr) + ')';
  TN := TreeView1.Items[0];
  while TN.GetNext <> nil do
  begin
    if TN.GetNext.Text = sName then
      TN.GetNext.Delete
    else
      TN := TN.GetNext;
  end;

end;

procedure TfrmWeConnect.SpeedButton1Click(Sender: TObject);
var
  sSend: string;
  len: integer;
  stb: string;
begin
  if ed_Content.Text = '' then exit;
  if co_Picture.ItemIndex < 0 then
    stb := '99'
  else
    stb := formatfloat('00', co_Picture.itemindex);
  sSend := stb + '||' + Ed_Name.Text + '||' + Ed_Content.Text;
  SendData(sSend);
  ed_Content.SelectAll;
  // showMessage(inttostr(len));
end;

procedure TfrmWeConnect.SendData(sSend: string);
var
  len: integer;
begin
  if not bSocketReady then exit;
  FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(m_GroupAddr));
  FSockAddrIn.sin_port := htons(m_SendPort);
  len := sendto(m_socket, sSend[1], length(sSend), 0, FSockAddrIn,
    sizeof(FSockAddrIn));
end;

procedure TfrmWeConnect.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Me_Player.FileName := self.m_ExitS;
  if m_ExitS <> '' then
  begin
    Me_player.Open;
    Me_Player.Play;
  end;
  SendData('**||do||' + ed_name.Text + '||');
  closeSocket(m_Socket);
  WSACleanup();
  Shell_NotifyIcon(NIM_DELETE, @m_Icon);
end;

procedure TfrmWeConnect.Timer1Timer(Sender: TObject);
var
  TN: TTreeNode;
begin
  if bSocketReady then
    if now - dt_lastOnline > (10 / (24 * 60 * 60)) then
    begin
      SendData('**||zz||'); //如果间隔超过1分钟,更新在线用户列表.
      TN := TreeView1.Items[0];
      while TN.GetNext <> nil do
        TN.GetNext.Delete;
    end;
end;

procedure TFrmWeConnect.GetIPUSER();
var
  pptr: PapInaddr; //用来格式化far* far * 无类型双指针.
  phe: PHostEnt; //用户IP类的结构.
  Buffer: array[0..63] of char;
  I: Integer;
  localHost: string;
  strList: TStringList;
begin
  strList := TStringList.Create;
  getHostName(Buffer, sizeof(Buffer)); //用到用户名.PCHAR类
  localHost := strPas(Buffer); //将PCHAR变成PASCAL的STRING
  m_PC := localhost; //记录本机名称
  phe := GetHostByName(Buffer); //将到IP地下列表
  if Phe = nil then exit;

  //用一个PAPINADDR类型转换.成in_addr数组指针
  pptr := PapInaddr(phe^.h_addr_list);
  i := 0;
  m_IP := '127.0.0.1';
  while pptr^[I] <> nil do
  begin
    strlist.Add(strpas(inet_ntoa(pptr^[i]^)));
    INC(I);
  end;
  application.CreateForm(TfrmSelectIP, frmSelectIP);
  try
    frmSelectIP.ComboBox1.Items.AddStrings(StrList);
    frmSelectIP.showModal;
    m_IP := frmSelectIP.Ed_IP.Text; //记录我的IP地址
  finally
    frmSelectIp.free;
  end;

end;

//********************************
//         读注册表,得机器名,IP
//********************************

function TfrmWeConnect.ReadRegistry(): boolean;
var
  m_reg: TRegistry;
  sTempStr: string;
begin
  result := true;
  m_Reg := TRegistry.Create;
  m_Reg.RootKey := hkey_current_user;
  if m_Reg.OpenKey('Software\WeConnect', false) then
    //以只读方式打开Weconnect的目录d
  begin
    m_PC := m_Reg.ReadString('m_pc');
    if m_PC = '' then result := false;
    m_IP := m_Reg.ReadString('m_IP');
    if m_IP = '' then Result := false;
    m_MessageS := m_Reg.ReadString('m_Message');
    m_LoginS := m_Reg.ReadString('m_Login');
    m_ExitS := m_Reg.ReadString('m_Exit');
  end
  else
    result := false;
  m_Reg.Free;
end;

//********************************
//         将机器名,IP 写入注册表
//********************************

function TfrmWeConnect.WriteRegistry(): boolean;
var
  m_reg: TRegistry;
  sTempStr: string;
begin
  m_Reg := TRegistry.Create;
  m_Reg.RootKey := hkey_current_user;
  m_Reg.OpenKey('Software\WeConnect', true);
  //以只读方式打开Weconnect的目录d
  m_Reg.writeString('m_pc', m_Pc);
  m_Reg.WriteString('m_IP', m_IP);
  result := true;
  m_reg.Free;
end;

procedure TfrmWeConnect.Ed_ContentKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    SpeedButton1.Click;
end;

procedure TfrmWeConnect.N1Click(Sender: TObject);
begin
  self.Visible := false;
end;

//*****************
//生成小图标
//****************

procedure TfrmWeConnect.SetIcon();
begin
  m_Icon.cbSize := SizeOf(TNotifyIconData);
  m_Icon.Wnd := self.Handle;
  m_Icon.uID := 2;
  m_Icon.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  m_Icon.uCallbackMessage := ICON_MESSAGE;
  m_Icon.hIcon := application.Icon.Handle;
  m_Icon.szTip := 'WeConnect';
  Shell_NotifyIcon(NIM_ADD, @m_Icon);
end;

procedure TfrmWeConnect.IconMessage(var Message: TMessage);
begin
  if message.LParam = WM_RBUTTONUP then
    PopupMenu1.Popup(mouse.CursorPos.X, mouse.CursorPos.Y);
end;

procedure TfrmWeConnect.R1Click(Sender: TObject);
begin
  self.Visible := true;
end;

procedure TfrmWeConnect.N2Click(Sender: TObject);
begin
  application.CreateForm(TfrmIntroduce, frmIntroduce);
  try
    frmIntroduce.ShowModal;
  finally
    frmIntroduce.Free;
  end;
end;

procedure TfrmWeConnect.Timer2Timer(Sender: TObject);
begin
  if not bSocketReady then
    StartupSocket()
  else
    if now - dt_lastOnline > (15 / (24 * 60 * 60)) then
    begin
      //如果两分钟内没有收到更新在线用户的要求,就当网络出错.
      self.DelRoute(); //删除224.0.0.0路由
      lb_State.Caption := '网络断开.';
      bSocketReady := false;
      closeSocket(m_Socket);
      WSACLeanUP();
    end;
end;

procedure TfrmWeConnect.IP1Click(Sender: TObject);
var
  m_reg: TRegistry;
  sTempStr: string;
begin
  m_Reg := TRegistry.Create;
  m_Reg.RootKey := hkey_current_user;
  m_Reg.OpenKey('Software\WeConnect', true);
  //以只读方式打开Weconnect的目录d
  m_Reg.WriteString('m_IP', '');
  m_Reg.WriteString('m_PC', '');
  m_Reg.WriteString('m_Login', '');
  m_Reg.WriteString('m_Message', '');
  m_Reg.WriteString('m_Exit', '');
  m_reg.Free;
end;

procedure TfrmWeConnect.O1Click(Sender: TObject);
begin
  skinData1.Active := false;
end;

//******************************************************************************
//   删除224.0.0.0路由.它删除的是PERSISTENT ROUTES.非活动的ROUTER.
//******************************************************************************

procedure TFrmWeConnect.DelRoute();
var
  aa: Pchar;
  tempStr: string;
begin
  GetMem(aa, 255); //申请内存
  GetSystemDirectory(aa, 254); //得到系统目录 windows\system32的目录
  m_Syspath := aa;
  tempStr := aa;
  WinExec(pchar(tempStr + '\route.exe  delete 224.0.0.0'), SW_HIDE);
  FreeMem(aa); //释放内存
end;

procedure TfrmWeConnect.N3Click(Sender: TObject);
begin
  application.CreateForm(TfrmSoundSelect, frmSoundSelect);
  try
    frmSoundSelect.ed_MessageS.Text := m_MessageS;
    frmSoundSelect.Ed_LoginS.Text := m_LoginS;
    frmSoundSelect.Ed_ExitS.Text := m_exitS;
    DelRoute();
    frmSoundSelect.Op_Sound.InitialDir := m_SysPath;
    frmSoundSelect.ShowModal;
    m_MessageS := frmSoundSelect.ed_MessageS.Text;
    m_LoginS := frmSoundSelect.Ed_LoginS.Text;
    m_exitS := frmSoundSelect.Ed_ExitS.Text;
  finally
    frmSoundSelect.Free;
  end;
end;

end.