idtelnetserver.pas

网络控件适用于Delphi6

{ $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:  11783: IdTelnetServer.pas 
{
{   Rev 1.12    2004.02.03 5:44:32 PM  czhower
{ Name changes
}
{
{   Rev 1.11    2004.01.22 2:33:58 PM  czhower
{ Matched visibility of DoConnect
}
{
{   Rev 1.10    1/21/2004 4:20:52 PM  JPMugaas
{ InitComponent
}
{
{   Rev 1.9    2003.10.21 9:13:16 PM  czhower
{ Now compiles.
}
{
{   Rev 1.8    9/19/2003 04:27:02 PM  JPMugaas
{ Removed IdFTPServer so Indy can compile with Kudzu's new changes.
}
{
    Rev 1.7    7/6/2003 7:55:36 PM  BGooijen
  Removed unused units from the uses
}
{
{   Rev 1.6    2/24/2003 10:32:50 PM  JPMugaas
}
{
{   Rev 1.5    1/17/2003 07:11:04 PM  JPMugaas
{ Now compiles under new framework.
}
{
{   Rev 1.4    1/17/2003 04:05:40 PM  JPMugaas
{ Now compiles under new design.
}
{
{   Rev 1.3    1/9/2003 06:09:42 AM  JPMugaas
{ Updated for IdContext API change.
}
{
{   Rev 1.2    1/8/2003 05:53:58 PM  JPMugaas
{ Switched stuff to IdContext.
}
{
{   Rev 1.1    12/7/2002 06:43:36 PM  JPMugaas
{ These should now compile except for Socks server.  IPVersion has to be a
{ property someplace for that.
}
{
{   Rev 1.0    11/13/2002 08:02:56 AM  JPMugaas
}
unit IdTelnetServer;

interface

uses
  Classes,
  IdAssignedNumbers, IdContext, IdTCPConnection, IdYarn, IdTCPServer;

const
  GLoginAttempts = 3;

type

  // SG 16/02/2001: Moved the TTelnetData object from TIdPeerThread to custom TIdPeerThread descendant

  TTelnetData = class(TObject)
  public
    Username, Password: String;
    HUserToken: cardinal;
  end;

  // Custom Peer thread class
  TIdTelnetPeerContext = Class(TIdContext)
  private
    FTelnetData: TTelnetData;
  public
    constructor Create(
      AConnection: TIdTCPConnection;
      AYarn: TIdYarn;
      AList: TThreadList = nil
      ); override;
    destructor Destroy; override;
    Property TelnetData: TTelnetData read FTelnetData;
  end; //class


  TIdTelnetNegotiateEvent = procedure(AContext: TIdContext) of object;
  TAuthenticationEvent = procedure(AContext: TIdContext;
   const AUsername, APassword: string; var AAuthenticated: Boolean) of object;

  TIdTelnetServer = class(TIdTCPServer)
  protected
    FLoginAttempts: Integer;
    FOnAuthentication: TAuthenticationEvent;
    FLoginMessage: string;
    FOnNegotiate: TIdTelnetNegotiateEvent;
    //
    procedure DoConnect(AContext: TIdContext); override;
    procedure InitComponent; override;
  public
    function DoAuthenticate(AContext: TIdContext; const AUsername, APassword: string)
     : boolean; virtual;
    procedure DoNegotiate(AContext: TIdContext); virtual;
  published
    property DefaultPort default IdPORT_TELNET;
    property LoginAttempts: Integer read FLoginAttempts write FLoginAttempts Default GLoginAttempts;
    property LoginMessage: String read FLoginMessage write FLoginMessage;
    property OnAuthentication: TAuthenticationEvent read FOnAuthentication write FOnAuthentication;
    property OnNegotiate: TIdTelnetNegotiateEvent read FOnNegotiate write FOnNegotiate;
  end;

implementation

uses
  IdException, IdGlobal, IdResourceStringsProtocols, SysUtils;

procedure TIdTelnetServer.InitComponent;
begin
  inherited;
  LoginAttempts := GLoginAttempts;
  LoginMessage := RSTELNETSRVWelcomeString;
  DefaultPort := IdPORT_TELNET;
  FContextClass := TIdTelnetPeerContext;
end;

function TIdTelnetServer.DoAuthenticate;
begin
  if not Assigned(OnAuthentication) then begin
    raise EIdException.Create(RSTELNETSRVNoAuthHandler);
  end;
  Result := False;
  OnAuthentication(AContext, AUsername, APassword, result);
end;

procedure TIdTelnetServer.DoConnect(AContext: TIdContext);
Var
  Data: TTelnetData;
  i: integer;
begin
  try
    inherited;
    Data := (AContext as TIdTelnetPeerContext).TelnetData;
    // do protocol negotiation first
    DoNegotiate(AContext);
    // Welcome the user
    if length(LoginMessage) > 0 then
    begin
      AContext.Connection.IOHandler.WriteLn(LoginMessage);
      AContext.Connection.IOHandler.WriteLn('');    {Do not Localize}
    end;
    // Only prompt for creditentials if there is an authentication handler
    if assigned(OnAuthentication) then
    begin
      // ask for username/password.
      for i := 1 to LoginAttempts do
      begin
        // UserName
        AContext.Connection.IOHandler.Write(RSTELNETSRVUsernamePrompt);
        Data.Username := AContext.Connection.IOHandler.InputLn;
        // Password
        AContext.Connection.IOHandler.Write(RSTELNETSRVPasswordPrompt);
        Data.Password := AContext.Connection.IOHandler.InputLn('*');    {Do not Localize}
        AContext.Connection.IOHandler.WriteLn;
        // Check authentication
        if DoAuthenticate(AContext, Data.Username, Data.Password) then begin
          Break; // exit the loop
        end else begin
          AContext.Connection.IOHandler.WriteLn(RSTELNETSRVInvalidLogin); // translate
          if i = FLoginAttempts then begin
            raise EIdException.Create(RSTELNETSRVMaxloginAttempt); // translate
          end;
        end;
      end;
    end;
  except
    on E: Exception do begin
      AContext.Connection.IOHandler.WriteLn(E.Message);
      AContext.Connection.Disconnect;
    end;
  end;
end;

procedure TIdTelnetServer.DoNegotiate(AContext: TIdContext);
begin
  if assigned(FOnNegotiate) then begin
    FOnNegotiate(AContext);
  end;
end;

{ TIdTelnetPeerContext }

constructor TIdTelnetPeerContext.Create;
begin
  inherited;
  FTelnetData := TTelnetData.Create;
end;

destructor TIdTelnetPeerContext.Destroy;
begin
  FreeAndNil(FTelnetData);
  inherited;
end;


end.