idircserver.pas

Indy控件的使用源代码

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10229: IdIrcServer.pas 
{
{   Rev 1.0    2002.11.12 10:43:48 PM  czhower
}
unit IdIrcServer;

interface

{
2000-15-May:  Renamed events to Id Prefix
2000-22-Apr: J Peter Mugass
  -Ported to Indy
2000-13-Jan MTL
  -Moved to new Palette Scheme (Winshoes Servers)
1999-13-Apr
  -Final Version
Original Author: Ozz Nixon
  -RFC 1459 - Internet Relay Chat
}

uses
  Classes,
  IdAssignedNumbers,
  IdTCPServer;

Const
   KnownCommands:Array [1..40] of string=
      (
       'ADMIN',    {Do not Localize}
       'AWAY',    {Do not Localize}
       'CONNECT',    {Do not Localize}
       'ERROR',    {Do not Localize}
       'INFO',    {Do not Localize}
       'INVITE',    {Do not Localize}
       'ISON',    {Do not Localize}
       'JOIN',    {Do not Localize}
       'KICK',    {Do not Localize}
       'KILL',    {Do not Localize}
       'LINKS',    {Do not Localize}
       'LIST',    {Do not Localize}
       'MODE',    {Do not Localize}
       'NAMES',    {Do not Localize}
       'NICK',    {Do not Localize}
       'NOTICE',    {Do not Localize}
       'OPER',    {Do not Localize}
       'PART',    {Do not Localize}
       'PASS',    {Do not Localize}
       'PING',    {Do not Localize}
       'PONG',    {Do not Localize}
       'PRIVMSG',    {Do not Localize}
       'QUIT',    {Do not Localize}
       'REHASH',    {Do not Localize}
       'RESTART',    {Do not Localize}
       'SERVER',    {Do not Localize}
       'SQUIT',    {Do not Localize}
       'STATS',    {Do not Localize}
       'SUMMON',    {Do not Localize}
       'TIME',    {Do not Localize}
       'TOPIC',    {Do not Localize}
       'TRACE',    {Do not Localize}
       'USER',    {Do not Localize}
       'USERHOST',    {Do not Localize}
       'USERS',    {Do not Localize}
       'VERSION',    {Do not Localize}
       'WALLOPS',    {Do not Localize}
       'WHO',    {Do not Localize}
       'WHOIS',    {Do not Localize}
       'WHOWAS'    {Do not Localize}
       );

Type
  TIdIrcGetEvent = procedure ( Thread: TIdPeerThread) of object;
  TIdIrcOtherEvent = procedure ( Thread: TIdPeerThread; Command, Parm : String) of object;
  TIdIrcOneParmEvent = procedure (Thread: TIdPeerThread; Parm : String) of object;
  TIdIrcTwoParmEvent = procedure (Thread: TIdPeerThread; Parm1, Parm2 : String) of object;
  TIdIrcThreeParmEvent = procedure (Thread: TIdPeerThread; Parm1, Parm2, Parm3 : String) of object;
  TIdIrcFiveParmEvent = procedure (Thread: TIdPeerThread; Parm1, Parm2, Parm3, Parm4, Parm5 : String) of object;
  TIdIrcUserEvent = procedure ( Thread: TIdPeerThread; UserName, HostName, ServerName, RealName : String) of object;
  TIdIrcServerEvent = procedure ( Thread: TIdPeerThread; ServerName, Hopcount, Info : String) of object;

  TIdIRCServer = class( TIdTCPServer )
  protected
    fOnCommandOther : TIdIrcOtherEvent;
    fOnCommandPass : TIdIrcOneParmEvent;
    fOnCommandNick : TIdIrcTwoParmEvent;
    fOnCommandUser : TIdIrcUserEvent;
    fOnCommandServer : TIdIrcServerEvent;
    fOnCommandOper : TIdIrcTwoParmEvent;
    fOnCommandQuit : TIdIrcOneParmEvent;
    fOnCommandSQuit : TIdIrcTwoParmEvent;
    fOnCommandJoin : TIdIrcTwoParmEvent;
    fOnCommandPart : TIdIrcOneParmEvent;
    fOnCommandMode : TIdIrcFiveParmEvent;
    fOnCommandTopic : TIdIrcTwoParmEvent;
    fOnCommandNames : TIdIrcOneParmEvent;
    fOnCommandList : TIdIrcTwoParmEvent;
    fOnCommandInvite : TIdIrcTwoParmEvent;
    fOnCommandKick : TIdIrcThreeParmEvent;
    fOnCommandVersion : TIdIrcOneParmEvent;
    fOnCommandStats : TIdIrcTwoParmEvent;
    fOnCommandLinks : TIdIrcTwoParmEvent;
    fOnCommandTime : TIdIrcOneParmEvent;
    fOnCommandConnect : TIdIrcThreeParmEvent;
    fOnCommandTrace : TIdIrcOneParmEvent;
    fOnCommandAdmin : TIdIrcOneParmEvent;
    fOnCommandInfo : TIdIrcOneParmEvent;
    fOnCommandPrivMsg : TIdIrcTwoParmEvent;
    fOnCommandNotice : TIdIrcTwoParmEvent;
    fOnCommandWho : TIdIrcTwoParmEvent;
    fOnCommandWhoIs : TIdIrcTwoParmEvent;
    fOnCommandWhoWas : TIdIrcThreeParmEvent;
    fOnCommandKill : TIdIrcTwoParmEvent;
    fOnCommandPing : TIdIrcTwoParmEvent;
    fOnCommandPong : TIdIrcTwoParmEvent;
    fOnCommandError : TIdIrcOneParmEvent;
    fOnCommandAway : TIdIrcOneParmEvent;
    fOnCommandRehash : TIdIrcGetEvent;
    fOnCommandRestart : TIdIrcGetEvent;
    fOnCommandSummon : TIdIrcTwoParmEvent;
    fOnCommandUsers : TIdIrcOneParmEvent;
    fOnCommandWallops : TIdIrcOneParmEvent;
    fOnCommandUserHost : TIdIrcOneParmEvent;
    fOnCommandIsOn : TIdIrcOneParmEvent;
    //
    function DoExecute( Thread : TIdPeerThread ): boolean; override;
  public
    constructor Create( AOwner : TComponent ); override;
  published
    property OnCommandPass : TIdIrcOneParmEvent read fOnCommandPass write fOnCommandPass;
    property OnCommandNick : TIdIrcTwoParmEvent read fOnCommandNick write fOnCommandNick;
    property OnCommandUser : TIdIrcUserEvent read fOnCommandUser write fOnCommandUser;
    property OnCommandServer : TIdIrcServerEvent read fOnCommandServer write fOnCommandServer;
    property OnCommandOper : TIdIrcTwoParmEvent read fOnCommandOper write fOnCommandOper;
    property OnCommandQuit : TIdIrcOneParmEvent read fOnCommandQuit write fOnCommandQuit;
    property OnCommandSQuit : TIdIrcTwoParmEvent read fOnCommandSQuit write fOnCommandSQuit;
    property OnCommandJoin : TIdIrcTwoParmEvent read fOnCommandJoin write fOnCommandJoin;
    property OnCommandPart : TIdIrcOneParmEvent read fOnCommandPart write fOnCommandPart;
    property OnCommandMode : TIdIrcFiveParmEvent read fOnCommandMode write fOnCommandMode;
    property OnCommandTopic : TIdIrcTwoParmEvent read fOnCommandTopic write fOnCommandTopic;
    property OnCommandNames : TIdIrcOneParmEvent read fOnCommandNames write fOnCommandNames;
    property OnCommandList : TIdIrcTwoParmEvent read fOnCommandList write fOnCommandList;
    property OnCommandInvite : TIdIrcTwoParmEvent read fOnCommandInvite write fOnCommandInvite;
    property OnCommandKick : TIdIrcThreeParmEvent read fOnCommandKick write fOnCommandKick;
    property OnCommandVersion : TIdIrcOneParmEvent read fOnCommandVersion write fOnCommandVersion;
    property OnCommandStats : TIdIrcTwoParmEvent read fOnCommandStats write fOnCommandStats;
    property OnCommandLinks : TIdIrcTwoParmEvent read fOnCommandLinks write fOnCommandLinks;
    property OnCommandTime : TIdIrcOneParmEvent read fOnCommandTime write fOnCommandTime;
    property OnCommandConnect : TIdIrcThreeParmEvent read fOnCommandConnect write fOnCommandConnect;
    property OnCommandTrace : TIdIrcOneParmEvent read fOnCommandTrace write fOnCommandTrace;
    property OnCommandAdmin : TIdIrcOneParmEvent read fOnCommandAdmin write fOnCommandAdmin;
    property OnCommandInfo : TIdIrcOneParmEvent read fOnCommandInfo write fOnCommandInfo;
    property OnCommandPrivMsg : TIdIrcTwoParmEvent read fOnCommandPrivMsg write fOnCommandPrivMsg;
    property OnCommandNotice : TIdIrcTwoParmEvent read fOnCommandNotice write fOnCommandNotice;
    property OnCommandWho : TIdIrcTwoParmEvent read fOnCommandWho write fOnCommandWho;
    property OnCommandWhoIs : TIdIrcTwoParmEvent read fOnCommandWhoIs write fOnCommandWhoIs;
    property OnCommandWhoWas : TIdIrcThreeParmEvent read fOnCommandWhoWas write fOnCommandWhoWas;
    property OnCommandKill : TIdIrcTwoParmEvent read fOnCommandKill write fOnCommandKill;
    property OnCommandPing : TIdIrcTwoParmEvent read fOnCommandPing write fOnCommandPing;
    property OnCommandPong : TIdIrcTwoParmEvent read fOnCommandPong write fOnCommandPong;
    property OnCommandError : TIdIrcOneParmEvent read fOnCommandError write fOnCommandError;
    property OnCommandAway : TIdIrcOneParmEvent read fOnCommandAway write fOnCommandAway;
    property OnCommandRehash : TIdIrcGetEvent read fOnCommandRehash write fOnCommandRehash;
    property OnCommandRestart : TIdIrcGetEvent read fOnCommandRestart write fOnCommandRestart;
    property OnCommandSummon : TIdIrcTwoParmEvent read fOnCommandSummon write fOnCommandSummon;
    property OnCommandUsers : TIdIrcOneParmEvent read fOnCommandUsers write fOnCommandUsers;
    property OnCommandWallops : TIdIrcOneParmEvent read fOnCommandWallops write fOnCommandWallops;
    property OnCommandUserHost : TIdIrcOneParmEvent read fOnCommandUserHost write fOnCommandUserHost;
    property OnCommandIsOn : TIdIrcOneParmEvent read fOnCommandIsOn write fOnCommandIsOn;
    property OnCommandOther : TIdIrcOtherEvent read fOnCommandOther write fOnCommandOther;
  end;

implementation

uses
  IdGlobal,
  IdResourceStrings,
  SysUtils;

constructor TIdIRCServer.Create ( AOwner : TComponent );
begin
  inherited;
  DefaultPort := IdPORT_IRC;
end;

function TIdIRCServer.DoExecute ( Thread : TIdPeerThread ) : boolean;
var
  s, sCmd, sCmd2, sCmd3, sCmd4 : String;

  procedure NotHandled;
  begin
    Thread.Connection.Writeln( '421 ' + RSCMDNotRecognized );    {Do not Localize}
  end;

begin
  result := true;
  while Thread.Connection.Connected do begin
    s := Thread.Connection.ReadLn;
    sCmd := Fetch ( s, ' ');    {Do not Localize}
    Case Succ ( PosInStrArray ( Uppercase ( sCmd ), KnownCommands ) ) of
      1 : {ADMIN}
          if assigned ( OnCommandAdmin ) then begin
            OnCommandAdmin ( Thread, S );
          end // if assigned ( OnCommandAdmin ) then
          else
            NotHandled;
      2 : {AWAY}
          if assigned ( OnCommandAway ) then begin
            OnCommandAway ( Thread, S );
          end // if assigned ( OnCommandAway ) then
          else
            NotHandled;
      3 : {CONNECT}
          if assigned(OnCommandConnect) then begin
            sCmd2 := Fetch ( s, ' ' );    {Do not Localize}
            sCmd3 :=  Fetch ( s, ' ' );    {Do not Localize}
            OnCommandConnect ( Thread, sCmd2, sCmd3, S );
          end  // if assigned(OnCommandConnect) then
          else
            NotHandled;
      4 : {ERROR}
          if assigned ( OnCommandError ) then begin
            OnCommandError ( Thread, S );
          end // if assigned ( OnCommandError ) then
          else
            NotHandled;
      5 : {INFO}
          if assigned ( OnCommandInfo ) then begin
            OnCommandInfo ( Thread, S );
          end  // if assigned ( OnCommandInfo ) then
          else
            NotHandled;
      6 : {INVITE}
          if assigned ( OnCommandInvite ) then begin
            sCmd2 := Fetch( s, ' ' );    {Do not Localize}
            OnCommandInvite ( Thread, sCmd2, S );
          end // if assigned ( OnCommandInvite ) then