main.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, StdCtrls, ScktComp, MyTelnet, ComCtrls, ToolWin, ImgList;

const
  AppName = 'MyTelnet';
  DefaultHostName = 'localhost';
  DefaultTermType = 'ansi';

type
  TTelnetForm = class(TForm)
    FontDialog: TFontDialog;
    SaveDialog: TSaveDialog;
    ToolBar1: TToolBar;
    MyTelnet1: TMyTelnet;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ImageList1: TImageList;
    TelnetMainMenu: TMainMenu;
    procedure MyTelnet1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure MyTelnet1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure MyTelnet1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure ToolButton11Click(Sender: TObject);
    procedure ToolButton13Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure miConnectExitClick(Sender: TObject);
  private
    CurHost: string;
    CurPort: Integer;
    CurTerm: string;
    MaxRegs: Integer;
    UserStop: Boolean;
    function CanOpenNew: Boolean;

  public
    procedure Init;
    procedure OpenHost(hName: string);
  end;

var
  TelnetForm: TTelnetForm;

implementation

{$R *.DFM}

uses Clipbrd, OpenHosts, About;

procedure TelnetErrorProc(ErrorCode: Integer);
begin
    case ErrorCode of
    10049, 10060, 10061, 10065:
        MessageBox(TelnetForm.Handle, @('无法连接到主机“'
        +TelnetForm.CurHost+'”')[1], '连接失败', MB_ICONSTOP);
    else MessageBox(TelnetForm.Handle, @('Unknown Error with code :'
    +IntToStr(ErrorCode))[1], '错误', MB_ICONSTOP);
    end;
end;

procedure TTelnetForm.Init;
var tmpvar, tmpcode: Integer;
    tmpstr: string;
begin
    CurPort:=23;
    MyTelnet1.CaretStyle:=csLine;
    toolbutton2.Enabled:=false;
    Update;
    SetErrorProc(TelnetErrorProc);
    Application.ProcessMessages;
    CurHost:='localhost';
end;

procedure TTelnetForm.OpenHost(hName: string);
begin { 命令行打开连接 }
    CurHost:=Trim(hName);
    CurTerm:=DefaultTermType;
    MyTelnet1.TermType:=CurTerm;
    MyTelnet1.Open(CurHost, CurPort);
end;

function TTelnetForm.CanOpenNew: Boolean;
begin
    Result:=True;
    if MyTelnet1.Active then begin
        if MessageBox(Handle, '连接新主机之前，断开当前的连接吗？',
         '询问', MB_ICONQUESTION+MB_YESNO)<>ID_YES then
        begin Result:=False; Exit end;
        UserStop:=True;
        MyTelnet1.Close;
    end;
end;

procedure TTelnetForm.MyTelnet1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
    Caption:=AppName + ' - '+CurHost;
end;

procedure TTelnetForm.MyTelnet1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
    if not UserStop then
        MessageBox(Handle, '到主机的连接丢失。', AppName, 0);
    Caption:=AppName+' - (无)';
    UserStop:=False;
    toolbutton1.Enabled:=True;
    toolbutton2.Enabled:=False;
end;

procedure TTelnetForm.MyTelnet1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
    TelnetErrorProc(ErrorCode);
    ErrorCode:=0;
end;



procedure TTelnetForm.ToolButton1Click(Sender: TObject);
begin
    if not CanOpenNew then Exit;
    if ConnectToHost(CurHost, CurTerm)<>ID_OK then Exit;
    MyTelnet1.TermType:=CurTerm;
    MyTelnet1.Open(CurHost, CurPort);
end;

procedure TTelnetForm.ToolButton2Click(Sender: TObject);
begin
    if MyTelnet1.Active then begin
        UserStop:=True;
        MyTelnet1.Close;
    end;
end;

procedure TTelnetForm.ToolButton4Click(Sender: TObject);
begin
    MyTelnet1.CopyToClipboard;
end;

procedure TTelnetForm.ToolButton5Click(Sender: TObject);
begin
    MyTelnet1.PasteFromClipboard;
end;

procedure TTelnetForm.ToolButton6Click(Sender: TObject);
begin
    MyTelnet1.SelectAll;
end;



procedure TTelnetForm.ToolButton11Click(Sender: TObject);
begin  { 字体设置 }
    FontDialog.Font.Assign(MyTelnet1.Font);
    FontDialog.Font.Style:=[];
    FontDialog.Font.Color:=clWindowText;
    if not FontDialog.Execute then Exit;
    FontDialog.Font.Style:=[];
    FontDialog.Font.Color:=clWindowText;
    MyTelnet1.Font.Assign(FontDialog.Font);
end;

procedure TTelnetForm.ToolButton13Click(Sender: TObject);
begin
    ShowAbout;
end;

procedure TTelnetForm.ToolButton8Click(Sender: TObject);
begin
    MyTelnet1.CaretStyle:=csLine;
    toolbutton8.Down:=true;
    toolbutton9.Down:=false;
end;

procedure TTelnetForm.ToolButton9Click(Sender: TObject);
begin
    MyTelnet1.CaretStyle:=csBlock;
    toolbutton8.Down:=false;
    toolbutton9.Down:=true;
end;

procedure TTelnetForm.miConnectExitClick(Sender: TObject);
begin
    Close
end;

end.