应用TIdFinger和TIdFingerServer组件

(1) unit U_Finger_Client;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdFinger, StdCtrls, Buttons;

type
  TF_Finger_Client = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    Button1: TButton;
    Label2: TLabel;
    IdFinger1: TIdFinger;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  F_Finger_Client: TF_Finger_Client;

implementation

{$R *.dfm}

procedure TF_Finger_Client.Button1Click(Sender: TObject);
begin
  //设置查询字符串
  IdFinger1.CompleteQuery := Edit1.Text;
  //是否进行冗长查询
  IdFinger1.VerboseOutput := CheckBox1.Checked;
  //显示查询结果
  Memo1.Lines.Text := IdFinger1.Finger;
end;

end.
(2) unit U_Finger_Server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdFingerServer,
  StdCtrls,IDGlobal;

type
  TFinger_Server = class(TForm)
    Label1: TLabel;
    lblStatus: TLabel;
    IdFingerServer1: TIdFingerServer;
    procedure FormActivate(Sender: TObject);
    procedure IdFingerServer1CommandFinger(AThread: TIdPeerThread;
      const AUserName: String);
    procedure IdFingerServer1CommandVerboseFinger(AThread: TIdPeerThread;
      const AUserName: String);
    procedure IdFingerServer1Connect(AThread: TIdPeerThread);
    procedure IdFingerServer1Disconnect(AThread: TIdPeerThread);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Finger_Server: TFinger_Server;

implementation

{$R *.dfm}

Const SampleUsers : Array [1..3] of String =
  ('TIDFINGER', 'TIDQUOTD', 'TIDTIME');

procedure TFinger_Server.FormActivate(Sender: TObject);
begin
   try
    IdFingerServer1.Active := True;
  except
    ShowMessage('拒绝连接');
    Application.Terminate;
  end;

end;

procedure TFinger_Server.IdFingerServer1CommandFinger(
  AThread: TIdPeerThread; const AUserName: String);
begin
     //对通用查询，列出所有用户
  if AUserName = '' then
    begin
    AThread.Connection.WriteLn('TIdFinger');
    AThread.Connection.WriteLn('TIdQuotD');
    AThread.Connection.WriteLn('TIdTime');
    end
  else
    begin
    Case Succ ( PosInStrArray ( Uppercase ( AUserName ), SampleUsers ) ) of
      1 :   AThread.Connection.WriteLn('TIdFinger implements RFC 1288');
      2 :   AThread.Connection.WriteLn('TIdQuotD implements RFC 865');
      3 :   AThread.Connection.WriteLn('TIdTime implements RFC 868');
    else     AThread.Connection.WriteLn( AUserName + '?' );
    end; //Case Succ
  end; //if AUserName = '' then
end;

procedure TFinger_Server.IdFingerServer1CommandVerboseFinger(
  AThread: TIdPeerThread; const AUserName: String);
begin
   AThread.Connection.WriteLn('冗长查询');
  //对通用查询，列出所有用户
  if AUserName = '' then
      begin
        AThread.Connection.WriteLn('TIdFinger');
        AThread.Connection.WriteLn('TIdQuotD');
        AThread.Connection.WriteLn('TIdTime');
      end
  else
  begin //提供简单的信息
      Case Succ ( PosInStrArray ( Uppercase ( AUserName ), SampleUsers ) ) of
      1 : //用户为"TIdFinger"
          begin
            AThread.Connection.WriteLn('TIdFinger实现了RFC 1288所描述的Finger协议。');
            AThread.Connection.WriteLn('');
            AThread.Connection.WriteLn('Finger协议是为数据库服务的有关远程系统');
            AThread.Connection.WriteLn('上的用户的信息的接口，具体的用户信息包');
            AThread.Connection.WriteLn('括用户是否登录到系统中、用户何时读取电');
            AThread.Connection.WriteLn('子邮件以及其它用户想要发布的信息等。');
          end; {1}
      2 : //用户为"TIdQuotD "
          begin
            AThread.Connection.WriteLn('TIdQuotD实现了RFC 865所描述的QUOTD协议');
            AThread.Connection.WriteLn('');
            AThread.Connection.WriteLn('QUOTD协议是一个简单的协议，用于从服务器');
            AThread.Connection.WriteLn('中获取一个短引用。');
          end; {2}
      3 : //用户为"TIdTime "
          begin
            AThread.Connection.WriteLn('TIdTime实现了RFC 868所描述的Time协议。');
            AThread.Connection.WriteLn('');
            AThread.Connection.WriteLn('Time协议用于同步本地网络上的时钟。');
          end; {3}
      else    //当系统中没有该用户时进行如下处理
         AThread.Connection.WriteLn( AUserName + '?' );
      end;
  end;
end;

procedure TFinger_Server.IdFingerServer1Connect(AThread: TIdPeerThread);
begin
   lblStatus.caption := '[ 连接到客户端 ]';
end;

procedure TFinger_Server.IdFingerServer1Disconnect(AThread: TIdPeerThread);
begin
   lblStatus.caption := '[ 空闲 ]';
end;

end.