怎么实现telnet

Indy控件啊，IdTelnet、IdTelnetServer

使用：Indy组件：
TelnetClient
unit mainform;interfaceuses
{$IFDEF Linux}
   QGraphics,  QControls,  QForms,  QDialogs,  QComCtrls,  QStdCtrls,
{$ELSE}
   Graphics,  Controls,  Forms,  Dialogs,  ComCtrls,  StdCtrls,
{$ENDIF}
  windows, messages, spin,  SysUtils,  Classes, IdBaseComponent, IdComponent,
    IdTCPConnection, IdTCPClient, IdTelnet;type
  TfrmTelnetDemo = class(TForm)
    Memo1: TRichEdit;
    edtServer: TEdit;
    lblServer: TLabel;
    spnedtPort: TSpinEdit;
    lblPort: TLabel;
    btnConnect: TButton;
    btnDisconnect: TButton;
    sbrStatus: TStatusBar;
    IdTelnetDemo: TIdTelnet;
    Button1: TButton;
    procedure btnConnectClick(Sender: TObject);
    procedure btnDisconnectClick(Sender: TObject);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure IdTelnetDemoDataAvailable(Buffer: string);
    procedure IdTelnetDemoConnected(Sender: TObject);
    procedure IdTelnetDemoConnect;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  frmTelnetDemo: TfrmTelnetDemo;implementation{$IFDEF MSWINDOWS}{$R *.dfm}{$ELSE}{$R *.xfm}{$ENDIF}procedure TfrmTelnetDemo.btnConnectClick(Sender: TObject);
begin
  IDTelnetDemo.Host := edtServer.Text;
  IDTelnetDemo.port := spnedtPort.Value;
  IdTelnetDemo.Connect;
end;procedure TfrmTelnetDemo.btnDisconnectClick(Sender: TObject);
begin
  IdTelnetDemo.Disconnect;
end;procedure TfrmTelnetDemo.Memo1KeyPress(Sender: TObject;
  var Key: Char);
begin
  {we simply send the key stroke to the server.  It may echo it back to us}
  if IdTelnetDemo.Connected then
    IdTelnetDemo.SendCh(Key);

  Key := #0;
end;procedure TfrmTelnetDemo.IdTelnetDemoDataAvailable(Buffer: string);
{This routine comes directly from the ICS TNDEMO code. Thanks to Francois Piette
It updates the memo control when we get data}
const
  CR = #13;
  LF = #10;
var
  Start, Stop: Integer;
begin
  if Memo1.Lines.Count = 0 then
    Memo1.Lines.Add('');  Start := 1;
  Stop := Pos(CR, Buffer);
  if Stop = 0 then
    Stop := Length(Buffer) + 1;
  while Start <= Length(Buffer) do
  begin
    Memo1.Lines.Strings[Memo1.Lines.Count - 1] :=
      Memo1.Lines.Strings[Memo1.Lines.Count - 1] +
      Copy(Buffer, Start, Stop - Start);
    if Buffer[Stop] = CR then
    begin
      Memo1.Lines.Add('');
{$IFNDEF Linux}
      SendMessage(Memo1.Handle, WM_KEYDOWN, VK_UP, 1);
{$ENDIF}
    end;
    Start := Stop + 1;
    if Start > Length(Buffer) then
      Break;
    if Buffer[Start] = LF then
      Start := Start + 1;
    Stop := Start;
    while (Buffer[Stop] <> CR) and (Stop <= Length(Buffer)) do
      Stop := Stop + 1;
  end;
end;procedure TfrmTelnetDemo.IdTelnetDemoConnected(Sender: TObject);
begin
  sbrStatus.SimpleText := 'Connected';
end;procedure TfrmTelnetDemo.IdTelnetDemoConnect;
begin
  sbrStatus.SimpleText := 'Connect';
end;procedure TfrmTelnetDemo.Button1Click(Sender: TObject);
begin
idtelnetdemo.Write('dir c:\'+#13);end;end.

unit tndemo1;interfaceuses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TnCnx, ExtCtrls;type
  TTnDemoForm = class(TForm)
    DisplayMemo: TMemo;
    Panel1: TPanel;
    TnCnx: TTnCnx;
    HostLabel: TLabel;
    HostEdit: TEdit;
    ConnectButton: TButton;
    InfoLabel: TLabel;
    DisconnectButton: TButton;
    PortLabel: TLabel;
    PortEdit: TEdit;
    procedure ConnectButtonClick(Sender: TObject);
    procedure TnCnxDataAvailable(Sender: TTnCnx; Buffer: PChar;
      Len: Integer);
    procedure TnCnxSessionConnected(Sender: TTnCnx; Error: Word);
    procedure DisplayMemoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DisplayMemoKeyPress(Sender: TObject; var Key: Char);
    procedure TnCnxSessionClosed(Sender: TTnCnx; Error: Word);
    procedure DisconnectButtonClick(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
  private
    { D閏larations priv閑s }
  public
    { D閏larations publiques }
  end;var
  TnDemoForm: TTnDemoForm;implementation{$R *.DFM}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{* Display a message in the memo field, breaking with CR                   *}
procedure MemoAddLines(Memo : TMemo; Msg : String);
const
    CR = #13;
    LF = #10;
var
    Start, Stop : Integer;
begin
    if Memo.Lines.Count = 0 then
        Memo.Lines.Add('');    Start := 1;
    Stop  := Pos(CR, Msg);
    if Stop = 0 then
        Stop := Length(Msg) + 1;
    while Start <= Length(Msg) do begin
        Memo.Lines.Strings[Memo.Lines.Count - 1] :=
            Memo.Lines.Strings[Memo.Lines.Count - 1] +
            Copy(Msg, Start, Stop - Start);
        if Msg[Stop] = CR then begin
            Memo.Lines.Add('');
            SendMessage(Memo.Handle, WM_KEYDOWN, VK_UP, 1);
        end;
        Start := Stop + 1;
        if Start > Length(Msg) then
            Break;
        if Msg[Start] = LF then
           Start := Start + 1;
        Stop := Start;
        while (Msg[Stop] <> CR) and (Stop <= Length(Msg)) do
            Stop := Stop + 1;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnDemoForm.ConnectButtonClick(Sender: TObject);
begin
    TnCnx.Host      := HostEdit.Text;
    TnCnx.Port      := PortEdit.Text;
    TnCnx.TermType  := 'VT100';
    TnCnx.LocalEcho := FALSE;
    TnCnx.Connect;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnDemoForm.DisconnectButtonClick(Sender: TObject);
begin
    TnCnx.Close;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnDemoForm.TnCnxSessionConnected(Sender: TTnCnx; Error: Word);
begin
    DisplayMemo.Clear;
    InfoLabel.Caption        := 'Connected';
    DisplayMemo.Enabled      := TRUE;
    ConnectButton.Enabled    := FALSE;
    DisconnectButton.Enabled := TRUE;
    ActiveControl            := DisplayMemo;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnDemoForm.TnCnxSessionClosed(Sender: TTnCnx; Error: Word);
begin
    InfoLabel.Caption        := 'Disconnected';
    DisplayMemo.Enabled      := FALSE;
    ConnectButton.Enabled    := TRUE;
    DisconnectButton.Enabled := FALSE;
    ActiveControl            := ConnectButton;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnDemoForm.TnCnxDataAvailable(Sender: TTnCnx; Buffer: PChar;
  Len: Integer);
begin
    MemoAddLines(DisplayMemo, StrPas(Buffer));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnDemoForm.DisplayMemoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    Key := 0;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnDemoForm.DisplayMemoKeyPress(Sender: TObject; var Key: Char);
begin
    TnCnx.Send(@Key, 1);
    Key := #0;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}end.

unit Tnsrv1;
interfaceuses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, WSocket, WinSock, StdCtrls, Tnsrv2, ScktComp;const
  TnSrvVersion = 124;type
  TClient = class(TObject)
    Form      : TClientForm;
    Peer      : String;
    constructor Create(AOwner : TComponent);
    destructor  Destroy; override;
  end;  TServerForm = class(TForm)
    Memo: TMemo;
    QuitButton: TButton;
    AboutButton: TButton;
    SrvSocket: TWSocket;
    PortLabel: TLabel;
    PortEdit: TEdit;
    ChangePortButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Display(Msg : String);
    procedure QuitButtonClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure AboutButtonClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure SrvSocketSessionAvailable(Sender: TObject; Error: Word);
    procedure SrvSocketSessionClosed(Sender: TObject; Error: Word);
    procedure ChangePortButtonClick(Sender: TObject);
  protected
    procedure WMDisconnect(var msg: TMessage); message WM_DISCONNECT;
  private
    { Private declarations }
  public
    Clients  : TList;
  end;var
  ServerForm: TServerForm;implementation{$R *.DFM}
{DEFINE Debug}     { Add or remove dollar sign before Debug to }
                   { generate code for debug message output    }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure DebugString(Msg : String);
const
    Cnt : Integer = 0;
{$IFDEF Debug}
var
    Buf : String[20];
{$ENDIF}
begin
{$IFDEF Debug}
    Cnt := Cnt + 1;
    Buf := IntToHex(Cnt, 4) + ' ' + #0;
    OutputDebugString(@Buf[1]);
{$IFDEF WIN32}
    OutputDebugString(PChar(Msg));
{$ELSE}
    if Length(Msg) < High(Msg) then
        Msg[Length(Msg) + 1] := #0;    OutputDebugString(@Msg[1]);
{$ENDIF}
{$ENDIF}
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TClient.Create(AOwner : TComponent);
begin
     Application.CreateForm(TClientForm, Form);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TClient.Destroy;
begin
    Form.Release;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.FormCreate(Sender: TObject);
begin
    Memo.Clear;
    Clients := TList.Create;
    Display(PortEdit.Text + ' Server Ready' + #13 + #10);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.FormActivate(Sender: TObject);
const
    FirstTime : Boolean = TRUE;
begin
    if FirstTime then begin
        FirstTime := FALSE;
        SrvSocket.Listen;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.Display(Msg : String);
var
    Start, Stop : Integer;
begin
    if Memo.Lines.Count = 0 then
        Memo.Lines.Add('');    Start := 1;
    Stop  := Pos(#13, Msg);
    if Stop = 0 then
        Stop := Length(Msg) + 1;
    while Start <= Length(Msg) do begin
        Memo.Lines.Strings[Memo.Lines.Count - 1] := Memo.Lines.Strings[Memo.Lines.Count - 1] + Copy(Msg, Start, Stop - Start);
        if Msg[Stop] = #13 then begin
            Memo.Lines.Add('');
            SendMessage(Memo.Handle, WM_KEYDOWN, VK_UP, 1);
        end;
        Start := Stop + 1;
        if Start > Length(Msg) then
            Break;
        if Msg[Start] = #10 then
           Start := Start + 1;
        Stop := Start;
        while (Stop <= Length(Msg)) and (Msg[Stop] <> #13) do
            Stop := Stop + 1;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.SrvSocketSessionAvailable(Sender: TObject; Error : word);
var
    NewHSocket : TSocket;
    PeerName   : TSockAddrIn;
    Client     : TClient;
begin
    NewHSocket := SrvSocket.Accept;
    Client := TClient.Create(Self);
    Client.Form.Reference  := Client;
    Client.Form.PortNum    := SrvSocket.PortNum;
    Client.Form.AcceptForm := Self;
    Client.Form.Socket.Dup(NewHSocket);
    Client.Form.Socket.GetPeerName(PeerName, Sizeof(PeerName));
    Client.Peer := StrPas(inet_ntoa(PeerName.Sin_addr));
    Display('Remote ' + Client.Peer + ' connected' + #13 + #10);
    Client.Form.Caption := Client.Peer;
    Client.Form.Show;
    Clients.Add(Client);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.WMDisconnect(var msg: TMessage);
var
    Client : TClient;
    Why    : String;
begin
    case msg.wParam of
    DISCONNECT_SELF   : Why := 'has been disconnected';
    DISCONNECT_REMOTE : Why := 'has closed the connection';
    else                Why := 'disconnected';
    end;    Client := TCLient(msg.lParam);
    Display('Remote ' + Client.Peer + ' ' + Why + #13 + #10);
    Client.Form.Socket.Shutdown(2);
    Client.Form.Socket.Close;
    Client.Form.Visible := FALSE;
    Client.Form.Release;
    Clients.Remove(Client);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.SrvSocketSessionClosed(Sender: TObject; Error : word);
begin
    Display(#13 + #10 + '*** Remote has closed ***' + #13 + #10);
    if SrvSocket.State = wsOpened then
        SrvSocket.Close;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.QuitButtonClick(Sender: TObject);
begin
    SrvSocket.Close;
    Close;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.AboutButtonClick(Sender: TObject);
begin
    Application.MessageBox(
        'TnSRV  V1.1 ' +
{$IFDEF WIN32}
        '32 bit' +
{$ELSE}
        '16 bit' +
{$ENDIF}
        '  March 19, 1997' + #10 + #10 +
        'Free Software, Copyright Francois Piette' + #10 + #10 +
        '[email protected]  http://www.rtfm.be/fpiette',
        'About TnSrv', MB_OK);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Adjust the position for each control in the form as the user resize it   *}
procedure TServerForm.FormResize(Sender: TObject);
begin
    Memo.Height          := ClientHeight - QuitButton.Height - 20;
    QuitButton.Left      := ClientWidth - QuitButton.Width - 10;
    AboutButton.Left     := QuitButton.Left - AboutButton.Width - 10;
    QuitButton.Top       := ClientHeight - QuitButton.Height - 10;
    AboutButton.Top      := QuitButton.Top;
    ChangePortButton.Top := QuitButton.Top;
    PortEdit.Top         := QuitButton.Top;
    PortLabel.Top        := QuitButton.Top + 4;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TServerForm.ChangePortButtonClick(Sender: TObject);
begin
    with SrvSocket do begin
        Close;
        Addr  := '0.0.0.0';
        Proto := 'tcp';
        Port  := PortEdit.Text;
        Listen;
    end;
    Memo.Clear;
    Display(PortEdit.Text + ' Server Ready' + #13 + #10);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}end.

太大了
给你发去吧！
给一下email:

give me a copy:[email protected] you!

INDY在DELPHI中本身就有DEMO..可以按照它的方法做..

调试易

怎么实现telnet

解决方案 »