unit ChatServerUnit;

interface

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

type
  PClientRecord = ^ClientRecord;

  ClientRecord = record
    UserId: string[100];
    UserNick: string[100];
    Error: integer;
  end;

  TChatServerMFrm = class(TForm)
    BasePanel: TPanel;
    ChatMsg: TRichEdit;
    LeftPanel: TPanel;
    MsgPanel: TPanel;
    UserList: TListBox;
    TopPanel: TPanel;
    ServerPort: TLabeledEdit;
    BtnStart: TBitBtn;
    BtnStop: TBitBtn;
    ServerSocket: TServerSocket;
    NumClient: TStaticText;
    ClientText: TStaticText;
    Panel1: TPanel;
    Panel2: TPanel;
    Edit1: TEdit;
    procedure BtnStartClick(Sender: TObject);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure FormCreate(Sender: TObject);
    procedure BtnStopClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ClientList: TList;
    procedure BroadCast(BroadMsg: string);
    procedure BroadCastExceptOne(BroadMsg: string; ExceptId: string);
  end;

var
  ChatServerMFrm: TChatServerMFrm;

implementation

{$R *.dfm}

// returns ISP assigned IP
function LocalIP : string;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array [0..63] of char;
  I: integer;
  GInitData: TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe :=GetHostByName(buffer);
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do begin
    result:=StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

procedure TChatServerMFrm.BtnStartClick(Sender: TObject);
begin
  if ServerPort.Text = '' then begin
    MessageDlg('포트정보가 없습니다.'#13#13'접속할 서버의 포트번호를 입력하세요', mtWarning, [mbOK], 0);
    ServerPort.SetFocus;
    Exit;
  end;

  ServerSocket.Port := StrToInt(ServerPort.Text);
  ServerSocket.Active := true;

  BtnStart.Enabled := False;
  BtnStop.Enabled := True;
end;

procedure TChatServerMFrm.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ClientData: PClientRecord;
begin
  GetMem(ClientData, Sizeof(ClientRecord));
  Socket.Data := ClientData;
  ClientData^.UserId := '';
  ClientData^.UserNick := '';
  ClientData^.Error := 0;
  NumClient.Caption := IntToStr(StrToInt(NumClient.Caption)+1);
end;

procedure TChatServerMFrm.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ClientData: PClientRecord;
  i: integer;
begin
  NumClient.Caption := IntToStr(StrToInt(NumClient.Caption)-1);
  ClientData := PClientRecord(Socket.Data);
  ClientData.Error := 1;

  BroadCastExceptOne('DISC|'+ClientData^.UserId, ClientData^.UserId);

  for i:=0 to UserList.Items.Count-1 do begin
    if (LeftStr(UserList.Items[i], Pos('[',UserList.Items[i])-1)) = ClientData^.UserId then
    begin
      UserList.Items.Delete(i);
      break;
    end;
  end;
  
  FreeMem(PClientRecord(Socket.Data));
end;

procedure TChatServerMFrm.BroadCast(BroadMsg: string);
var
  i: integer;
begin
  for i:=0 to ServerSocket.Socket.ActiveConnections-1 do
  begin
    if PClientRecord(ServerSocket.Socket.Connections[i].Data).Error <>1 then
    begin
      ServerSocket.Socket.Connections[i].SendText(BroadMsg+#10);
    end;
  end;
end;

procedure TChatServerMFrm.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  RevMsg: string;
  Packet, PacketDetail: TStringList;
  i, j: integer;
  tmpClientData: PClientRecord;
begin
  RevMsg := Socket.ReceiveText;

  Packet := TStringList.Create;
  PacketDetail := TStringList.Create;

  try
    Packet.Clear;
    ExtractStrings([#10], [' '], PChar(RevMsg), Packet);

    for i:=0 to Packet.Count-1 do
    begin
      ChatMsg.Lines.Add(Packet.Strings[i]);
      PacketDetail.Clear;
      ExtractStrings(['|'], [' '], PChar(Packet.Strings[i]), PacketDetail );

      // CONN 패킷
      if PacketDetail.Strings[0] = 'CONN' then
      begin
        for j:=0 to ServerSocket.Socket.ActiveConnections-2 do begin
          tmpClientData := PClientRecord(ServerSocket.Socket.Connections[j].Data);
          
          if (tmpClientData^.UserId = PacketDetail[1]) then begin   // id 중복검사
            Socket.SendText('SYSM|'+PacketDetail[1]+'는 이미 존재하는 아이디입니다.');
            Socket.Close;
            Exit;
          end;
          Socket.SendText('MEMB|'+tmpClientData^.UserId+'|'+tmpClientData^.UserNick+#10);
        end;

        UserList.Items.Add(PacketDetail.Strings[1]+'['+PacketDetail.Strings[2]+']');

        BroadCast(Packet.Strings[i]);
        (PClientRecord(Socket.Data)).UserId := PacketDetail.Strings[2];
        (PClientRecord(Socket.Data)).UserNick := PacketDetail.Strings[1];
      end;

      // MESG 패킷
      if PacketDetail.Strings[0] = 'MESG' then
      begin
        BroadCast(Packet.Strings[i]);
      end;

      // WHIS 패킷
      if PacketDetail.Strings[0] = 'WHSP' then
      begin
        for j:=0 to ServerSocket.Socket.ActiveConnections-1 do
          if (PClientRecord(ServerSocket.Socket.Connections[j].Data)^.UserId = PacketDetail[1]) or (PClientRecord(ServerSocket.Socket.Connections[j].Data)^.UserId = PacketDetail[2]) then
            ServerSocket.Socket.Connections[j].SendText(Packet.Strings[i]+#10);
      end;

      // NICK 패킷
      if PacketDetail.Strings[0] = 'NICK' then
      begin
        BroadCast(Packet.Strings[i]);

        for j:=0 to UserList.Items.Count-1 do begin
          if (LeftStr(UserList.Items[j], Pos('[',UserList.Items[j])-1)) = PacketDetail[1] then
          begin
            UserList.Items[j] := PacketDetail[1]+'['+PacketDetail[2]+']';
            break;
          end;
        end;
      end;
    end;
  finally
    Packet.Free;
    PacketDetail.Free;
  end;
end;

procedure TChatServerMFrm.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  Socket.Close;
  ErrorCode := 0;
end;

procedure TChatServerMFrm.FormCreate(Sender: TObject);
begin
  Edit1.Text := LocalIp;
end;

procedure TChatServerMFrm.BtnStopClick(Sender: TObject);
begin
  ServerSocket.Active := False;
  UserList.Clear;
  
  BtnStart.Enabled := True;
  BtnStop.Enabled := False;
end;

procedure TChatServerMFrm.BroadCastExceptOne(BroadMsg, ExceptId: string);
var
  i: integer;
begin
  for i:=0 to ServerSocket.Socket.ActiveConnections-1 do
  begin
    if (PClientRecord(ServerSocket.Socket.Connections[i].Data).Error <> 1) and (PClientRecord(ServerSocket.Socket.Connections[i].Data).UserId <> ExceptId) then
    begin
      ServerSocket.Socket.Connections[i].SendText(BroadMsg+#10);
    end;
  end;

end;

end.

-참고-
**글구 혹시 델파이 소스를 c++소스로 변환해주는 툴은 없는지요?...**