clientunit.pas

IPXControl: 本软件是一个免费控件

//==================================================================//
//多用户语音聊天客户端
//发送格式：正文消息 Rain_MSG: + message
//          更新私聊用户列表 Rain_Private: + PrivateUser
//接收格式：含有Rain_Update:的消息是当前用户列表，以,\n结束。
//          没有标记的是正文消息
//==================================================================//
unit ClientUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, Menus, Buttons, ScktComp,mmsystem,shellApi,
  Registry, ImgList;
const CHAT_SERVER_PORT=6778;
      WM_MYICON=WM_USER+2001;
type
  TChatClient = class(TForm)
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    ConnectMenuItem: TMenuItem;
    N1: TMenuItem;
    DisConnectMenuItem: TMenuItem;
    FileSettingsMenuItem: TMenuItem;
    Exit: TMenuItem;
    H1: TMenuItem;
    AboutMenuItem: TMenuItem;
    Bevel1: TBevel;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Memo1: TMemo;
    Splitter1: TSplitter;
    Memo2: TMemo;
    ClientSocket1: TClientSocket;
    SpeedButton1: TSpeedButton;
    PopupMenu1: TPopupMenu;
    OpenPop: TMenuItem;
    ConnectPop: TMenuItem;
    DisConnectPop: TMenuItem;
    N2: TMenuItem;
    ExitPop: TMenuItem;
    AutoRunMenuItem: TMenuItem;
    CanSoundPop: TMenuItem;
    CanSound: TMenuItem;
    N4: TMenuItem;
    A2: TMenuItem;
    ImageList1: TImageList;
    FlashTimer: TTimer;
    OnLineListBox: TListBox;
    Splitter2: TSplitter;
    CheckBox1: TCheckBox;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ConnectMenuItemClick(Sender: TObject);
    procedure DisConnectMenuItemClick(Sender: TObject);
    procedure FileSettingsMenuItemClick(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Lookup(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure OpenPopClick(Sender: TObject);
    procedure ConnectPopClick(Sender: TObject);
    procedure DisConnectPopClick(Sender: TObject);
    procedure ExitPopClick(Sender: TObject);
    procedure ExitClick(Sender: TObject);
    procedure AutoRunMenuItemClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure CanSoundPopClick(Sender: TObject);
    procedure CanSoundClick(Sender: TObject);
    procedure A2Click(Sender: TObject);
    procedure AboutMenuItemClick(Sender: TObject);
    procedure FlashTimerTimer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure OnLineListBoxClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    ClientConnected:Boolean;
    NickName:AnsiString;
    OutSocket:TCustomWinSocket;
    procedure UpdateTrayTip(TempStr:string);
    procedure MaxTray(Sender: TObject);
    procedure MiniTray(Sender: TObject);
    procedure WMmyicon(var MSG:Tmessage);
    procedure EnableClient;
    procedure DisableClient;
    procedure ValidateControls(Sender:TObject;var Done:Boolean);
    procedure OnLineUserUpdate(TmpStr:string);
  public
    { Public declarations }
  end;

var
  ChatClient: TChatClient;
  CanPaint:Boolean;
  Pnid:NOTIFYICONDATA;
  Flag:Boolean = False;
  FlashCount:integer = 0;
implementation
  uses  SettingUnit;
    function  StartPhone(HostAddress:LPCTSTR;lPort:Integer;rPort:Integer):Integer;stdcall;external'Phone.dll' ;
    procedure ClosePhone ; stdcall;external'Phone.dll';
{$R *.DFM}
{$R RING.RES}

procedure TChatClient.FormCreate(Sender: TObject);
var
   RegF:TRegistry;
begin
   ClientConnected:=False;
   OutSocket:=nil;
   Application.OnIdle:=ValidateControls;
   Application.OnMinimize:=MiniTray;
   Application.OnRestore:=MaxTray;
   CanPaint:=True;
   CanSound.Checked:=True;
   CanSoundPop.Checked:=True;

   Pnid.cbSize:=sizeof(NOTIFYICONDATA);
   Pnid.Wnd:=AllocateHWnd(WmMyIcon);                             //
   Pnid.uID:=1;
   Pnid.uFlags:=NIF_TIP or NIF_ICON or NIF_MESSAGE;
   Pnid.uCallbackMessage:=WM_MYICON;                          //
   Pnid.hIcon:=Application.Icon.Handle;

   Memo1.Lines.Clear;
   Memo2.Lines.Clear;
   NickName:='Test1';
   ConnectMenuItem.Enabled:=not ClientConnected;
   DisconnectMenuItem.Enabled:=ClientConnected;
   FileSettingsMenuItem.Enabled:=not ClientConnected;
   Memo1.ReadOnly:=(OutSocket=nil);
   ClientSocket1.Port:=CHAT_SERVER_PORT;
   RegF:=TRegistry.Create;
   RegF.RootKey:=HKEY_LOCAL_MACHINE;

   AutoRunMenuItem.Checked:=False;
   try
     RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
     if  RegF.ValueExists('MultiChatClient') then
        if (RegF.ReadString('MultiChatClient')=Application.ExeName) then
            AutoRunMenuItem.Checked:=True;

   finally
     RegF.CloseKey;
     RegF.Free;
   end;

end;

procedure TChatClient.ConnectMenuItemClick(Sender: TObject);
begin
//  ClientSocket1.Host:='LocalHost';
  if (ClientSocket1.Host='') and (ClientSocket1.Address='') then
      FileSettingsMenuItemClick(application)
  else
      EnableClient;
end;

procedure TChatClient.DisConnectMenuItemClick(Sender: TObject);
begin
  if ClientConnected then
       DisableClient;
end;

procedure TChatClient.FileSettingsMenuItemClick(Sender: TObject);
begin
   SettingForm:=TSettingForm.Create(Application);
   SettingForm.HostEdit.Text:=trim(ClientSocket1.Host);
   SettingForm.NickNameEdit.Text:=trim(NickName);
   if SettingForm.ShowModal=mrOk then
   begin
      if Pos('.',SettingForm.HostEdit.Text) = 0 then
         ClientSocket1.Host:=SettingForm.HostEdit.Text
      else
         ClientSocket1.Address:=trim(SettingForm.HostEdit.Text);
      NickName:=SettingForm.NickNameEdit.Text;
      EnableClient;
   end;
   SettingForm.Close;
end;

procedure TChatClient.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
   MsgToSend:string;
begin
   if OutSocket<>nil then
     if Key=VK_RETURN then
     begin
       //消息Rain_MSG:
       MsgToSend:='Rain_MSG:'+Memo1.Lines[Memo1.Lines.Count - 1];
       OutSocket.SendText(MsgToSend);
       Key:=0;
     end;
end;

procedure TChatClient.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  sendstring:AnsiString;
begin
  StatusBar1.Panels[0].Text:='连接到服务器...';
  OutSocket:=Socket;
  sendstring:=NickName+'\n';
  Socket.SendText(sendstring);
  Memo1.ReadOnly:=(OutSocket=nil);
end;

procedure TChatClient.DisableClient;
begin
   OutSocket:=nil;
   ClientConnected:=False;
   clientSocket1.Close;
end;
procedure TChatClient.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   DisableClient;
end;

procedure TChatClient.ClientSocket1Connecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Statusbar1.Panels[0].Text:='正在连接服务器...';
end;

procedure TChatClient.ClientSocket1Lookup(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   Statusbar1.Panels[0].Text:='正在寻找服务器...';
end;

procedure TChatClient.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  Statusbar1.Panels[0].Text:='错误代码为:'+IntToStr(Errorcode);
  ShowMessage('Socket错误:'+IntToStr(ErrorCode));
  ErrorCode:=0;
  DisableClient;
end;

procedure TChatClient.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
   FindHandle,ResHandle:THandle;
   ResPtr:Pointer;
   TmpStr:string;
   Flag:String;
begin
  if chatclient.Visible = False then
      ChatClient.Visible := True;
  ChatClient.BringToFront;
  Statusbar1.Panels[0].Text:='正在从服务器中读取数据...';
//铃声
 if CanSound.Checked then
 begin
  FindHandle:=FindResource(HInstance,'ID_RING','WAVE');
  if FindHandle<>0 then
  begin
    ResHandle:=LoadResource(HInstance,FindHandle);
    if ResHandle<>0 then
    begin
      ResPtr:=LockResource(ResHandle);
      if ResPtr<>nil then
        sndPlaySound(PChar(ResPtr),SND_ASYNC OR SND_MEMORY);
      UnLockResource(ResHandle);
    end;
    FreeResource(FindHandle);
  end;
 end;
  TmpStr:=Socket.ReceiveText;
  Flag:=Copy(TmpStr,1,12);
  if Flag = 'Rain_Update:' then
  begin