userver.pas

一个使用UDP开发的消息广播服务与客户端程序

unit Userver;
{
    即时网络通讯软件Main服务器
}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms,Winsock, Dialogs, StdCtrls, ExtCtrls,
  ComCtrls,TypeInc, ScktComp;

type
  TfrmServer = class(TForm)
    GroupBox1: TGroupBox;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    GroupBox2: TGroupBox;
    LabeledEdit6: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    LabeledEdit7: TLabeledEdit;
    LabeledEdit8: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit5: TLabeledEdit;
    LabeledEdit9: TLabeledEdit;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    UDPMemo: TMemo;
    SServer: TServerSocket;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Button5: TButton;
    SClient: TClientSocket;
    Button6: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SServerAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure SServerClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SServerClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SServerClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure SServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button3Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    procedure upShowDate();
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmServer: TfrmServer;

implementation

uses Udm;

{$R *.dfm}

const
  HOSTNAMELENGTH = 80;
function GetIPFromName(Name: string): string;
//其的IP地址
var
  WSAData: TWSAData;
  HostEnt: PHostEnt;
begin
  WSAStartup(2, WSAData);
  HostEnt := gethostbyname(PChar(Name));
  with HostEnt^ do
    Result := Format('%d.%d.%d.%d', [Byte(h_addr^[0]),
      Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
  WSACleanup;
end;

procedure TfrmServer.SServerClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  p:pchar;
  length:longint;
  Count,i:Integer;
  //Bufmsg:^TM_ServLogin;
begin
    p:=nil;
    while socket.ReceiveLength>0 do begin
        length:=socket.receivelength;
        //GetMem(Bufmsg,length);
        Getmem(p,length);
        TRY
            socket.ReceiveBuf(p^,socket.receivelength);
            Count:=SServer.Socket.ActiveConnections;
            for i:=0 to Count-1 do
                SServer.Socket.Connections[i].SendBuf(p^,length);
            UDPMemo.Lines.Add(p);
        FINALLY
            FreeMem(p);
        END;
    end;

end;

procedure TfrmServer.FormCreate(Sender: TObject);
begin

    self.Top:=(screen.Height-self.Height) div 2;
    self.Left:=(screen.Width-self.Width) div 2;
    Button1Click(Sender);
end;
procedure TfrmServer.upShowDate();
var
    D_Info:TM_DBINFO;
    rs:integer;
begin
    //检查数据库信息
    //rs:=DMServer.CM_GetDbInfo(D_Info);
    //LabeledEdit6.Text:=inttostr(D_Info.Server);
    //LabeledEdit4.text:=inttostr(D_Info.RegSrv);
    //LabeledEdit7.Text:=inttostr(D_Info.Online);
    //LabeledEdit8.Text:=inttostr(D_Info.RegOline);
    StatusBar1.Panels[0].Text:='服务器时间：'+DateTimeToStr(Now);
end;

procedure TfrmServer.Button2Click(Sender: TObject);
begin
    Close();
end;

procedure TfrmServer.Timer1Timer(Sender: TObject);
begin
    StatusBar1.Panels[0].Text:='服务器时间：'+DateTimeToStr(Now);
end;

procedure TfrmServer.SServerAccept(Sender: TObject;
  Socket: TCustomWinSocket);
var
  Tempstr:pchar;
begin
    //向客户端发送连接到服务器的信息
    TempStr:=pchar('欢迎使用测试服务器    '#13#10);
    socket.SendText(TempStr);
    TempStr:=pchar('#######################################'#13#10);
    socket.SendText(TempStr);
    TempStr:=pchar('All your words will be sent to all online people'#13#10);
    socket.SendText(TempStr+#10+#13);

end;

procedure TfrmServer.SServerClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  UDPMemo.lines.add('SocketHandle:'#9+Inttostr(Socket.SocketHandle));
  UDPMemo.lines.add('    IP  地址:'#9+Socket.RemoteAddress);
  socket.SendText(pchar('您的IP地址为：'#9+Socket.RemoteAddress+#10#13#10#13));
end;

procedure TfrmServer.SServerClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
//客户端断开

begin
    UDPMemo.Lines.add('Usr Offline');
    UDPMemo.Lines.add('SocketID:'+Inttostr(Socket.SocketHandle));
end;

procedure TfrmServer.SServerClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
//Error Conditions
    Case ErrorCode Of
        10054:UDPMemo.lines.add('one connection is reset by remote side.');
    Else
        UDPMemo.Lines.Add('Error Happen, Error Code:'+InttoStr(errorCode));
    end;
    ErrorCode:=0;
end;

procedure TfrmServer.Button3Click(Sender: TObject);
var
  i:integer;
  Count:Integer;
begin
    if SServer.Active=False then exit;
    Count:=SServer.Socket.ActiveConnections;
    if Count=0 then
    begin
         UDPMemo.Lines.Add('无用户连接至服务器！');
         exit;
    end;
    for i:=0 to Count-1 do
      SServer.Socket.Connections[i].SendText('服务器广播：'+Edit1.Text+#10+#13);

end;

procedure TfrmServer.FormDestroy(Sender: TObject);
var
  i:integer;
  Count:Integer;
begin
    Count:=SServer.Socket.ActiveConnections;
    for i:=0 to Count-1 do
      SServer.Socket.Connections[i].SendText('Server is closed'+#10+#13);

end;

procedure TfrmServer.Button4Click(Sender: TObject);
//断开所有连接
var
  i:integer;
  Count:Integer;
begin
    if SServer.Active=False then exit;
    Count:=SServer.Socket.ActiveConnections;
    for i:=0 to Count-1 do
      SServer.Socket.Connections[i].Close;
    UDPMemo.Lines.Add('断开所有用户连接');
end;

procedure TfrmServer.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
  begin
    Button3Click(Sender);
    //CClient.Socket.SendText(Edit1.Text);
    Edit1.SelectAll;
    key:=#0;
  end;
end;

procedure TfrmServer.Button1Click(Sender: TObject);
begin
    if SServer.Active=True then exit;
    try
        //初始化连接
        SServer.Active:=True;
        LabeledEdit9.Text :=SServer.Socket.LocalHost;
        LabeledEdit1.Text:=GetIPFromName(SServer.Socket.LocalHost);
        LabeledEdit2.Text :=inttostr(SServer.Port);
        upShowDate;
        UDPMemo.Lines.Add('测试服务器已经启动');
    except
        //
    end;
end;

procedure TfrmServer.Button5Click(Sender: TObject);
begin
    if SServer.Active=False then exit;
    SServer.Active:=False;
    UDPMemo.Lines.Add('测试服务器已经关闭');
end;

procedure TfrmServer.Button6Click(Sender: TObject);
begin
    UDPMemo.Lines.Clear;
end;

end.