mainfrm.pas

工廠採購管理系統

unit MainFrm;

{=======================================================
  项目:  ZhaoSoft 短信服务器
  模块:  主窗口
  描述:
  版本:  1.0
  日期:  2005-02-27
  作者:  zjwen
  更新:  
=======================================================}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, WinSock, ScktComp, ComCtrls,// OleCtrls, 
  IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IdSocketHandle,
  IdUDPClient, Buttons;

type
  TChatInfo = class(TForm)
    BottomBevel: TBevel;
    ShapeTitle: TShape;
    UDPServer: TIdUDPServer;
    MemoMsg: TMemo;
    UDPClient: TIdUDPClient;
    ClientCountLabel: TLabel;
    btnReset: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure UDPServerUDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MemoMsgDblClick(Sender: TObject);
    procedure btnResetClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    FClientDataList: TList;
    FClientID: Integer;
    FClientCount: Integer;
    FConnected: Boolean;
    FReceiveStream: TMemoryStream;
    FSendStream: TMemoryStream;

    procedure ClientConnect(ABinding: TIdSocketHandle);
    procedure ClientReceive(Data: TMemoryStream; ABinding: TIdSocketHandle);
    procedure ClientChat(Data: TMemoryStream; ABinding: TIdSocketHandle);
    procedure ClientLogout(Data: TMemoryStream; ABinding: TIdSocketHandle);
    procedure ShowClientCount;
  end;

var
  ChatInfo: TChatInfo;

implementation

uses
  xBASE;

{$R *.DFM}

{============================================================}

procedure TChatInfo.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 := 8848;
  UDPServerPort := 8849;
end;


{============================================================}

procedure TChatInfo.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 TChatInfo.ShowClientCount;
begin
  ClientCountLabel.Caption :=  '在线用户：  ' + IntToStr(FClientCount);
end;

{============================================================}

procedure TChatInfo.FormDestroy(Sender: TObject);
begin
  while FClientDataList.Count > 0 do
    FClientDataList.Remove(FClientDataList.Last);

  FReceiveStream.Free;
  FSendStream.Free;
  FClientDataList.Free;
end;

{============================================================}

procedure TChatInfo.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 TChatInfo.ClientConnect(ABinding: TIdSocketHandle);
begin
  FSendStream.Clear;
  MessageID := xMIDConnectS;
  FSendStream.Write(MessageID, SizeOf(MessageID));
  UDPClient.SendBuffer(ABinding.PeerIP, UDPClientServerPort, FSendStream.Memory^, FSendStream.Size);
end;

{============================================================}

procedure TChatInfo.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 + ' 来自于 ' + AClientData.IPAddress + ' 已经登录');
end;

{============================================================}

procedure TChatInfo.ClientLogout(Data: TMemoryStream; ABinding: TIdSocketHandle);
var
  Vi, Vj, VCount: 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 + ' 来自于 ' + AClientData.IPAddress + ' 已经断开');
      Break;
    end;
  end;
end;

{============================================================}

procedure TChatInfo.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Vi, VCount: Integer;
begin
  FSendStream.Clear;
  MessageID := xMIDServerExit;
  FSendStream.Write(MessageID, SizeOf(MessageID));
  VCount := FClientCount - 1;
  for Vi := 0 to VCount do
    UDPClient.SendBuffer(PxClientData(FClientDataList.Items[Vi])^.IPAddress, UDPClientServerPort, FSendStream.Memory^, FSendStream.Size);
end;

{============================================================}

procedure TChatInfo.MemoMsgDblClick(Sender: TObject);
begin
  MemoMsg.Clear;
end;

procedure TChatInfo.btnResetClick(Sender: TObject);
begin
  while FClientDataList.Count > 0 do
    FClientDataList.Remove(FClientDataList.Last);

  FReceiveStream.Free;
  FSendStream.Free;
  FClientDataList.Free;

  FClientDataList := TList.Create;
  FClientID := 40000;
  FClientCount := 0;
  FSendStream := TMemoryStream.Create;
  FReceiveStream := TMemoryStream.Create;
  FClientCount := 0;
  FConnected := True;
  ShowClientCount;
  UDPServer.Active := True;
  UDPClientServerPort := 8401;
  UDPServerPort := 8400;
end;

procedure TChatInfo.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canclose:=false;
hide;
end;

end.