iddictserver.pas

photo.163.com 相册下载器 多线程下载

{ $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:  13790: IdDICTServer.pas
{
    Rev 1.10    6/11/2004 6:16:50 AM  DSiders
  Corrected spelling in class names, properties, and methods.
}
{
{   Rev 1.9    2004.02.03 5:45:06 PM  czhower
{ Name changes
}
{
{   Rev 1.8    1/21/2004 2:12:44 PM  JPMugaas
{ InitComponent
}
{
    Rev 1.7    10/19/2003 11:51:16 AM  DSiders
  Added localization comments.
}
{
{   Rev 1.6    2003.10.18 9:42:08 PM  czhower
{ Boatload of bug fixes to command handlers.
}
{
{   Rev 1.5    7/18/2003 4:24:48 PM  SPerry
{ New DICT server using command handlers
}
{
{   Rev 1.4    2/24/2003 08:22:52 PM  JPMugaas
{ SHould compile with new code.
}
{
{   Rev 1.3    1/17/2003 05:35:14 PM  JPMugaas
{ Now compiles with new design.
}
{
{   Rev 1.2    1-1-2003 20:12:52  BGooijen
{ Changed to support the new TIdContext class
}
{
{   Rev 1.1    12/6/2002 02:17:42 PM  JPMugaas
{ Now compiles with Indy 10.
}
{
{   Rev 1.0    11/14/2002 02:17:24 PM  JPMugaas
}
unit IdDICTServer;

interface

{
2000-15-May: J. Peter Mugaas - renamed events to have Id prefix
2000-22-Apr: J. Peter Mugaas
  Ported to Indy
2000-23-JanL MTL Moved to new Palette Scheme
1999-23-Apr: Final Version
Original Author: Ozz Nixon
  RFC 2229 - Dictionary Protocol (Structure).
}

uses
  Classes, SysUtils, IdGlobal, IdGlobalProtocols, IdResourceStringsProtocols,
  IdAssignedNumbers, IdCommandHandlers, IdCmdTCPServer;

type
  TIdDICTGetEvent = procedure (AContext:TIdCommand) of object;
  TIdDICTOtherEvent = procedure (AContext:TIdCommand; Command, Parm:String) of object;
  TIdDICTDefineEvent = procedure (AContext:TIdCommand; Database, WordToFind : String) of object;
  TIdDICTMatchEvent = procedure (AContext:TIdCommand; Database, Strategy,WordToFind : String) of object;
  TIdDICTShowEvent = procedure (AContext:TIdCommand; Command : String) of object;
  TIdDICTAuthEvent = procedure (AContext:TIdCommand; Username, authstring : String) of object;

  TIdDICTServer = class(TIdCmdTCPServer)
  protected
    fOnCommandHELP:TIdDICTGetEvent;
    fOnCommandDEFINE:TIdDICTDefineEvent;
    fOnCommandMATCH:TIdDICTMatchEvent;
    fOnCommandQUIT:TIdDICTGetEvent;
    fOnCommandSHOW:TIdDICTShowEvent;
    fOnCommandAUTH, fOnCommandSASLAuth:TIdDICTAuthEvent;
    fOnCommandOption:TIdDICTOtherEvent;
    fOnCommandSTAT:TIdDICTGetEvent;
    fOnCommandCLIENT:TIdDICTShowEvent;
    fOnCommandOther:TIdDICTOtherEvent;
    //
    procedure DoOnCommandHELP(ASender: TIdCommand);
    procedure DoOnCommandDEFINE(ASender: TIdCommand);
    procedure DoOnCommandMATCH(ASender: TIdCommand);
    procedure DoOnCommandQUIT(ASender: TIdCommand);
    procedure DoOnCommandSHOW(ASender: TIdCommand);
    procedure DoOnCommandAUTH(ASender: TIdCommand);
    procedure DoOnCommandSASLAuth(ASender: TIdCommand);
    procedure DoOnCommandOption(ASender: TIdCommand);
    procedure DoOnCommandSTAT(ASender: TIdCommand);
    procedure DoOnCommandCLIENT(ASender: TIdCommand);
    procedure DoOnCommandOther(ASender: TIdCommand);
    procedure DoOnCommandNotHandled(ASender: TIdCommandHandler; ACommand: TIdCommand;
      const AData, AMessage: String);
    //
    procedure InitializeCommandHandlers; override;
    procedure InitComponent; override;
  published
    property DefaultPort default IdPORT_DICT;
    //
    property OnCommandHelp: TIdDICTGetEvent read fOnCommandHelp write fOnCommandHelp;
    property OnCommandDefine: TIdDICTDefineEvent read fOnCommandDefine write fOnCommandDefine;
    property OnCommandMatch: TIdDICTMatchEvent read fOnCommandMatch write fOnCommandMatch;
    property OnCommandQuit: TIdDICTGetEvent read fOnCommandQuit write fOnCommandQuit;
    property OnCommandShow: TIdDICTShowEvent read fOnCommandShow write fOnCommandShow;
    property OnCommandAuth: TIdDICTAuthEvent read fOnCommandAuth write fOnCommandAuth;
    property OnCommandSASLAuth: TIdDICTAuthEvent read fOnCommandSASLAuth write fOnCommandSASLAuth;
    property OnCommandOption: TIdDICTOtherEvent read fOnCommandOption write fOnCommandOption;
    property OnCommandStatus: TIdDICTGetEvent read fOnCommandStat write fOnCommandStat;
    property OnCommandClient: TIdDICTShowEvent read fOnCommandClient write fOnCommandClient;
    property OnCommandOther: TIdDICTOtherEvent read fOnCommandOther write fOnCommandOther;
  end;

implementation

procedure TIdDICTServer.InitComponent;
begin
  inherited;
  DefaultPort := IdPORT_DICT;
end;

{ Command handlers }

procedure TIdDICTServer.DoOnCommandHELP(ASender: TIdCommand);
begin
  if assigned (OnCommandHelp) then
    OnCommandHelp(ASender);
end;

procedure TIdDICTServer.DoOnCommandDEFINE(ASender: TIdCommand);
begin
  if assigned (OnCommandDefine) then
  begin
    OnCommandDefine (ASender, ASender.Params[0], ASender.Params[1]);
  end;
end;

procedure TIdDICTServer.DoOnCommandMATCH(ASender: TIdCommand);
begin
  if assigned (OnCommandMatch) then
  begin
    OnCommandMatch(ASender, ASender.Params[0], ASender.Params[1], ASender.Params[2]);
  end;
end;

procedure TIdDICTServer.DoOnCommandQUIT(ASender: TIdCommand);
begin
  if assigned (OnCommandQuit) then
    OnCommandQuit (ASender);
end;

procedure TIdDICTServer.DoOnCommandSHOW(ASender: TIdCommand);
begin
  if assigned ( OnCommandShow ) then
    OnCommandShow (ASender, ASender.Params[0]);
end;

procedure TIdDICTServer.DoOnCommandAUTH(ASender: TIdCommand);
begin
  if assigned (OnCommandAuth) then
  begin
    OnCommandAuth (ASender, ASender.Params[0], ASender.Params[1]);
  end;
end;

procedure TIdDICTServer.DoOnCommandSASLAuth(ASender: TIdCommand);
begin
  if assigned ( OnCommandSASLAuth ) then
  begin
    OnCommandSASLAuth(ASender, ASender.Params[0], ASender.Params[1]);
  end;
end;

procedure TIdDICTServer.DoOnCommandOption(ASender: TIdCommand);
begin
  if assigned(OnCommandOption) then
    OnCommandOption(ASender, ASender.Params[0], '');
end;

procedure TIdDICTServer.DoOnCommandSTAT(ASender: TIdCommand);
begin
  if assigned ( OnCommandStatus ) then
    OnCommandStatus (ASender);
end;

procedure TIdDICTServer.DoOnCommandCLIENT(ASender: TIdCommand);
begin
  if assigned (OnCommandClient) then
    OnCommandClient (ASender, ASender.Params[0]);
end;

procedure TIdDICTServer.DoOnCommandOther(ASender: TIdCommand);
begin

end;

procedure TIdDICTServer.DoOnCommandNotHandled(ASender: TIdCommandHandler;
  ACommand: TIdCommand; const AData, AMessage: String);
begin
  ACommand.Context.Connection.IOHandler.WriteLn('500 ' + RSCMDNotRecognized); {do not localize}
end;


procedure TIdDICTServer.InitializeCommandHandlers;
begin
  with CommandHandlers.Add do
  begin
    Command := 'AUTH';  {do not localize}
    OnCommand := DoOnCommandAUTH;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'CLIENT';  {do not localize}
    OnCommand := DoOnCommandCLIENT;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'DEFINE';  {do not localize}
    OnCommand := DoOnCommandDEFINE;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'HELP';  {do not localize}
    OnCommand := DoOnCommandHELP;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'MATCH'; {do not localize}
    OnCommand := DoOnCommandMATCH;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'OPTION';  {do not localize}
    OnCommand := DoOnCommandOPTION;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'QUIT';  {do not localize}
    OnCommand := DoOnCommandQUIT;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'SASLAUTH';  {do not localize}
    OnCommand := DoOnCommandSASLAUTH;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'SHOW';  {do not localize}
    OnCommand := DoOnCommandSHOW;
  end;
  with CommandHandlers.Add do
  begin
    Command := 'STATUS';  {do not localize}
    OnCommand := DoOnCommandSTAT;
  end;
  { Other }
  with CommandHandlers.Add do
  begin
    Command := '';
    //OnCommand :=;
    //OnException :=;
  end;
end;

end.