?? clientunit.pas
字號:
//==================================================================//
//多用戶語音聊天客戶端
//發送格式:正文消息 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -