|
|
unit u_chat_server;
|
|
|
|
|
|
interface
|
|
|
|
|
|
uses
|
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
|
ExtCtrls, StdCtrls, WinSock, ScktComp, ComCtrls, OleCtrls, ShellApi,
|
|
|
IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IdSocketHandle,
|
|
|
IdUDPClient, AppEvnts, bsSkinData, BusinessSkinForm, DB, ADODB,
|
|
|
bsSkinTabs, bsSkinCtrls, dxExEdtr, dxCntner, dxTL, dxDBCtrl, dxDBGrid,
|
|
|
dxDBTLCl, dxGrClms;
|
|
|
|
|
|
const
|
|
|
SERVER_TRAY_MESSAGE = WM_USER + 100;
|
|
|
|
|
|
type
|
|
|
Tfrm_chat_server = class(TForm)
|
|
|
db: TADOConnection;
|
|
|
bsBusinessSkinForm1: TbsBusinessSkinForm;
|
|
|
bsSkinData1: TbsSkinData;
|
|
|
bsStoredSkin1: TbsStoredSkin;
|
|
|
UDPServer: TIdUDPServer;
|
|
|
UDPClient: TIdUDPClient;
|
|
|
ApplicationEvents: TApplicationEvents;
|
|
|
bsSkinPageControl1: TbsSkinPageControl;
|
|
|
bsSkinTabSheet1: TbsSkinTabSheet;
|
|
|
bsSkinTabSheet2: TbsSkinTabSheet;
|
|
|
bsSkinPanel1: TbsSkinPanel;
|
|
|
MemoMsg: TMemo;
|
|
|
bsSkinPanel2: TbsSkinPanel;
|
|
|
ServerStatusLabel: TLabel;
|
|
|
ClientCountLabel: TLabel;
|
|
|
ListBox1: TListBox;
|
|
|
t_sys_information: TADOQuery;
|
|
|
t_sys_information1: TDataSource;
|
|
|
dxDBGrid1: TdxDBGrid;
|
|
|
dxDBGrid1Column1: TdxDBGridMaskColumn;
|
|
|
dxDBGrid1Column2: TdxDBGridMaskColumn;
|
|
|
dxDBGrid1Column3: TdxDBGridMaskColumn;
|
|
|
dxDBGrid1Column4: TdxDBGridMaskColumn;
|
|
|
dxDBGrid1Column5: TdxDBGridDateColumn;
|
|
|
dxDBGrid1Column6: TdxDBGridMemoColumn;
|
|
|
procedure FormCreate(Sender: TObject);
|
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
|
procedure FormDestroy(Sender: TObject);
|
|
|
procedure UDPServerUDPRead(Sender: TObject; AData: TStream;
|
|
|
ABinding: TIdSocketHandle);
|
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
|
procedure ApplicationEventsMinimize(Sender: TObject);
|
|
|
private
|
|
|
FClientDataList: TList;
|
|
|
FClientID: Integer;
|
|
|
FClientCount: Integer;
|
|
|
FConnected: Boolean;
|
|
|
FReceiveStream: TMemoryStream;
|
|
|
FSendStream: TMemoryStream;
|
|
|
ServerTrayIconData : TNotifyIconData;
|
|
|
|
|
|
procedure ServerTrayMessage(var Message: TMessage); message SERVER_TRAY_MESSAGE;
|
|
|
procedure ClientConnect(ABinding: TIdSocketHandle);
|
|
|
procedure ClientReceive(Data: TMemoryStream; ABinding: TIdSocketHandle);
|
|
|
procedure ClientChat(Data: TMemoryStream; ABinding: TIdSocketHandle);
|
|
|
procedure ClientLogout(Data: TMemoryStream; ABinding: TIdSocketHandle);
|
|
|
procedure ShowClientCount;
|
|
|
{ Private declarations }
|
|
|
public
|
|
|
{ Public declarations }
|
|
|
end;
|
|
|
|
|
|
var
|
|
|
frm_chat_server: Tfrm_chat_server;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
uses
|
|
|
xBASE;
|
|
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
procedure Tfrm_chat_server.ClientChat(Data: TMemoryStream; ABinding: TIdSocketHandle);
|
|
|
var
|
|
|
AClientData: TxClientData;
|
|
|
Vi, VCount: Integer;
|
|
|
begin
|
|
|
Data.Seek(SizeOf(AClientData), soFromCurrent);
|
|
|
Data.Read(AClientData, SizeOf(AClientData));
|
|
|
VCount := FClientCount - 1;
|
|
|
for Vi := 0 to VCount do
|
|
|
begin
|
|
|
if AClientData.ClientID = PxClientData(FClientDataList.Items[Vi])^.ClientID then
|
|
|
begin
|
|
|
UDPClient.SendBuffer(PxClientData(FClientDataList.Items[Vi])^.IPAddress, UDPClientServerPort, Data.Memory^, Data.Size);
|
|
|
Break;
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.ShowClientCount;
|
|
|
begin
|
|
|
ClientCountLabel.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD>û<EFBFBD><C3BB><EFBFBD> ' + IntToStr(FClientCount);
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.ClientConnect(ABinding: TIdSocketHandle);
|
|
|
begin
|
|
|
FSendStream.Clear;
|
|
|
MessageID := xMIDConnectS;
|
|
|
FSendStream.Write(MessageID, SizeOf(MessageID));
|
|
|
UDPClient.SendBuffer(ABinding.PeerIP, UDPClientServerPort, FSendStream.Memory^, FSendStream.Size);
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.ClientReceive(Data: TMemoryStream;
|
|
|
ABinding: TIdSocketHandle);
|
|
|
var
|
|
|
AClientData: PxClientData;
|
|
|
Vi: Integer;
|
|
|
begin
|
|
|
New(AClientData);
|
|
|
Data.Read(AClientData^, SizeOf(TxClientData));
|
|
|
for Vi := 0 to FClientCount - 1 do
|
|
|
if AClientData^.IPAddress = PxClientData(FClientDataList.Items[Vi])^.IPAddress then Exit;
|
|
|
|
|
|
Inc(FClientCount);
|
|
|
AClientData^.ClientID := FClientID;
|
|
|
Inc(FClientID);
|
|
|
FClientDataList.Add(AClientData);
|
|
|
|
|
|
FSendStream.Clear;
|
|
|
MessageID := xMIDClientData;
|
|
|
FSendStream.Write(MessageID, SizeOf(MessageID));
|
|
|
FSendStream.Write(AClientData^, SizeOf(TxClientData));
|
|
|
for Vi := 0 to FClientCount - 2 do
|
|
|
UDPClient.SendBuffer((PxClientData(FClientDataList.Items[Vi])^.IPAddress), UDPClientServerPort, FSendStream.Memory^, FSendStream.Size);
|
|
|
|
|
|
FSendStream.Clear;
|
|
|
MessageID := xMIDClientDataS;
|
|
|
FSendStream.Write(MessageID, SizeOf(MessageID));
|
|
|
FSendStream.Write(FClientCount, SizeOf(FClientCount));
|
|
|
for Vi := 0 to FClientCount - 1 do
|
|
|
FSendStream.Write((FClientDataList.Items[Vi])^, SizeOf(TxClientData));
|
|
|
UDPClient.SendBuffer(ABinding.PeerIP, UDPClientServerPort , FSendStream.Memory^, FSendStream.Size);
|
|
|
|
|
|
ShowClientCount;
|
|
|
if MemoMsg.Lines.Count > 1024 then MemoMsg.Clear;
|
|
|
MemoMsg.Lines.Add(AClientData.NickName + ' <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ' + AClientData.IPAddress + ' <20>Ѿ<EFBFBD><D1BE><EFBFBD>¼');
|
|
|
ListBox1.Items.Add(AClientData.NickName);
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.ClientLogout(Data: TMemoryStream; ABinding: TIdSocketHandle);
|
|
|
var
|
|
|
Vi, Vj, VCount,i,j: Integer;
|
|
|
AClientData: TxClientData;
|
|
|
begin
|
|
|
Data.Read(AClientData, SizeOf(TxClientData));
|
|
|
VCount := FClientCount - 1;
|
|
|
for Vi := 0 to VCount do
|
|
|
begin
|
|
|
if AClientData.ClientID = PxClientData(FClientDataList.Items[Vi])^.ClientID then
|
|
|
begin
|
|
|
FSendStream.Clear;
|
|
|
MessageID := xMIDClientLogout;
|
|
|
FSendStream.Write(MessageID, SizeOf(MessageID));
|
|
|
FSendStream.Write((FClientDataList.Items[Vi])^, SizeOf(TxClientData));
|
|
|
for Vj := 0 to VCount do
|
|
|
begin
|
|
|
if Vj <> Vi then
|
|
|
UDPClient.SendBuffer((PxClientData(FClientDataList.Items[Vj])^.IPAddress), UDPClientServerPort, FSendStream.Memory^, FSendStream.Size);
|
|
|
end;
|
|
|
FClientDataList.Remove(FClientDataList.Items[Vi]);
|
|
|
Dec(FClientCount);
|
|
|
ShowClientCount;
|
|
|
if MemoMsg.Lines.Count > 1024 then MemoMsg.Clear;
|
|
|
MemoMsg.Lines.Add(AClientData.NickName + ' <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ' + AClientData.IPAddress + ' <20>Ѿ<EFBFBD><D1BE>Ͽ<EFBFBD>');
|
|
|
j:=-1;
|
|
|
for i:=0 to ListBox1.Items.Count-1 do
|
|
|
begin
|
|
|
if AClientData.NickName=ListBox1.Items[i] then
|
|
|
begin
|
|
|
j:=ListBox1.ItemIndex;
|
|
|
end;
|
|
|
end;
|
|
|
if j<>-1 then
|
|
|
begin
|
|
|
ListBox1.Items.Delete(j);
|
|
|
end;
|
|
|
Break;
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.ServerTrayMessage(var Message: TMessage);
|
|
|
begin
|
|
|
if Message.Msg = SERVER_TRAY_MESSAGE then
|
|
|
begin
|
|
|
case Message.LParam of
|
|
|
WM_LBUTTONDBLCLK:
|
|
|
begin
|
|
|
if IsIconic(Application.Handle) then begin
|
|
|
ShowWindow(Application.Handle, SW_NORMAL);
|
|
|
SetForegroundWindow(Application.Handle);
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.FormCreate(Sender: TObject);
|
|
|
begin
|
|
|
FClientDataList := TList.Create;
|
|
|
FClientID := 40000;
|
|
|
FClientCount := 0;
|
|
|
FConnected := False;
|
|
|
FSendStream := TMemoryStream.Create;
|
|
|
FReceiveStream := TMemoryStream.Create;
|
|
|
FClientCount := 0;
|
|
|
FConnected := True;
|
|
|
ShowClientCount;
|
|
|
UDPServer.Active := True;
|
|
|
UDPClientServerPort := 8401;
|
|
|
UDPServerPort := 8400;
|
|
|
ServerStatusLabel.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ѿ<EFBFBD><D1BE><EFBFBD><EFBFBD><EFBFBD>';
|
|
|
{ <20><><EFBFBD><EFBFBD> }
|
|
|
ServerTrayIconData.cbSize := SizeOf(ServerTrayIconData);
|
|
|
ServerTrayIconData.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
|
|
|
ServerTrayIconData.uID := UINT(Self);
|
|
|
ServerTrayIconData.Wnd := Handle;
|
|
|
ServerTrayIconData.hIcon := Application.Icon.Handle;
|
|
|
ServerTrayIconData.szTip := '<27>κ<EFBFBD><CEBA><EFBFBD>ϵͳ<CFB5><CDB3>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
|
|
|
ServerTrayIconData.uCallbackMessage := SERVER_TRAY_MESSAGE;
|
|
|
Shell_NotifyIcon(NIM_ADD, @ServerTrayIconData);
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.FormClose(Sender: TObject;
|
|
|
var Action: TCloseAction);
|
|
|
begin
|
|
|
FSendStream.Clear;
|
|
|
MessageID := xMIDServerExit;
|
|
|
FSendStream.Write(MessageID, SizeOf(MessageID));
|
|
|
UDPClient.SendBuffer(BROADCAST_ADDRESS, UDPClientServerPort, FSendStream.Memory^, FSendStream.Size);
|
|
|
Shell_NotifyIcon(NIM_DELETE, @ServerTrayIconData);
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.FormDestroy(Sender: TObject);
|
|
|
begin
|
|
|
FReceiveStream.Free;
|
|
|
FSendStream.Free;
|
|
|
FClientDataList.Free;
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.UDPServerUDPRead(Sender: TObject;
|
|
|
AData: TStream; ABinding: TIdSocketHandle);
|
|
|
begin
|
|
|
FReceiveStream.Clear;
|
|
|
FReceiveStream.LoadFromStream(AData);
|
|
|
FReceiveStream.Read(MessageID, SizeOf(MessageID));
|
|
|
|
|
|
case MessageID of
|
|
|
xMIDConnect:
|
|
|
begin
|
|
|
ClientConnect(ABinding);
|
|
|
end;
|
|
|
xMIDClientData:
|
|
|
begin
|
|
|
ClientReceive(FReceiveStream, ABinding);
|
|
|
end;
|
|
|
xMIDChat:
|
|
|
begin
|
|
|
ClientChat(FReceiveStream, ABinding);
|
|
|
end;
|
|
|
xMIDClientLogout:
|
|
|
begin
|
|
|
ClientLogout(FReceiveStream, ABinding);
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.FormCloseQuery(Sender: TObject;
|
|
|
var CanClose: Boolean);
|
|
|
begin
|
|
|
if FClientDataList.Count > 0 then
|
|
|
CanClose:=false;
|
|
|
end;
|
|
|
|
|
|
procedure Tfrm_chat_server.ApplicationEventsMinimize(Sender: TObject);
|
|
|
begin
|
|
|
ShowWindow(Application.Handle, SW_HIDE);
|
|
|
end;
|
|
|
|
|
|
end.
|